home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
GEMini Atari
/
GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso
/
zip
/
utility
/
the_acc.lzh
/
theacc.mod
< prev
next >
Wrap
Text File
|
1988-04-23
|
85KB
|
2,618 lines
MODULE TRYIT;
(*$S-,$T-*)
FROM AESApplications IMPORT ApplInitialise;
FROM AESResources IMPORT ResourceLoad,ResourceGetAddr;
FROM SYSTEM IMPORT ADDRESS,ADR,CODE,BYTE,NULL,REGISTER,SETREG;
FROM AESForms IMPORT FormDo,FormCenter,FormAlert,FormDialogue;
FROM AESObjects IMPORT ObjectDraw,ObjectOffset,ObjectChange,
ObjectFind;
FROM AESGraphics IMPORT GrafDragBox,GrafMouseKeyboardState,GrafGrowBox,
GrafShrinkBox;
FROM GEMAESbase IMPORT Object,TEdInfo,Arrow,HourGlass,AESCallResult,
MesageEvent;
FROM BIOS IMPORT DriveMap,DriveSet,BPB,BPBPtr,GetBPB,RW,RWAbs,BCosStat,
Device;
FROM XBIOS IMPORT FloppyFormat,FloppyWrite,PrototypeBootSector,SuperExec,
FloppyRead,GetResolution;
FROM InOut IMPORT WriteString,WriteLn,WriteInt,WriteCard,OpenOutputFile;
IMPORT Terminal;
IMPORT GEMDOS;
FROM Strings IMPORT String,Length,Concat,Compare,CompareResults,Insert,
Delete,Pos,Copy;
FROM AESGraphics IMPORT GrafMouse;
FROM LongInOut IMPORT WriteLongCard;
FROM M2Conversions IMPORT ConvertReal,ConvertInteger,ConvertCardinal,
ConvertToInteger,ConvertAddrDec;
FROM AESWindows IMPORT WindowCreate,WindowOpen,WindowClose,WindowDelete;
FROM AESEvents IMPORT EventMultiple;
FROM AESMenus IMPORT MenuRegister;
FROM Conversions IMPORT ConvertToString;
CONST
tree1 = 0; (* form/dialog *)
dialogbx = 1; (* BOX in tree TREE1 *)
fpath = 2; (* BOXTEXT in tree TREE1 *)
fup = 3; (* BOXTEXT in tree TREE1 *)
fwind = 4; (* BOX in tree TREE1 *)
fname2 = 5; (* TEXT in tree TREE1 *)
fname3 = 6; (* TEXT in tree TREE1 *)
fname4 = 7; (* TEXT in tree TREE1 *)
fname5 = 8; (* TEXT in tree TREE1 *)
fname6 = 9; (* TEXT in tree TREE1 *)
fname7 = 10; (* TEXT in tree TREE1 *)
fname8 = 11; (* TEXT in tree TREE1 *)
fname9 = 12; (* TEXT in tree TREE1 *)
fname10 = 13; (* TEXT in tree TREE1 *)
fname11 = 14; (* TEXT in tree TREE1 *)
fname12 = 15; (* TEXT in tree TREE1 *)
fname13 = 16; (* TEXT in tree TREE1 *)
fntrack = 17; (* BOX in tree TREE1 *)
fnslider = 18; (* BOX in tree TREE1 *)
ftofile = 20; (* BOXTEXT in tree TREE1 *)
ftoname = 21; (* FTEXT in tree TREE1 *)
drivea = 22; (* BOXTEXT in tree TREE1 *)
driveb = 23; (* BOXTEXT in tree TREE1 *)
drivec = 24; (* BOXTEXT in tree TREE1 *)
drived = 25; (* BOXTEXT in tree TREE1 *)
drivee = 26; (* BOXTEXT in tree TREE1 *)
drivef = 27; (* BOXTEXT in tree TREE1 *)
driveg = 28; (* BOXTEXT in tree TREE1 *)
driveh = 29; (* BOXTEXT in tree TREE1 *)
drivei = 30; (* BOXTEXT in tree TREE1 *)
drivej = 31; (* BOXTEXT in tree TREE1 *)
drivek = 32; (* BOXTEXT in tree TREE1 *)
drivel = 33; (* BOXTEXT in tree TREE1 *)
drivem = 34; (* BOXTEXT in tree TREE1 *)
driven = 35; (* BOXTEXT in tree TREE1 *)
driveo = 36; (* BOXTEXT in tree TREE1 *)
drivep = 37; (* BOXTEXT in tree TREE1 *)
printbx = 38; (* BOX in tree TREE1 *)
fprint = 39; (* BOXTEXT in tree TREE1 *)
fall = 40; (* BOXTEXT in tree TREE1 *)
fnone = 41; (* BOXTEXT in tree TREE1 *)
fdown = 42; (* BOXTEXT in tree TREE1 *)
drvfree = 43; (* BOXTEXT in tree TREE1 *)
frspc = 44; (* BOXTEXT in tree TREE1 *)
folderbx = 45; (* BOX in tree TREE1 *)
ferase = 47; (* BOXTEXT in tree TREE1 *)
fcreate = 48; (* BOXTEXT in tree TREE1 *)
fldok = 49; (* BOXTEXT in tree TREE1 *)
finfobx = 50; (* BOX in tree TREE1 *)
fbytes = 51; (* BOXTEXT in tree TREE1 *)
fro = 52; (* BOXTEXT in tree TREE1 *)
fdate = 53; (* FBOXTEXT in tree TREE1 *)
frw = 54; (* BOXTEXT in tree TREE1 *)
ftime = 55; (* FBOXTEXT in tree TREE1 *)
fset = 56; (* BOXTEXT in tree TREE1 *)
filename = 57; (* FBOXTEXT in tree TREE1 *)
finfo = 58; (* BOXTEXT in tree TREE1 *)
mainexit = 59; (* BOXTEXT in tree TREE1 *)
fileopts = 60; (* BOX in tree TREE1 *)
filedlg = 61; (* BOX in tree TREE1 *)
cpyoptns = 62; (* BOXTEXT in tree TREE1 *)
cpyfile = 64; (* BOXTEXT in tree TREE1 *)
cpydisk = 65; (* BOXTEXT in tree TREE1 *)
cpycopy = 66; (* BOXTEXT in tree TREE1 *)
cpycancl = 67; (* BOXTEXT in tree TREE1 *)
cpyscr = 69; (* BOXTEXT in tree TREE1 *)
cpydst = 70; (* BOXTEXT in tree TREE1 *)
verify = 71; (* BOXTEXT in tree TREE1 *)
options = 72; (* BOXTEXT in tree TREE1 *)
erase = 74; (* BOXTEXT in tree TREE1 *)
formatbx = 75; (* BOX in tree TREE1 *)
format = 76; (* BOXTEXT in tree TREE1 *)
fdrva = 78; (* BOXTEXT in tree TREE1 *)
fdrvb = 79; (* BOXTEXT in tree TREE1 *)
fspt = 80; (* BOXTEXT in tree TREE1 *)
fss = 82; (* BOXTEXT in tree TREE1 *)
fdd = 83; (* BOXTEXT in tree TREE1 *)
slidebox = 84; (* BOX in tree TREE1 *)
ftrack = 85; (* BOX in tree TREE1 *)
fslider = 86; (* BOX in tree TREE1 *)
tree3 = 1; (* form/dialog *)
errdlg = 0; (* BOX in tree TREE3 *)
cfdest = 1; (* FTEXT in tree TREE3 *)
cfok = 2; (* BUTTON in tree TREE3 *)
cfcancel = 3; (* BUTTON in tree TREE3 *)
tree2 = 2; (* form/dialog *)
cpydlg = 0; (* BOX in tree TREE2 *)
cpyatob = 1; (* BOXTEXT in tree TREE2 *)
cpyok = 2; (* BUTTON in tree TREE2 *)
cpybtoa = 3; (* BOXTEXT in tree TREE2 *)
cpyexit = 4; (* BUTTON in tree TREE2 *)
cpyslide = 6; (* IBOX in tree TREE2 *)
dsttrack = 7; (* BOX in tree TREE2 *)
dstslide = 8; (* BOX in tree TREE2 *)
scrtrack = 9; (* BOX in tree TREE2 *)
scrslide = 10; (* BOX in tree TREE2 *)
tree4 = 3; (* form/dialog *)
optdlg = 0; (* BOX in tree TREE4 *)
cpyyes = 2; (* BUTTON in tree TREE4 *)
cpyno = 3; (* BUTTON in tree TREE4 *)
dltyes = 5; (* BUTTON in tree TREE4 *)
dltno = 6; (* BUTTON in tree TREE4 *)
conok = 7; (* BUTTON in tree TREE4 *)
concancl = 8; (* BUTTON in tree TREE4 *)
tree5 = 4; (* form/dialog *)
copydlg = 0; (* BOX in tree TREE5 *)
numtocpy = 3; (* TEXT in tree TREE5 *)
condlgok = 4; (* BUTTON in tree TREE5 *)
condlgcl = 5; (* BUTTON in tree TREE5 *)
tree6 = 5; (* form/dialog *)
dltdlg = 0; (* BOX in tree TREE6 *)
numtodlt = 3; (* TEXT in tree TREE6 *)
dltdlgok = 4; (* BUTTON in tree TREE6 *)
dltdlgcl = 5; (* BUTTON in tree TREE6 *)
Normal = 0;
selected = 1;
disabled = 8;
RTS = 04E75H;
stacksize = 4096;
TYPE
PTRTOTEDINFO = POINTER TO TEdInfo;
etree = POINTER TO TEdInfo;
objtree = RECORD
next : INTEGER;
head : INTEGER;
tail : INTEGER;
type : INTEGER;
flags : INTEGER;
state : INTEGER;
spec : etree;
x : INTEGER;
y : INTEGER;
width :INTEGER;
height : INTEGER;
END;
bootsectortype = RECORD
bbi : CARDINAL;
loader : ARRAY[0..5] OF CHAR;
snum : ARRAY[0..2] OF CHAR;
bps : CARDINAL;
spc : CARDINAL;
res : CARDINAL;
fat : CHAR;
dir : CARDINAL;
sec : CARDINAL;
media : CARDINAL;
spf : CARDINAL;
spt : CARDINAL;
filler1 : ARRAY[0..5] OF CHAR;
side : CARDINAL;
hid : CARDINAL;
filler2 : ARRAY[0..479] OF CHAR;
check : CARDINAL;
END;
Tree = POINTER TO ARRAY[1..300] OF objtree;
objstate = (Selected);
str = ARRAY[1..80] OF CHAR;
pathrecord = RECORD
reserved : ARRAY[0..20] OF BYTE;
attrib : BYTE;
time : CARDINAL;
date : CARDINAL;
size : LONGCARD;
name : String;
END;
nametype = ARRAY[1..500] OF String;
oned = ARRAY[1..500] OF INTEGER;
twod = ARRAY[1..500],[1..2] OF INTEGER;
VAR
tree1ptr,tree2ptr,tree3ptr,tree4ptr,tree5ptr,tree6ptr,
obtedinfo,treeaddr : Tree;
handle,x,y,w,h,xx,yy,ww,hh,showit,disktype,execflag,result,oldyoff,
nine,vint,ccount,index,fcount,fnslidery,fnsliderh,fntrackh
,th,sh,fnametemp,ii,newwind,menuid,apid,event,dummy,cresult
,fileselection,foundit,resolution : INTEGER;
bootsector : ARRAY[0..511] OF CHAR;
selection : POINTER TO String;
vobspec,gobspec : etree;
pbuffer : ARRAY[0..7] OF CARDINAL;
stack : ARRAY[1..4096] OF CARDINAL;
d : [0..31];
drv : DriveSet;
buffer,ptextaddr,bufferaddr,freememory : ADDRESS;
loaded,done,initialized,therewasanerror,confirmcopy,confirmdlt,
clearfirst : BOOLEAN;
errorstring : ARRAY[0..100] OF CHAR;
drive,spt,interleave,virgin,
defaultdrive,numberofsides,tracksperdisk,sectorspertrack,count,
ct,year,month,ryear,hour,minute,rhour,day,appldrive : CARDINAL;
dtarecord : pathrecord;
selobspec : etree;
writeverify [0444H] : BYTE;
verifyflag,defaultverify : BYTE;
swidth,tswidth,ttswidth : REAL;
free,drivemap,tsize,Count,sizebuffer : LONGCARD;
path,rpath,temp,temp2 : ARRAY[0..300] OF String;
atrib : ARRAY[0..100] OF CARDINAL;
farray,match,rfarray,r1,r2,r3,r4,temp1,result2
,p1,p2,p3,p4,ffpath,ppath,Temp1,Temp2,Temp3,filearray,
globlepath,clear,ptextstr,
clearstr,currentname,newname,presult,pathdrive,
hourstr,minutestr,rhourstr,rminutestr,timestr,yearstr,monthstr,
daystr,datestr,modystr,mresultstr,tresultstr,rdaystr,pathstr : String;
sourcename,destname,sourcepathstr,accname,fffpath,freestr,
gverifystr,selpathstr : String;
i1,i,j,j1,k,p,t : INTEGER;
s : BOOLEAN;
n : oned;
s9 : twod;
PROCEDURE MakeCardinal(a,b : CHAR) : CARDINAL;
VAR
aa,bb : CARDINAL;
BEGIN
aa := CARDINAL(a);
bb := CARDINAL(b);
RETURN (CARDINAL(a) + CARDINAL(b) * 256);
END MakeCardinal;
PROCEDURE ClearIt;
VAR
fromobspec,bobspec,tobspec,dobspec : etree;
bytesstr,timestr,datestr,pathstr : String;
selection : POINTER TO String;
blank : String;
where : CARDINAL;
BEGIN
IF (initialized) AND NOT (GetObjectState(tree1,cpyfile,Selected)) THEN
blank := '';
tree1ptr^[ftoname + 1].spec^.ptext := ADR(blank);
tree1ptr^[filename + 1].spec^.ptext := ADR(blank);
ObjectDraw(tree1ptr,ftoname,1,x,y,w,h);
ObjectDraw(tree1ptr,filename,1,x,y,w,h);
bytesstr := '000000';
datestr := '000000';
timestr := '0000 ';
tree1ptr^[fbytes + 1].spec^.ptext := ADR(bytesstr);
tree1ptr^[fdate + 1].spec^.ptext := ADR(datestr);
tree1ptr^[ftime + 1].spec^.ptext := ADR(timestr);
ObjectDraw(tree1ptr,fbytes,1,x,y,w,h);
ObjectDraw(tree1ptr,fdate,1,x,y,w,h);
ObjectDraw(tree1ptr,ftime,1,x,y,w,h);
ObjectChange(tree1ptr,fro,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,frw,0,x,y,w,h,Normal,0);
ObjectDraw(tree1ptr,frw,1,x,y,w,h);
ObjectChange(tree1ptr,fset,0,x,y,w,h,disabled,1);
clearfirst := TRUE;
ELSE
selection := tree1ptr^[ftoname + 1].spec^.ptext;
pathstr := selection^;
IF (Pos(pathstr,'*.',0,where) AND (clearfirst)) THEN
tree1ptr^[ftoname + 1].spec^.ptext := ADR(pathstr);
clearfirst := FALSE;END;
END;
END ClearIt;
PROCEDURE ChecktheState(tree,index : INTEGER) : BITSET;
VAR
treeaddr : Tree;
BEGIN
ResourceGetAddr(0,tree,treeaddr);
RETURN BITSET(treeaddr^[index + 1].state);
END ChecktheState;
PROCEDURE GetObjectState(tree,index : INTEGER ; mask : objstate) : BOOLEAN;
TYPE
state = SET OF objstate;
VAR
value : BITSET;
BEGIN
ResourceGetAddr(0,tree1,tree1ptr);
value := ChecktheState(tree,index);
RETURN (mask IN state(value));
END GetObjectState;
PROCEDURE CalcSliderSize;
BEGIN
th := tree1ptr^[fntrack + 1].height;
IF ii < 12 THEN
tree1ptr^[fnslider + 1].height := th;
ELSE
swidth := FLOAT(CARDINAL(th))/FLOAT(CARDINAL(ii));
swidth := swidth * 12.0;
ttswidth := swidth;
IF swidth < 5.00 THEN
tree1ptr^[fnslider + 1].height := 5;
swidth := swidth/12.0;
ELSE
tree1ptr^[fnslider + 1].height := INTEGER(TRUNC(swidth));
swidth := swidth/12.0;
END;
sh := tree1ptr^[fnslider + 1].height;
END; (* IF ELSE *)
tree1ptr^[fnslider + 1].y := 0;
IF initialized THEN ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);END;
END CalcSliderSize;
PROCEDURE updateslider(tree,index :INTEGER; treeaddr:Tree);
VAR
curx,curw : INTEGER;
BEGIN
curx := tree1ptr^[fslider + 1].x;
curw := tree1ptr^[fslider + 1].width;
curx := curx + 1;
curw := curw - 1;
tree1ptr^[fslider + 1].x := curx;
tree1ptr^[fslider + 1].width := curw;
ObjectDraw(tree1ptr,ftrack,1,x,y,w,h);
ObjectDraw(tree1ptr,fslider,1,x,y,w,h);
END updateslider;
PROCEDURE Bootsector;
VAR
bootsector : ARRAY[0..511] OF CHAR;
sec,sec2,spt : CARDINAL;
serialno : LONGINT;
disktype,execflag,result : INTEGER;
side,track,sector,count : CARDINAL;
buffer : ADDRESS;
BEGIN
serialno := 00FFFFFFEH;
side := 0;
execflag := 0;
track := 0;
sector := 1;
count := 1;
buffer := ADR(bootsector);
IF GetObjectState(tree1,fdd,Selected) THEN
disktype := 3;
IF tracksperdisk = 79 THEN
sec := 160;
sec2 := 5;
ELSE
sec := 104;
sec2 := 6;
END;
ELSE
disktype := 2;
IF tracksperdisk = 79 THEN
sec := 208;
sec2 := 2;
ELSE
sec := 52;
sec2 := 3;
END;
END;
PrototypeBootSector(buffer,serialno,disktype,execflag);
bootsector[24] := CHAR(sectorspertrack);
bootsector[19] := CHAR(sec);
bootsector[20] := CHAR(sec2);
buffer := ADR(bootsector);
result := FloppyWrite(buffer,drive,sector,track,side,count);
GrafMouse(Arrow,NIL);
END Bootsector;
PROCEDURE Formatdisk(tree,index : INTEGER; treeaddr:Tree);
VAR
defaultx,defaultwidth,result : INTEGER;
thestring,errorstr : String;
spt,track,side,interleave,virgin : CARDINAL;
buffer : ADDRESS;
BEGIN
showit := FormAlert(1,"[2][All the contents of the disk|will be ERASED, do you wish|to continue?][ CANCEL | OK ]");
IF showit # 1 THEN
IF GetObjectState(tree1,fdrva,Selected) THEN drive := 0 ELSE
drive := 1; END;
spt := sectorspertrack;
track := 0;
side := 0;
interleave := 1;
virgin := 000H;
GEMDOS.Alloc(10000,buffer);
defaultx := treeaddr^[index + 1].x;
defaultwidth := treeaddr^[index + 1].width;
GrafMouse(HourGlass,NIL);
LOOP
result := FloppyFormat(buffer,drive,spt,track,side,interleave,virgin);
IF GetObjectState(tree1,fdd,Selected) THEN
side := 1;
virgin := 0E5E5H;
result := FloppyFormat(buffer,drive,spt,track,side,interleave,virgin); IF track < 2 THEN virgin := 000H; END;
side := 0;
END;
IF (result < 0) OR (track = tracksperdisk) THEN EXIT ; END;
INC(track);
updateslider(tree,index,treeaddr);
IF track > 1 THEN virgin := 0E5E5H; END;
END; (* LOOP *)
IF result < 0 THEN
CASE result OF
-13 : errorstring := "[1][Disk is WRITE|protected! ][ OK ]"|
-16 : errorstring := "[1][An error occured|during format! ][ OK ]";
END; (* CASE *)
showit := FormAlert(1,errorstring);
END;
treeaddr^[index + 1].x := defaultx;
treeaddr^[index + 1].width := defaultwidth;
ObjectDraw(tree1ptr,fslider,1,x,y,w,h);
done := GEMDOS.Free(buffer);
IF result >= 0 THEN Bootsector; END;
END;
ObjectChange(tree1ptr,format,0,x,y,w,h,Normal,1);
END Formatdisk;
PROCEDURE ConvertDateTime(date,time : CARDINAL);
BEGIN
year := (date DIV 512) + 80;
ryear := date MOD 512;
month := ryear DIV 32;
day := ryear MOD 32;
ConvertToString(LONGCARD(year),10,FALSE,yearstr,done);
ConvertToString(LONGCARD(month),10,FALSE,monthstr,done);
ConvertToString(LONGCARD(day),10,FALSE,daystr,done);
IF (day < 10) AND (month < 10) THEN
Concat('0',monthstr,mresultstr);
monthstr := mresultstr;
Concat('0',daystr,rdaystr);
daystr := rdaystr;
ELSE
IF month < 10 THEN Concat('0',monthstr,mresultstr);
monthstr := mresultstr;END;
IF day < 10 THEN Concat('0',daystr,rdaystr);
daystr := rdaystr;END;
END;
Concat(monthstr,daystr,modystr);
Concat(modystr,yearstr,datestr);
hour := time DIV 2048;
rhour := time MOD 2048;
minute := rhour DIV 32;
ConvertToString(LONGCARD(hour),10,FALSE,hourstr,done);
ConvertToString(LONGCARD(minute),10,FALSE,minutestr,done);
IF hour < 1 THEN
Delete(hourstr,0,1);
Concat('12',hourstr,rhourstr);
hourstr := rhourstr;
END;
IF (hour >= 1) AND (hour < 10) THEN
Concat(' ',hourstr,rhourstr);
hourstr := rhourstr;
END;
IF minute < 10 THEN
Concat('0',minutestr,rminutestr);
minutestr := rminutestr;
END;
Concat(hourstr,minutestr,timestr);
IF hour < 12 THEN
Concat(timestr,'A',tresultstr);
ELSE
Concat(timestr,'P',tresultstr);
END;
END ConvertDateTime;
PROCEDURE GetFreeSpace;
TYPE
diskinfo = GEMDOS.DiskInfoBuffer;
VAR
freeinfo : diskinfo;
drive : CARDINAL;
freestr : String;
obspec : etree;
BEGIN
IF GetObjectState(tree1,drivea,Selected) THEN drive := 1; END;
IF GetObjectState(tree1,driveb,Selected) THEN drive := 2; END;
IF GetObjectState(tree1,drivec,Selected) THEN drive := 3; END;
IF GetObjectState(tree1,drived,Selected) THEN drive := 4; END;
IF GetObjectState(tree1,drivee,Selected) THEN drive := 5; END;
IF GetObjectState(tree1,drivef,Selected) THEN drive := 6; END;
IF GetObjectState(tree1,driveg,Selected) THEN drive := 7; END;
IF GetObjectState(tree1,driveh,Selected) THEN drive := 8; END;
IF GetObjectState(tree1,drivei,Selected) THEN drive := 9; END;
IF GetObjectState(tree1,drivej,Selected) THEN drive := 10; END;
IF GetObjectState(tree1,drivek,Selected) THEN drive := 11; END;
IF GetObjectState(tree1,drivel,Selected) THEN drive := 12; END;
IF GetObjectState(tree1,drivem,Selected) THEN drive := 13; END;
IF GetObjectState(tree1,driven,Selected) THEN drive := 14; END;
IF GetObjectState(tree1,driveo,Selected) THEN drive := 15; END;
IF GetObjectState(tree1,drivep,Selected) THEN drive := 16; END;
GrafMouse(HourGlass,NIL);
GEMDOS.DFree(freeinfo,drive);
free := freeinfo.freeSpace * freeinfo.sectorSize * freeinfo.clusterSize;
IF NOT (GetObjectState(tree1,fprint,Selected) AND
(GetObjectState(tree1,cpyfile,Selected) AND
GetObjectState(tree1,cpycopy,Selected))) THEN
ConvertToString(LONGCARD(free),10,FALSE,freestr,done);
tree1ptr^[frspc + 1].spec^.ptext := ADR(freestr);
ObjectDraw(tree1ptr,frspc,1,x,y,w,h);
GrafMouse(Arrow,NIL);
ObjectChange(tree1ptr,drvfree,0,x,y,w,h,Normal,1);
ELSE
ConvertToString(LONGCARD(free),10,FALSE,freestr,done);
WriteString(freestr);
GrafMouse(Arrow,NIL);
END;
END GetFreeSpace;
(*$P-*)
PROCEDURE SetVerifyOn;
BEGIN
writeverify := BYTE(-1);
CODE(RTS);
END SetVerifyOn;
(*$P-*)
PROCEDURE SetVerifyOff;
BEGIN
writeverify := BYTE(0);
CODE(RTS);
END SetVerifyOff;
(*$P-*)
PROCEDURE GetVerifyFlag;
BEGIN
verifyflag := writeverify;
CODE(RTS);
END GetVerifyFlag;
PROCEDURE DoVerify;
VAR
verifystr : String;
obspec : etree;
BEGIN
IF vint = 0 THEN
verifystr := 'WRITE VERIFY OFF ';
SuperExec(PROC(SetVerifyOff));
vint := -1
ELSE
verifystr := 'WRITE VERIFY ON ';
SuperExec(PROC(SetVerifyOn));
vint := 0;
END;
tree1ptr^[verify + 1].spec^.ptext := ADR(verifystr);
gverifystr := verifystr;
ObjectChange(tree1ptr,verify,0,x,y,w,h,Normal,1);
IF initialized THEN
ObjectDraw(tree1ptr,verify,1,x,y,w,h);END;
END DoVerify;
PROCEDURE BPBparameters(source,dest : BPB) : BOOLEAN;
BEGIN
IF source.recsiz <> dest.recsiz THEN RETURN(FALSE); END;
IF source.clsiz <> dest.clsiz THEN RETURN(FALSE); END;
IF source.clsizb <> dest.clsizb THEN RETURN(FALSE); END;
IF source.rdlen <> dest.rdlen THEN RETURN(FALSE); END;
IF source.fsiz <> dest.fsiz THEN RETURN(FALSE); END;
IF source.fatrec <> dest.fatrec THEN RETURN(FALSE); END;
IF source.datrec <> dest.datrec THEN RETURN(FALSE); END;
IF source.numcl <> dest.numcl THEN RETURN(FALSE); END;
IF source.bflags <> dest.bflags THEN RETURN(FALSE); END;
IF source.numcl > 500 THEN numberofsides := 2;
ELSE numberofsides := 1;END;
RETURN(TRUE);
END BPBparameters;
PROCEDURE DoCopy;
VAR
sourcedrv,destdrv : BPB;
sourceptr,destptr : BPBPtr;
source,dest,side,track,spt,bps,bside,sec,numberoftracks,
strack,dtrack,temp1,temp2,totaltracks : CARDINAL;
bufferaddr,baseaddr,addr,freememory,bootaddr : ADDRESS;
bytes,buffersize,bufferptr,endofbuffer : LONGCARD;
Done,reading,done : BOOLEAN;
curx,curw,scrdefx,scrdefw,dstdefx,dstdefw,snum,dnum,result : INTEGER;
obspec : etree;
sresult,dresult : String;
BEGIN
IF GetObjectState(tree2,cpyatob,Selected) THEN
source := 0;
dest := 1;
END;
IF GetObjectState(tree2,cpybtoa,Selected) THEN
dest := 0;
source := 1;
END;
sourceptr := GetBPB(source);
destptr := GetBPB(dest);
ConvertAddrDec(sourceptr,2,sresult);
ConvertAddrDec(destptr,2,dresult);
ConvertToInteger(sresult,done,snum);
ConvertToInteger(dresult,done,dnum);
IF (snum # 0 ) AND (dnum # 0) THEN
sourcedrv := destptr^;
destdrv := sourceptr^;
IF NOT BPBparameters(sourcedrv,destdrv) THEN
showit := FormAlert(1,"[1][Disk Formats are|not the same!][ OK ]");
Done := FALSE;
RETURN;
END;
endofbuffer := 0;
bufferptr := 0;
bytes := 0;
bufferaddr := ADR(bufferptr);
GEMDOS.Alloc(0FFFFFFFFH,bufferaddr);
bytes := LONGCARD(bufferaddr);
bytes := bytes - 2000H;
bytes := (bytes DIV 512) * 512;
GEMDOS.Alloc(bytes,bufferaddr);
baseaddr := bufferaddr;
endofbuffer := LONGCARD(baseaddr) + bytes;
bootaddr := ADR(bootsector);
result := FloppyRead(bootaddr,0,1,0,0,1);
sec := MakeCardinal(bootsector[19],bootsector[20]);
bside := MakeCardinal(bootsector[26],bootsector[27]);
spt := MakeCardinal(bootsector[24],bootsector[25]);
numberoftracks := sec DIV spt;
IF numberoftracks > 82 THEN numberoftracks := numberoftracks DIV 2;END;
tree2ptr^[scrtrack + 1].width := numberoftracks + 2;
tree2ptr^[scrslide + 1].width := numberoftracks;
tree2ptr^[scrslide + 1].x := (tree2ptr^[scrtrack + 1].x) + 1;
tree2ptr^[dsttrack + 1].width := numberoftracks + 2;
tree2ptr^[dstslide + 1].width := numberoftracks;
tree2ptr^[dstslide + 1].x := (tree2ptr^[dsttrack + 1].x) + 1;
ObjectDraw(tree2ptr,cpyslide,3,x,y,w,h);
bps := 512;
totaltracks := 0;
temp1 := 0;
temp2 := 0;
side := 0;
strack := 0;
dtrack := 0;
reading := TRUE;
bufferptr := LONGCARD(baseaddr);
scrdefx := tree2ptr^[scrslide + 1].x;
scrdefw := tree2ptr^[scrslide + 1].width;
dstdefx := tree2ptr^[dstslide + 1].x;
dstdefw := tree2ptr^[dstslide + 1].width;
GrafMouse(HourGlass,NIL);
LOOP
IF reading THEN
result := FloppyRead(bufferaddr,source,1,strack,side,spt);
IF side = 0 THEN
curx := tree2ptr^[scrslide + 1].x;
curw := tree2ptr^[scrslide + 1].width;
INC(curx);
DEC(curw);
tree2ptr^[scrslide + 1].x := curx;
tree2ptr^[scrslide + 1].width := curw;
ObjectDraw(tree2ptr,scrtrack,1,x,y,w,h);
ObjectDraw(tree2ptr,scrslide,1,x,y,w,h);
END;
ELSE
REPEAT
result := FloppyWrite(bufferaddr,dest,1,dtrack,side,spt);
IF result < 0 THEN
showit := FormAlert(1, "[1][ Disk Is Write Protected!][ Retry | Cancel ]");
CASE showit OF
2 : result := -1;
END;
END;
UNTIL (result >= 0) OR (result = -1);
IF (side = 0) AND (result >= 0) THEN
curx := tree2ptr^[dstslide + 1].x;
curw := tree2ptr^[dstslide + 1].width;
INC(curx);
DEC(curw);
tree2ptr^[dstslide + 1].x := curx;
tree2ptr^[dstslide + 1].width := curw;
ObjectDraw(tree2ptr,dsttrack,1,x,y,w,h);
ObjectDraw(tree2ptr,dstslide,1,x,y,w,h);
END;
END;
IF (side = 0) AND (bside = 2) THEN
side := 1;
ELSE
INC(totaltracks);
IF reading THEN INC(strack);
ELSE INC(dtrack);END;
side := 0;
END;
IF (side = 0) AND (totaltracks = numberoftracks) AND (NOT reading)
OR (result < 0) THEN EXIT; END;
bufferptr := bufferptr + LONGCARD(spt * bps);
bufferaddr := ADDRESS(bufferptr);
IF (bufferptr > endofbuffer) OR
((side = 0) AND (totaltracks = numberoftracks)) THEN
temp1 := totaltracks;
totaltracks := temp2;
temp2 := temp1;
reading := NOT reading;
bufferaddr := baseaddr;
bufferptr := LONGCARD(bufferaddr);
END;
END; (* LOOP *)
GrafMouse(Arrow,NIL);
tree2ptr^[scrslide + 1].x := scrdefx;
tree2ptr^[scrslide + 1].width := scrdefw;
tree2ptr^[dstslide + 1].x := dstdefx;
tree2ptr^[dstslide + 1].width := dstdefw;
ObjectDraw(tree2ptr,scrslide,1,x,y,w,h);
ObjectDraw(tree2ptr,dstslide,1,x,y,w,h);
Done := GEMDOS.Free(baseaddr);
Done := TRUE;
END; (* IF sourceptr and destptr *)
END DoCopy;
PROCEDURE CopyDialog;
VAR
xoff,yoff,bx,by,bw,bh,stw,sth,stx,sty,ewidth,eheight : INTEGER;
BEGIN
ObjectOffset(tree1ptr,filedlg,xoff,yoff);
tree2ptr^[cpydlg + 1].x := xoff;
tree2ptr^[cpydlg + 1].y := yoff;
tree2ptr^[scrtrack + 1].width := 82;
tree2ptr^[scrslide + 1].width := 80;
tree2ptr^[scrslide + 1].x := (tree2ptr^[scrtrack + 1].x) + 1;
tree2ptr^[dsttrack + 1].width := 82;
tree2ptr^[dstslide + 1].width := 80;
tree2ptr^[dstslide + 1].x := (tree2ptr^[dsttrack + 1].x) + 1;
ewidth := tree1ptr^[filedlg + 1].width;
eheight := tree1ptr^[filedlg + 1].height;
stx := (xoff + ewidth) DIV 2;
sty := (yoff + eheight) DIV 2;
stw := 5;
sth := 2;
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
ObjectDraw(tree2ptr,cpydlg,3,x,y,w,h);
REPEAT
showit := FormDo(tree2ptr,0);
IF GetObjectState(tree2,cpyok,Selected) THEN
DoCopy;
ObjectChange(tree2ptr,cpyok,0,x,y,w,h,Normal,1);
ObjectDraw(tree2ptr,cpyok,1,x,y,w,h);
END;
UNTIL GetObjectState(tree2,cpyexit,Selected);
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
ObjectChange(tree2ptr,cpyexit,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,cpydisk,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,fileopts,4,x,y,w,h);
END CopyDialog;
PROCEDURE Changespt;
VAR
sptstr : String;
sptobspec : etree;
BEGIN
IF nine = 0 THEN
sptstr := '9/80';
nine := 1;
sectorspertrack := 9;
tracksperdisk := 79;
tree1ptr^[ftrack + 1].width := 82;
tree1ptr^[fslider + 1].width := 80;
ELSE
sptstr := '10/82';
nine := 0;
sectorspertrack := 10;
tracksperdisk := 81;
tree1ptr^[ftrack + 1].width := 84;
tree1ptr^[fslider + 1].width := 82;
END;
tree1ptr^[fspt +1].spec^.ptext := ADR(sptstr);
ObjectDraw(tree1ptr,fspt,0,x,y,w,h);
ObjectChange(tree1ptr,fspt,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,slidebox,3,x,y,w,h);
END Changespt;
PROCEDURE switch(VAR a,b: String ; VAR s1 : BOOLEAN);
VAR
t : String;
BEGIN
t := a;
a := b;
b := t;
s1 := NOT s1;
END switch;
PROCEDURE save1(VAR q : INTEGER ;VAR s8 : twod ;a ,k1 : INTEGER);
BEGIN
q := q+1;
s8[q,1] := a+1;
s8[q,2] := k1
END save1;
PROCEDURE restore(s8:twod ; VAR i2,j2,q : INTEGER);
BEGIN
i2 := s8[q,1];
j2 := s8[q,2];
q := q - 1
END restore;
PROCEDURE init(VAR a,b,a1,b1 : INTEGER ; VAR es : BOOLEAN);
BEGIN
a := a1;
b := b1;
es := FALSE;
END init;
PROCEDURE sort;
BEGIN
REPEAT
IF (Compare(path[i],path[j]) = Greater) THEN switch(path[i],path[j],s);END;
IF s THEN i := i + 1
ELSE j := j - 1;END;
UNTIL i = j;
IF NOT(i+1 >= j1) THEN save1(p,s9,i,j1);END;
j1 := i - 1;
IF i1 < j1 THEN
init(i,j,i1,j1,s);
sort;
END;
IF p <> 0 THEN
restore(s9,i1,j1,p);
init(i,j,i1,j1,s);
j := ii;
sort;
END;
END sort;
PROCEDURE MakeArray(VAR ppath : ARRAY OF CHAR);
VAR
addr : ADDRESS;
pathdrive,presult,match,directchr : String;
obspec : etree;
i2,l : INTEGER;
atrib,where,start : CARDINAL;
BEGIN
ii := 0;
fnslidery := 0;
tswidth := 0.0;
ttswidth := 0.0;
pathdrive := CHR(ORD(defaultdrive) + ORD('A'));
Concat(pathdrive,':',presult);
Concat(presult,ppath,pathstr);
addr := ADR(dtarecord);
GEMDOS.SetDTA(addr);
GrafMouse(HourGlass,NIL);
GEMDOS.SFirst(pathstr,16,result);
IF result >= 0 THEN
REPEAT
WITH dtarecord DO;
IF (Compare(name,'.') # Equal) AND (Compare(name,'..')
# Equal) THEN
INC(ii);
path[ii] := name;
atrib := CARDINAL(attrib);
directchr := CHR(5);
Concat(directchr," ",directchr);
IF atrib = 16 THEN
Concat(directchr,path[ii],rpath[ii]);
ELSE
Concat(' ',path[ii],rpath[ii]);
END; (* IF *)
path[ii] := rpath[ii];
IF Length(rpath[ii]) < 14 THEN
FOR l := Length(rpath[ii]) + 1 TO 14 DO
Concat(rpath[ii],' ',rpath[ii]);
END; (* FOR *)
END; (* IF *)
path[ii] := rpath[ii];
END; (* IF *)
END; (* WITH *)
IF ii < 300 THEN
GEMDOS.SNext(result);
ELSE
showit := FormAlert(1,'[1][The maximum number of files|has been exceeded!][ OK ]');
result := -1;END;
UNTIL result < 0;
END; (* IF *)
match := ' ';
start := 0;
where := 0;
FOR i2 := 0 TO Length(pathstr) DO
IF Pos(pathstr,match,start,where) THEN
Delete(pathstr,where,1); END;
INC(start);
END; (* FOR *)
IF ii > 1 THEN
i1 := 1;
i := 0;
p := 0;
j1 := ii;
init(i,j,i1,j1,s);
j := ii;
sort;
END; (* IF ii > *)
tree1ptr^[fpath + 1].spec^.ptext := ADR(pathstr);
IF initialized THEN
ObjectDraw(tree1ptr,fpath,1,x,y,w,h);END;
GrafMouse(Arrow,NIL);
END MakeArray;
PROCEDURE Directory;
VAR
i : INTEGER;
obspec : etree;
BEGIN
FOR i := 1 TO 12 DO
tree1ptr^[fname2 + i].spec^.ptext := ADR(path[i]);END;
END Directory;
PROCEDURE ClearArray;
VAR
clearstr : String;
obspec : etree;
i : INTEGER;
BEGIN
clearstr := ' ';
FOR i := 0 TO ii DO
path[i] := clearstr;
tree1ptr^[fname2 + 1].spec^.ptext := ADR(path[i]);
END; (* FOR *)
END ClearArray;
PROCEDURE ScrollDown;
VAR
obspec : etree;
i,j : INTEGER;
BEGIN
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,fnametemp,1,x,y,w,h);
j := 0;
IF fcount < ii THEN
DEC(index,11);
FOR i := 1 TO 12 DO
INC(index);
(* obspec^.ptext := ADR(path[index]);*)
tree1ptr^[fname2 + i].spec^.ptext := ADR(path[index]);
ObjectDraw(tree1ptr,fname2 + j,1,x,y,w,h);
INC(j);
END; (* FOR *)
INC(fcount);
tswidth := tswidth + swidth;
tree1ptr^[fnslider + 1].y := INTEGER(TRUNC(tswidth));
ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
END; (* IF *)
END ScrollDown;
PROCEDURE ScrollUp;
VAR
i,j : INTEGER;
obspec : etree;
BEGIN
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
IF fcount > 12 THEN
i := 12;
j := 0;
INC(index,11);
WHILE i # 0 DO
tree1ptr^[fname2 + i].spec^.ptext := ADR(path[index - 12]);
ObjectDraw(tree1ptr,fname13 - j,1,x,y,w,h);
DEC(i);
INC(j);
DEC(index);
END; (* WHILE *)
DEC(fcount);
tswidth := tswidth - swidth;
IF tswidth < 0.0 THEN tswidth := 0.0; END;
tree1ptr^[fnslider + 1].y := INTEGER(TRUNC(tswidth));
ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
END; (* IF *)
END ScrollUp;
PROCEDURE Scroll12;
VAR
obspec : etree;
temp,i,mx,my,mstate,kstate,xoff,yoff : INTEGER;
BEGIN
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
GrafMouseKeyboardState(mx,my,mstate,kstate);
ObjectOffset(tree1ptr,fnslider,xoff,yoff);
IF my > yoff THEN
IF fcount < ii THEN
temp := ii - fcount;
IF temp < 12 THEN
temp := 12 - temp;
fcount := fcount - temp;
index := index - temp;
END;
FOR i := 1 TO 12 DO
INC(fcount);
INC(index);
tree1ptr^[fname2 + i].spec^.ptext := ADR(path[index]);
tswidth := tswidth + swidth;
END; (* FOR *)
IF tswidth + FLOAT(CARDINAL(sh)) > FLOAT(CARDINAL(th)) THEN
tswidth := FLOAT(CARDINAL(th)) - ttswidth;
END;
tree1ptr^[fnslider + 1].y := INTEGER(TRUNC(tswidth));
ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
END;
ELSE
IF fcount > 12 THEN
i := 12;
IF index < 24 THEN
temp := 24 - index;
index := index + temp;
fcount := index;
END;
WHILE i <> 0 DO
tree1ptr^[fname2 + i].spec^.ptext := ADR(path[CARDINAL(index) - 12]);
tswidth := tswidth - swidth;
DEC(index);
DEC(fcount);
DEC(i);
END; (* WHILE *)
IF tswidth < 0.0 THEN tswidth := 0.0 ; END;
tree1ptr^[fnslider + 1].y := INTEGER(TRUNC(tswidth));
ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
END;
END;
END Scroll12;
PROCEDURE FileInfo;
VAR
fobspec,toobspec,obspec : etree;
fname : POINTER TO String;
start,mode,where,count,RESULT : CARDINAL;
fnameaddr,addr : ADDRESS;
which,get : GEMDOS.SetOrGet;
drivepath,fnamestr,resultdrive,resultpath,thestring,temp,match,
tempcurrentname : String;
f,done,p : BOOLEAN;
result,c,i : INTEGER;
BEGIN
fname := tree1ptr^[ftoname + 1].spec^.ptext;
currentname := fname^;
tempcurrentname := currentname;
FOR c := 1 TO ii DO
IF NOT Pos(path[c],'*',0,where) THEN
temp := path[c];
Delete(temp,0,2);
match := ' ';
start := 0;
where := 0;
FOR i := 1 TO Length(temp) DO
IF Pos(temp,match,start,where) THEN
Delete(temp,where,Length(temp) - where); END;
INC(start);
END;
END;
IF Compare(temp,tempcurrentname) = Equal THEN
foundit := c; END;
END;
IF Length(tempcurrentname) > 0 THEN
tree1ptr^[filename +1].spec^.ptext := tree1ptr^[ftoname +1].spec^.ptext;
fname := tree1ptr^[ftoname + 1].spec^.ptext;
currentname := fname^;
tempcurrentname := currentname;
drivepath := CHR(ORD(defaultdrive) + ORD('A'));
Concat(drivepath,':\',resultdrive);
Concat(resultdrive,tempcurrentname,resultpath);
IF Length(ffpath) > 4 THEN
Copy(ffpath,0,Length(ffpath),temp);
f := Pos(temp,'\*.*',0,where);
Delete(temp,where,4);
f := Pos(resultpath,':\',0,where);
Insert(temp,resultpath,where + 1);
END; (* IF *)
which := get;
mode := 0;
GrafMouse(HourGlass,NIL);
GEMDOS.Attrib(resultpath,GEMDOS.get,mode);
addr := ADR(dtarecord);
GEMDOS.SetDTA(addr);
GEMDOS.SFirst(resultpath,0,result);
IF result >= 0 THEN
WITH dtarecord DO
ConvertToString(LONGCARD(size),10,FALSE,thestring,done);
tree1ptr^[fbytes + 1].spec^.ptext := ADR(thestring);
ObjectDraw(tree1ptr,fbytes,1,x,y,w,h);
ConvertDateTime(date,time);
tree1ptr^[fdate + 1].spec^.ptext := ADR(datestr);
ObjectDraw(tree1ptr,fdate,1,x,y,w,h);
tree1ptr^[ftime + 1].spec^.ptext := ADR(tresultstr);
ObjectDraw(tree1ptr,ftime,1,x,y,w,h);
END;(* WITH *)
END; (* IF *)
IF Pos(tempcurrentname,'.',0,where) THEN
IF where < 8 THEN
RESULT := 9 - where - 1;
start := where;
count := 0;
REPEAT
Insert(' ',tempcurrentname,start);
INC(count);
UNTIL count = RESULT;
p := Pos(tempcurrentname,'.',0,where);
END; (* IF where *)
Delete(tempcurrentname,where,1);
(*fobspec^.ptext := ADR(tempcurrentname);*)
tree1ptr^[filename + 1].spec^.ptext := ADR(tempcurrentname);
END; (* IF Pos *)
ObjectDraw(tree1ptr,filename,1,x,y,w,h);
IF mode = 0 THEN
ObjectChange(tree1ptr,frw,0,x,y,w,h,selected,1);
ObjectChange(tree1ptr,fro,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,fro,1,x,y,w,h);
ObjectDraw(tree1ptr,frw,1,x,y,w,h);
ELSE
ObjectChange(tree1ptr,fro,0,x,y,w,h,selected,1);
ObjectChange(tree1ptr,frw,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,frw,1,x,y,w,h);
ObjectDraw(tree1ptr,fro,1,x,y,w,h);
END;
ObjectChange(tree1ptr,finfo,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,finfo,1,x,y,w,h);
ObjectChange(tree1ptr,fset,0,x,y,w,h,Normal,1);
GrafMouse(Arrow,NIL);
ELSE
ObjectChange(tree1ptr,finfo,0,x,y,w,h,Normal,1);
END;
END FileInfo;
PROCEDURE SetTheDrive;
VAR
drvmap : LONGCARD;
obspec : etree;
BEGIN
IF GetObjectState(tree1,drivea,Selected) THEN drive := 0; END;
IF GetObjectState(tree1,driveb,Selected) THEN drive := 1; END;
IF GetObjectState(tree1,drivec,Selected) THEN drive := 2; END;
IF GetObjectState(tree1,drived,Selected) THEN drive := 3; END;
IF GetObjectState(tree1,drivee,Selected) THEN drive := 4; END;
IF GetObjectState(tree1,drivef,Selected) THEN drive := 5; END;
IF GetObjectState(tree1,driveg,Selected) THEN drive := 6; END;
IF GetObjectState(tree1,driveh,Selected) THEN drive := 7; END;
IF GetObjectState(tree1,drivei,Selected) THEN drive := 8; END;
IF GetObjectState(tree1,drivej,Selected) THEN drive := 9; END;
IF GetObjectState(tree1,drivek,Selected) THEN drive := 10; END;
IF GetObjectState(tree1,drivel,Selected) THEN drive := 11; END;
IF GetObjectState(tree1,drivem,Selected) THEN drive := 12; END;
IF GetObjectState(tree1,driven,Selected) THEN drive := 13; END;
IF GetObjectState(tree1,driveo,Selected) THEN drive := 14; END;
IF GetObjectState(tree1,drivep,Selected) THEN drive := 15; END;
GrafMouse(HourGlass,NIL);
GEMDOS.SetDrv(drive,drvmap);
GEMDOS.GetDrv(defaultdrive);
(*ppath := '';
p1 := '';
p2 := '';
p3 := '';
p4 := '';
ffpath := '';
Temp1 := '';
Temp2 := '';
Temp3 := '';
r1 := '';
r2 := '';
r3 := '';
r4 := '';*)
count := 0;
fcount := 12;
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
ClearArray;
MakeArray(globlepath);
Directory;
index := 12;
CalcSliderSize;
ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
GrafMouse(Arrow,NIL);
ClearIt;
END SetTheDrive;
PROCEDURE FirstPath;
BEGIN
Concat('\',farray,r1);
Concat(r1,'\*.*',p1);
ffpath := p1;
END FirstPath;
PROCEDURE SecondPath;
BEGIN
Concat('\',farray,r2);
Concat(r1,r2,Temp1);
Concat(Temp1,'\*.*',p2);
ffpath := p2;
END SecondPath;
PROCEDURE ThirdPath;
BEGIN
Concat('\',farray,r3);
Concat(Temp1,r3,Temp2);
Concat(Temp2,'\*.*',p3);
ffpath := p3;
END ThirdPath;
PROCEDURE FourthPath;
BEGIN
Concat('\',farray,r4);
Concat(Temp2,r4,Temp3);
Concat(Temp3,'\*.*',p4);
ffpath := p4;
END FourthPath;
PROCEDURE MoveName(fname : INTEGER);
VAR
nameobspec,toobspec : etree;
fnameaddr : POINTER TO String;
nothin : String;
l : INTEGER;
where,start : CARDINAL;
BEGIN
fnameaddr := tree1ptr^[fname + 1].spec^.ptext;
farray := fnameaddr^;
match := CHR(5);
IF Pos(farray,match,0,where) THEN
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,fname,0,x,y,w,h,selected,1);
IF count < 4 THEN
INC(count);END;
Delete(farray,0,2);
IF count < 5 THEN
CASE count OF
1 : FirstPath;|
2 : SecondPath;|
3 : ThirdPath;|
4 : FourthPath;
END; (* CASE *)
ClearArray;
MakeArray(ffpath);
Directory;
CalcSliderSize;
index := 12;
fcount := 12;
ObjectChange(tree1ptr,fname,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,fname,1,x,y,w,h);
ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
globlepath := ffpath;
ClearIt;
END;
ELSE
IF NOT Pos(farray,match,0,where) THEN
fnameaddr := tree1ptr^[fname + 1].spec^.ptext;
filearray := fnameaddr^;
Delete(filearray,0,2);
IF Pos(filearray,' ',0,where) THEN
FOR l := where TO Length(filearray) DO
Delete(filearray,where,1);
END; (* FOR *)
END; (* IF *)
nothin := '';
IF Compare(filearray,nothin) <> Equal THEN
fileselection := fname;
tree1ptr^[ftoname + 1].spec^.ptext := ADR(filearray);
ObjectDraw(tree1ptr,ftoname,1,x,y,w,h);
ObjectChange(tree1ptr,fname,0,x,y,w,h,selected,1);
IF fname > fnametemp THEN
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);END;
IF fname < fnametemp THEN
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);END;
fnametemp := fname;
END;
END;
END; (* IF ELSE *)
END MoveName;
PROCEDURE RenameOrSetAttrib;
VAR
start,nb,l,mode,where,regresult,numberofspaces : CARDINAL;
obspec,nobspec : etree;
fnameaddr : POINTER TO String;
which,get,set : GEMDOS.SetOrGet;
pathdrive,newstr,oldstr,npathstr,temp,
tempstr,rnewstr,result,thestring,newname : String;
i,errorcheck : INTEGER;
p,f,done,noerror : BOOLEAN;
BEGIN
start := 0;
noerror := TRUE;
fnameaddr := tree1ptr^[filename + 1].spec^.ptext;
newname := fnameaddr^;
IF Length(newname) > 8 THEN
IF Pos(newname,' ',0,where) THEN
IF (where > 8) OR (where = 0) THEN
Insert('.',newname,where);END;
IF where # 0 THEN
Insert('.',newname,where);
p := Pos(newname,' ',0,where);
nb := where;
Delete(newname,where,9 - where);
END; (* IF where *)
ELSE
Insert('.',newname,8);
END; (* IF Pos(newname) *)
END; (* IF Length(newname) *)
pathdrive := CHR(ORD(defaultdrive) + ORD('A'));
Concat(pathdrive,':\',npathstr);
Concat(npathstr,currentname,oldstr);
Concat(npathstr,newname,newstr);
IF Length(ffpath) > 0 THEN
Copy(ffpath,0,Length(ffpath),temp);
f := Pos(temp,'\*.*',0,where);
Delete(temp,where,4);
f := Pos(oldstr,':\',0,where);
Insert(temp,oldstr,where + 1);
Insert(temp,newstr,where + 1);
END; (* IF *)
IF Compare(currentname,newname) # Equal THEN
IF Length(newname) > 0 THEN
GEMDOS.Rename(oldstr,newstr);
Concat(' ',newname,rnewstr);
tree1ptr^[fileselection + 1].spec^.ptext := ADR(rnewstr);
IF Length(rnewstr) < 14 THEN
numberofspaces := 14 - Length(rnewstr) + 1;
FOR i := 1 TO numberofspaces DO
Concat(rnewstr,' ',rnewstr);result := rnewstr; END;
ELSE
result := rnewstr;
END;
path[foundit] := result;
ObjectDraw(tree1ptr,fileselection,1,x,y,w,h);
ELSE
showit := FormAlert(1,'[1][You did not specify|a name!][ OK ]'); noerror := FALSE;
END;
END;(* IF Compare *)
IF noerror THEN
IF GetObjectState(tree1,frw,Selected) THEN
mode := 0;
ELSE
mode := 1;
END;
which := GEMDOS.set;
GEMDOS.Attrib(oldstr,GEMDOS.set,mode);
ClearIt;
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
END;
ObjectChange(tree1ptr,fset,0,x,y,w,h,disabled,1);
ObjectDraw(tree1ptr,fset,1,x,y,w,h);
END RenameOrSetAttrib;
PROCEDURE FilePath;
VAR
obspec : etree;
start,where : CARDINAL;
found : BOOLEAN;
nothin,clear : String;
BEGIN
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
IF count > 0 THEN
CASE count OF
1 : ppath := '\*.*';
ffpath := '\*.*';
p1 := '';|
2 : ppath := p1;
ffpath := p1;
p2 := '';|
3 : ppath := p2;
ffpath := p2;
p3 := '';|
4 : ppath := p3;
ffpath := p3;
p4 := '';
END;
IF count >= 1 THEN
DEC(count);END;
ClearArray;
MakeArray(ppath);
Directory;
index := 12;
fcount := 12;
CalcSliderSize;
ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
globlepath := ppath;
nothin := '';
IF NOT GetObjectState(tree1,cpyfile,Selected) THEN
filearray := nothin;END;
clear := '';
END;
ClearIt;
END FilePath;
PROCEDURE PrintThePath;
VAR
result : INTEGER;
blanks,blank,rblank,astek,
rpath,path,rrpath,single,double,tsizestr,temppathstr : String;
l,i,t,atrib,where,start : CARDINAL;
BEGIN
WriteString('PATH: ');
temppathstr := pathstr;
match := ' ';
start := 0;
where := 0;
FOR i := 0 TO Length(temppathstr) DO
IF Pos(temppathstr,match,start,where) THEN
Delete(temppathstr,where,1); END;
INC(start);
END; (* FOR *)
WriteString(temppathstr);
WriteLn;
WriteLn;
REPEAT
WITH dtarecord DO
single := '.';
double := '..';
IF (Compare(name,single) # Equal) AND
(Compare(name,double) # Equal) THEN
path := name;
l := Length(path);
IF l < 13 THEN
FOR t := l TO 12 DO
Concat(rblank,' ',rblank);
END; (* FOR *)
Concat(path,rblank,rpath);
rblank := '';
END; (* IF *)
atrib := CARDINAL(attrib);
IF atrib = 16 THEN
Concat('*',rpath,rrpath);
ELSE
Concat(' ',rpath,rrpath);
END; (* IF *)
INC(ct);
WriteString(rrpath);
WriteString(' ');
WriteLongCard(size,6);
WriteString(' ');
tsize := tsize + size;
IF ct = 3 THEN
WriteLn;
ct := 0;
END;(* IF *)
END; (* IF *)
END; (* WITH *)
GEMDOS.SNext(result);
UNTIL result < 0;
ct := 0;
WriteLn;
WriteLn;
ConvertToString(LONGCARD(tsize),10,FALSE,tsizestr,done);
WriteString(tsizestr);
WriteString(' Bytes used in ');
WriteString(temppathstr);
WriteLn;
WriteLn;
GetFreeSpace;
ConvertToString(LONGCARD(free),10,FALSE,freestr,done);
WriteString(freestr);
WriteString(' BYTES Remaining');
WriteLn;
tsize := 0;
END PrintThePath;
PROCEDURE PrintAll;
VAR
result : INTEGER;
blanks,blank,rblank,astek,
rpath,path,rrpath,single,double,tsizestr,temppathstr : String;
l,i,t,atrib,where,start : CARDINAL;
BEGIN
WriteString('PATH: ');
temppathstr := pathstr;
match := ' ';
start := 0;
where := 0;
FOR i := 0 TO Length(temppathstr) DO
IF Pos(temppathstr,match,start,where) THEN
Delete(temppathstr,where,1); END;
INC(start);
END; (* FOR *)
WriteString(temppathstr);
WriteLn;
WriteLn;
WriteString(' File Name Time Date Size');
WriteLn;
WriteLn;
REPEAT
WITH dtarecord DO
single := '.';
double := '..';
IF (Compare(name,single) # Equal) AND
(Compare(name,double) # Equal) THEN
path := name;
l := Length(path);
IF l < 13 THEN
FOR t := l TO 12 DO
Concat(rblank,' ',rblank);
END; (* FOR *)
Concat(path,rblank,rpath);
rblank := '';
END; (* IF *)
atrib := CARDINAL(attrib);
IF atrib = 16 THEN
Concat('*',rpath,rrpath);
ELSE
Concat(' ',rpath,rrpath);
END; (* IF *)
WriteString(rrpath);
ConvertDateTime(date,time);
Insert('-',datestr,2);
Insert('-',datestr,5);
Insert(':',tresultstr,2);
WriteString(' ');
WriteString(tresultstr);
WriteString(' ');
WriteString(datestr);
WriteString(' ');
WriteLongCard(size,6);
WriteString(' ');
WriteLn;
tsize := tsize + size;
END; (* IF *)
END; (* WITH *)
GEMDOS.SNext(result);
UNTIL result < 0;
WriteLn;
WriteLn;
ConvertToString(LONGCARD(tsize),10,FALSE,tsizestr,done);
WriteString(tsizestr);
WriteString(' Bytes used in ');
WriteString(temppathstr);
WriteLn;
WriteLn;
GetFreeSpace;
ConvertToString(LONGCARD(free),10,FALSE,freestr,done);
WriteString(freestr);
WriteString(' BYTES Remaining');
WriteLn;
tsize := 0;
END PrintAll;
PROCEDURE HardCopy;
VAR
addr : ADDRESS;
rprint : BOOLEAN;
BEGIN
addr := ADR(dtarecord);
GEMDOS.SetDTA(addr);
GEMDOS.SFirst(pathstr,16,result);
rprint := BCosStat(PRT);
GrafMouse(HourGlass,NIL);
IF rprint = TRUE THEN
OpenOutputFile("PRN:");
WriteLn;
IF GetObjectState(tree1,fnone,Selected) THEN
PrintThePath;
WriteLn;
OpenOutputFile("CON:");
ELSE
PrintAll;
WriteLn;
OpenOutputFile("CON:");
END; (* IF *)
ELSE
showit := FormAlert(1,"[1][Printer is not|responding!][ OK ]");
END; (* IF *)
GrafMouse(Arrow,NIL);
ObjectChange(tree1ptr,fprint,0,x,y,w,h,Normal,1);
END HardCopy;
PROCEDURE MoveSlider;
VAR
i,sw,sh,tw,th,fx,fy,trackx,tracky,sliderx,slidery,
curyoff : INTEGER;
obspec : etree;
count : REAL;
BEGIN
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
sw := tree1ptr^[fnslider + 1].width + 1;
sh := tree1ptr^[fnslider + 1].height;
tw := tree1ptr^[fntrack + 1].width;
th := tree1ptr^[fntrack + 1].height;
ObjectOffset(tree1ptr,fntrack,trackx,tracky);
ObjectOffset(tree1ptr,fnslider,sliderx,slidery);
GrafDragBox(sw,sh,sliderx,slidery,trackx,tracky,tw,th,fx,fy);
tree1ptr^[fnslider + 1].y := fy - tracky;
ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
count := FLOAT(CARDINAL(fy - tracky)) / swidth;
index := INTEGER(TRUNC(count));
fcount := index;
curyoff := tree1ptr^[fnslider + 1].y;
tswidth := count * swidth;
FOR i := 1 TO 12 DO
INC(fcount);
INC(index);
tree1ptr^[fname2 + i].spec^.ptext := ADR(path[index]);
END; (* FOR *)
ObjectDraw(tree1ptr,fwind,1,x,y,w,h);
oldyoff := curyoff;
END MoveSlider;
PROCEDURE copy(rsfile,rdfile : String);
VAR
infile, outfile,xoff,yoff,ewidth,eheight,stx,sty,stw,sth : INTEGER;
endof : GEMDOS.SeekMode;
position,count : LONGCARD;
done,p,f : BOOLEAN;
cftree,cf2tree : etree;
tempstr,newstr,newnamestr,temp2str,errorstr,thestring : String;
l,where,start,count2,RESULT,nb : CARDINAL;
i : INTEGER;
newnameaddr : POINTER TO String;
BEGIN
start := 0;
where := 0;
GrafMouse(HourGlass,NIL);
GEMDOS.Open(rdfile,0,outfile);
IF outfile >= 0 THEN
match := '\';
FOR i := 0 TO Length(rdfile) DO
IF Pos(rdfile,match,start,where) THEN
INC(start); END;
END;
tempstr := rdfile;
Delete(tempstr,0,start);
start := 0;
where := 0;
IF Pos(tempstr,'.',0,where) THEN
IF where < 8 THEN
RESULT := 9 - where - 1;
start := where;
count2 := 0;
REPEAT
Insert(' ',tempstr,start);
INC(count2);
UNTIL count2 = RESULT;
p := Pos(tempstr,'.',0,where);
END; (* IF where *)
Delete(tempstr,where,1);
END; (* IF Pos *)
tree3ptr^[cfdest + 1].spec^.ptext := ADR(tempstr);
ObjectOffset(tree1ptr,filedlg,xoff,yoff);
tree3ptr^[errdlg + 1].x := xoff;
tree3ptr^[errdlg + 1].y := yoff;
ewidth := tree3ptr^[errdlg + 1].width;
eheight := tree3ptr^[errdlg + 1].height;
stx := (xoff + ewidth) DIV 2;
sty := (yoff + eheight) DIV 2;
stw := 5;
sth := 2;
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
ObjectDraw(tree3ptr,errdlg,1,xx,yy,ww,hh);
ObjectChange(tree3ptr,cfcancel,0,x,y,w,h,Normal,1);
GrafMouse(Arrow,NIL);
showit := FormDo(tree3ptr,0);
therewasanerror := TRUE;
match := '\';
start := 0;
where := 0;
FOR i := 0 TO Length(rdfile) DO
IF Pos(rdfile,match,start,where) THEN
INC(start); END;
END;
temp2str := rdfile;
Delete(temp2str,start,Length(rdfile) - start);
newnameaddr := tree3ptr^[cfdest + 1].spec^.ptext;
newnamestr := newnameaddr^;
where := 0;
start := 0;
nb := 0;
IF Length(newnamestr) > 8 THEN
IF Pos(newnamestr,' ',0,where) THEN
IF (where > 8) OR (where = 0) THEN
Insert('.',newnamestr,where);END;
IF where # 0 THEN
Insert('.',newnamestr,where);
p := Pos(newnamestr,' ',0,where);
nb := where;
Delete(newnamestr,where,9 - where);
END; (* IF where *)
ELSE
Insert('.',newnamestr,8);
END; (* IF Pos(newnamestr) *)
END; (* IF Length(newnamestr) *)
Concat(temp2str,newnamestr,newstr);
rdfile := newstr;
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
IF confirmcopy THEN
ObjectDraw(tree5ptr,copydlg,2,x,y,w,h);
ELSE
ObjectDraw(tree1ptr,fileopts,4,x,y,w,h);END;
END;
IF GetObjectState(tree3,cfok,Selected) THEN
ObjectChange(tree3ptr,cfok,0,x,y,w,h,Normal,0);
END; (* IF *)
IF NOT GetObjectState(tree3,cfcancel,Selected) THEN
GrafMouse(HourGlass,NIL);
GEMDOS.Create(rdfile,0,outfile);
IF outfile >= 0 THEN
GEMDOS.Open(rsfile,0,infile);
REPEAT
done := GEMDOS.Close(outfile);
GEMDOS.Open(rdfile,1,outfile);
GEMDOS.Seek(0,outfile,GEMDOS.end,position);
GEMDOS.Read(infile,Count,bufferaddr);
IF NOT therewasanerror THEN
sizebuffer := sizebuffer + Count;
therewasanerror := FALSE;END;
IF sizebuffer < free THEN
GEMDOS.Write(outfile,Count,bufferaddr);
cresult := 0;
ELSE
Count := 0;
cresult := -1;
showit := FormAlert(1,'[1][There is not enough room|in the destination!][ok]');
f := GEMDOS.Delete(rdfile);END;
UNTIL Count = 0;
done := GEMDOS.Close(outfile);
done := GEMDOS.Close(infile);
GrafMouse(Arrow,NIL);
END; (* outfile *)
ELSE
done := GEMDOS.Close(outfile);
END; (* IF ELSE*)
END copy;
PROCEDURE CopytheFile(sfile,dfile : String);
VAR
sourceobspec,destobspec,conobspec,toobspec : etree;
sfilename,destfilename,fname : POINTER TO String;
tempstr,rsfile,rdfile,errorstr,match,thestring,rstr,currentname : String;
p,wildcard : BOOLEAN;
l,i,start,where,start2,where2 : CARDINAL;
dtaaddr : ADDRESS;
result,numberoffiles : INTEGER;
fnrecord : pathrecord;
sizeaccum,memory : LONGCARD;
BEGIN
sizebuffer := 0;
numberoffiles := 0;
wildcard := FALSE;
sizeaccum := 0;
fname := tree1ptr^[ftoname + 1].spec^.ptext;
currentname := fname^;
IF Length(currentname) > 0 THEN
IF confirmcopy THEN
GEMDOS.SetDTA(ADR(fnrecord));
GEMDOS.SFirst(sfile,0,result);
IF result >= 0 THEN
REPEAT
INC(numberoffiles);
GEMDOS.SNext(result);
UNTIL result < 0;END;
ConvertInteger(numberoffiles,1,thestring);
tree5ptr^[numtocpy + 1].spec^.ptext := ADR(thestring);
ConfirmCopys;
END;
IF (GetObjectState(tree5,condlgok,Selected) OR
(GetObjectState(tree4,cpyno,Selected))) THEN
IF GetObjectState(tree1,cpydst,Selected) THEN
GEMDOS.Alloc(LONGCARD(-1),freememory);
IF LONGCARD(freememory) < 100000 THEN
GEMDOS.Alloc((LONGCARD(freememory) - 20000),bufferaddr);
memory := LONGCARD(freememory);
ELSE
GEMDOS.Alloc(100000,bufferaddr);
memory := 100000;END;
dtaaddr := ADR(fnrecord);
GEMDOS.SetDTA(dtaaddr);
GetFreeSpace;
GEMDOS.SFirst(sfile,0,result);
start := 0;
where := 0;
match := '*.';
start2 := 0;
where2 := 0;
IF Pos(dfile,match,start,where) THEN
wildcard := TRUE;
match := "\";
FOR i := 0 TO Length(dfile) DO
IF Pos(dfile,match,start2,where2) THEN
start2 := where2 + 1;END;
END;
IF start2 # start THEN
start := start2;END;
Delete(dfile,start,Length(dfile) - start); END;
start := 0;
where := 0;
start2 := 0;
where2 := 0;
match := '*.';
IF Pos(sfile,match,start,where) THEN
wildcard := TRUE;
match := "\";
FOR i := 0 TO Length(sfile) DO
IF Pos(sfile,match,start2,where2) THEN
start2 := where2 + 1;END;
END;
IF start2 # start THEN
start := start2;END;
Delete(sfile,start,Length(sfile) - start); END;
IF result >= 0 THEN
REPEAT
IF wildcard THEN
Concat(sfile,fnrecord.name,rsfile);
Concat(dfile,fnrecord.name,rdfile);
ELSE
rsfile := sfile;
rdfile := dfile;END;
Count := memory;
copy(rsfile,rdfile);
IF cresult >= 0 THEN
GEMDOS.SNext(result);END;
therewasanerror := FALSE;
IF confirmcopy THEN
DEC(numberoffiles);
ConvertInteger(numberoffiles,1,thestring);
IF ((numberoffiles >= 10) AND (numberoffiles < 100)) THEN
Concat(' ',thestring,rstr);thestring := rstr;END;
IF numberoffiles < 10 THEN
Concat(' ',thestring,rstr);thestring := rstr;END;
(*conobspec^.ptext := ADR(thestring); *)
tree5ptr^[numtocpy + 1].spec^.ptext := ADR(thestring);
ObjectDraw(tree5ptr,numtocpy,1,x,y,w,h);END;
UNTIL (cresult < 0) OR (result < 0);
END;(* IF *)
cresult := 0;
done := GEMDOS.Free(bufferaddr);
IF NOT GetObjectState(tree3,cfcancel,Selected) THEN
ClearArray;
MakeArray(globlepath);
Directory;
index := 12;
fcount := 12;
CalcSliderSize;
ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
GetFreeSpace;
ELSE
ObjectChange(tree3ptr,cfcancel,0,x,y,w,h,Normal,0);END;
IF therewasanerror THEN
therewasanerror := FALSE; END;
ELSE
errorstr := '[1][A destination path has|not been Selected!][ OK ]';
showit := FormAlert(1,errorstr);
END; (* IF ELSE *)
ELSE
IF NOT confirmcopy THEN
CancelCopy;
ObjectChange(tree5ptr,condlgcl,0,x,y,w,h,Normal,0);END;
END;(* IF ELSE *)
IF confirmcopy THEN
ObjectChange(tree5ptr,condlgok,0,x,y,w,h,Normal,0);
ObjectDraw(tree1ptr,filedlg,4,x,y,w,h);
tree1ptr^[verify + 1].spec^.ptext := ADR(gverifystr);
ObjectDraw(tree1ptr,verify,1,x,y,w,h);END;
ELSE
showit := FormAlert(1,'[1][A file(s) not Specified!][ OK ]');
END;
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,fnametemp,1,x,y,w,h);
tree1ptr^[verify + 1].spec^.ptext := ADR(gverifystr);
ObjectDraw(tree1ptr,verify,1,x,y,w,h);
END CopytheFile;
PROCEDURE CopyDiskorFile;
VAR
totree,fromtree,foptstree : etree;
tostring,fromstring,fileoptstr,
tempstr,sourcename,sourcefile,destfile : String;
result : ARRAY[0..79] OF CHAR;
destobspec,sourceobspec : etree;
destfilename,sfilename : POINTER TO String;
p : BOOLEAN;
l,i,start,where : CARDINAL;
BEGIN
IF GetObjectState(tree1,cpydisk,Selected) THEN
CopyDialog;
ObjectChange(tree1ptr,cpydisk,0,x,y,w,h,Normal,0);
tree1ptr^[verify + 1].spec^.ptext := ADR(gverifystr);
ObjectDraw(tree1ptr,verify,1,x,y,w,h);
END;
IF GetObjectState(tree1,cpyfile,Selected) THEN
start := 0;
p := Pos(sourcepathstr,'*.',start,where);
Delete(sourcepathstr,where,3);
start := 0;
FOR i := 0 TO Length(sourcepathstr) DO
IF Pos(sourcepathstr,' ',start,where) THEN
Delete(sourcepathstr,where,1);
INC(start);
END; (* IF *)
END; (* FOR *)
sfilename := tree1ptr^[ftoname + 1].spec^.ptext;
sourcename := sfilename^;
Concat(sourcepathstr,sourcename,sourcefile);
destfilename := tree1ptr^[ftoname + 1].spec^.ptext;
destname := destfilename^;
tempstr := pathstr;
start := 0;
p := Pos(tempstr,'*.',start,where);
Delete(tempstr,where,3);
where := 0;
start := 0;
FOR i := 0 TO Length(tempstr) DO
IF Pos(tempstr,' ',start,where) THEN
Delete(tempstr,where,1);
INC(start);
END; (* IF *)
END; (* FOR *)
Concat(tempstr,destname,destfile);
CopytheFile(sourcefile,destfile);
ObjectChange(tree1ptr,cpyfile,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,cpydisk,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,verify,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,cpydst,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,cpyscr,0,x,y,w,h,selected,1);
END;
ObjectChange(tree1ptr,cpycopy,0,x,y,w,h,Normal,1);
ClearIt;
END CopyDiskorFile;
PROCEDURE CancelCopy;
BEGIN
IF GetObjectState(tree1,cpydisk,Selected) THEN
ObjectChange(tree1ptr,cpydisk,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,cpydisk,1,x,y,w,h);
END;
IF GetObjectState(tree1,cpyfile,Selected) THEN
ObjectChange(tree1ptr,cpyfile,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,cpydisk,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,cpydst,0,x,y,w,h,Normal,1);
ObjectChange(tree1ptr,cpyscr,0,x,y,w,h,selected,1);
END;
ObjectChange(tree1ptr,cpycancl,0,x,y,w,h,Normal,1);
END CancelCopy;
PROCEDURE ErasetheFile;
VAR
dltobspec,toobspec : etree;
fname : POINTER TO String;
currentname,drivepath,resultdrive,resultpath,temp,rpath,tempstr
,match,thestring,rstr : String;
result,i,numberoffiles : INTEGER;
where,start,l,start2,where2 : CARDINAL;
f : BOOLEAN;
fnrecord : pathrecord;
addr : ADDRESS;
BEGIN
numberoffiles := 0;
fname := tree1ptr^[ftoname + 1].spec^.ptext;
currentname := fname^;
IF Length(currentname) > 0 THEN
drivepath := CHR(ORD(defaultdrive) + ORD('A'));
Concat(drivepath,':\',resultdrive);
Concat(resultdrive,currentname,resultpath);
IF Length(ffpath) > 4 THEN
Copy(ffpath,0,Length(ffpath),temp);
f := Pos(temp,'\*.*',0,where);
Delete(temp,where,4);
f := Pos(resultpath,':\',0,where);
Insert(temp,resultpath,where + 1);
END;
IF confirmdlt THEN
GEMDOS.SetDTA(ADR(fnrecord));
GEMDOS.SFirst(resultpath,0,result);
IF result >= 0 THEN
REPEAT
INC(numberoffiles);
GEMDOS.SNext(result);
UNTIL result < 0;END;
ConvertInteger(numberoffiles,1,thestring);
tree6ptr^[numtocpy + 1].spec^.ptext := ADR(thestring);
ConfirmDeletes;END;
IF (GetObjectState(tree6,dltdlgok,Selected) OR
(GetObjectState(tree4,dltno,Selected))) THEN
addr := ADR(fnrecord);
GEMDOS.SetDTA(addr);
GrafMouse(HourGlass,NIL);
GEMDOS.SFirst(resultpath,0,result);
IF result >= 0 THEN
match := '*.';
start := 0;
where := 0;
start2 := 0;
where2 := 0;
IF Pos(resultpath,match,start,where) THEN
match := "\";
FOR i := 0 TO Length(resultpath) DO
IF Pos(resultpath,match,start2,where2) THEN
start2 := where2 + 1;END;
END;
IF start2 # start THEN
start := start2;END;
ELSE
match := '\';
FOR i := 0 TO Length(resultpath) DO
IF Pos(resultpath,match,start,where) THEN
start := where + 1;END;
END;
END;
Delete(resultpath,start,Length(resultpath) - start);
REPEAT
Concat(resultpath,fnrecord.name,rpath);
f := GEMDOS.Delete(rpath);
IF confirmdlt THEN
DEC(numberoffiles);
ConvertInteger(numberoffiles,1,thestring);
IF ((numberoffiles > 10) AND (numberoffiles < 100)) THEN
Concat(' ',thestring,rstr);thestring := rstr;END;
IF numberoffiles < 10 THEN
Concat(' ',thestring,rstr);thestring := rstr;END;
(*dltobspec^.ptext := ADR(thestring);*)
tree6ptr^[numtocpy + 1].spec^.ptext := ADR(thestring);
ObjectDraw(tree6ptr,numtocpy,1,x,y,w,h);END;
GEMDOS.SNext(result);
UNTIL result < 0;
GrafMouse(Arrow,NIL);
ELSE
showit := FormAlert(1,'[1][File not Found!][OK]');
END; (* IF ELSE *)
ObjectChange(tree1ptr,erase,0,x,y,w,h,Normal,1);
tempstr := pathstr;
Delete(tempstr,0,2);
ClearArray;
MakeArray(tempstr);
Directory;
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,fwind,3,x,y,w,h);
CalcSliderSize;
ObjectChange(tree6ptr,dltdlgok,0,x,y,w,h,Normal,1);
GetFreeSpace;
ELSE
ObjectChange(tree6ptr,dltdlgcl,0,x,y,w,h,Normal,1);
END; (* IF ELSE *)
IF confirmdlt THEN
ObjectDraw(tree1ptr,filedlg,4,x,y,w,h);END;
ELSE
showit := FormAlert(1,'[1][No File(s) was Specified!][ OK ]');
ObjectChange(tree1ptr,erase,0,x,y,w,h,Normal,1);
END;
tree1ptr^[verify + 1].spec^.ptext := ADR(gverifystr);
ObjectDraw(tree1ptr,verify,1,x,y,w,h);
ObjectChange(tree1ptr,erase,0,x,y,w,h,Normal,1);
ClearIt;
ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
END ErasetheFile;
PROCEDURE CreateFolder;
VAR
toobspec : etree;
fname : POINTER TO String;
currentname,drivepath,resultdrive,temp,resultpath,tempstr : String;
where : CARDINAL;
f,done :BOOLEAN;
outfile : INTEGER;
BEGIN
where := 0;
fname := tree1ptr^[ftoname + 1].spec^.ptext;
currentname := fname^;
IF Length(currentname) > 0 THEN
drivepath := CHR(ORD(defaultdrive) + ORD('A'));
Concat(drivepath,':\',resultdrive);
Concat(resultdrive,currentname,resultpath);
IF Length(ffpath) > 4 THEN
Copy(ffpath,0,Length(ffpath),temp);
f := Pos(temp,'\*.*',0,where);
Delete(temp,where,4);
f := Pos(resultpath,':\',0,where);
Insert(temp,resultpath,where + 1);
END;
GrafMouse(HourGlass,NIL);
GEMDOS.Open(resultpath,0,outfile);
IF outfile < 0 THEN
IF NOT GEMDOS.DirCreate(resultpath) THEN
GrafMouse(Arrow,NIL);
showit := FormAlert(1,'[1][A Folder with that name|already exists!][OK]');
ELSE
tempstr := pathstr;
Delete(tempstr,0,2);
ClearArray;
MakeArray(tempstr);
Directory;
ObjectDraw(tree1ptr,fwind,3,x,y,w,h);
CalcSliderSize;
GrafMouse(Arrow,NIL);END;
ELSE
GrafMouse(Arrow,NIL);
showit := FormAlert(1,'[1][A File with that name|already exists!][ OK ]');
done := GEMDOS.Close(outfile);
END; (* IF GEMDOS.Open *)
ELSE
showit := FormAlert(1,'[1][A folder name was|not specified!][ OK ]');
END;
ObjectChange(tree1ptr,fcreate,0,x,y,w,h,Normal,1);
END CreateFolder;
PROCEDURE EraseFolder;
VAR
toobspec : etree;
fname : POINTER TO String;
currentname,drivepath,resultdrive,resultpath,temp,rpath,tempstr
,match,amendpath : String;
result,i : INTEGER;
where,start,l : CARDINAL;
f : BOOLEAN;
fnrecord : pathrecord;
addr : ADDRESS;
BEGIN
fname := tree1ptr^[ftoname + 1].spec^.ptext;
currentname := fname^;
IF Length(currentname) > 0 THEN
drivepath := CHR(ORD(defaultdrive) + ORD('A'));
Concat(drivepath,':\',resultdrive);
Concat(resultdrive,currentname,resultpath);
IF Length(ffpath) > 4 THEN
Copy(ffpath,0,Length(ffpath),temp);
f := Pos(temp,'\*.*',0,where);
Delete(temp,where,4);
f := Pos(resultpath,':\',0,where);
Insert(temp,resultpath,where + 1);
END;
addr := ADR(fnrecord);
GEMDOS.SetDTA(addr);
GrafMouse(HourGlass,NIL);
Concat(resultpath,'\*.*',resultpath);
GEMDOS.SFirst(resultpath,16,result);
IF result >= 0 THEN
match := '\*.*';
IF Pos(resultpath,match,start,where) THEN
Delete(resultpath,where,Length(resultpath) - where);
ELSE
match := '\';
start := 0;
where := 0;
FOR i := 0 TO Length(resultpath) DO
IF Pos(resultpath,match,start,where) THEN
INC(start);END;
END; (* FOR *)
Delete(resultpath,start,Length(resultpath) - start);
END; (* IF ELSE *)
Concat(resultpath,'\',resultpath);
REPEAT
Concat(resultpath,fnrecord.name,rpath);
f := GEMDOS.Delete(rpath);
GEMDOS.SNext(result);
UNTIL result < 0;
f := GEMDOS.DirDelete(resultpath);
GrafMouse(Arrow,NIL);
ELSE
showit := FormAlert(1,'[1][ |File not Found!][OK]');
END; (* IF ELSE *)
tempstr := pathstr;
Delete(tempstr,0,2);
ClearArray;
MakeArray(tempstr);
Directory;
ObjectChange(tree1ptr,ferase,0,x,y,w,h,Normal,1);
ObjectDraw(tree1ptr,fwind,3,x,y,w,h);
CalcSliderSize;
GetFreeSpace;
ELSE
showit := FormAlert(1,'[1][A folder name was|not specified!][ OK ]');
END;
END EraseFolder;
PROCEDURE EraseOrCreate;
BEGIN
IF GetObjectState(tree1,fcreate,Selected) THEN
CreateFolder;
ObjectChange(tree1ptr,fcreate,0,x,y,w,h,Normal,1);END;
IF GetObjectState(tree1,ferase,Selected) THEN
EraseFolder;
ObjectChange(tree1ptr,ferase,0,x,y,w,h,Normal,1);END;
ObjectChange(tree1ptr,fldok,0,x,y,w,h,Normal,1);
ClearIt;
END EraseOrCreate;
PROCEDURE GetOptions;
VAR
stx,sty,stw,sth,ewidth,eheight,xoff,yoff : INTEGER;
copyyes,deleteyes : BOOLEAN;
BEGIN
ObjectOffset(tree1ptr,fileopts,xoff,yoff);
tree4ptr^[optdlg + 1].x := xoff;
tree4ptr^[optdlg + 1].y := yoff;
ewidth := tree4ptr^[optdlg + 1].width;
eheight := tree4ptr^[optdlg + 1].height;
stx := (xoff + ewidth) DIV 2;
sty := (yoff + eheight) DIV 2;
stw := 5;
sth := 2;
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
ObjectDraw(tree4ptr,optdlg,2,xx,yy,ww,hh);
IF GetObjectState(tree4,cpyyes,Selected) THEN
copyyes := TRUE; ELSE copyyes := FALSE;END;
IF GetObjectState(tree4,dltyes,Selected) THEN
deleteyes := TRUE; ELSE deleteyes := FALSE;END;
showit := FormDo(tree4ptr,0);
IF GetObjectState(tree4,conok,Selected) THEN
IF GetObjectState(tree4,cpyyes,Selected) THEN
confirmcopy := TRUE; ELSE confirmcopy := FALSE; END;
IF GetObjectState(tree4,dltyes,Selected) THEN
confirmdlt := TRUE; ELSE confirmdlt := FALSE; END;
ObjectChange(tree4ptr,conok,0,x,y,w,h,Normal,0);
END; (* IF *)
IF GetObjectState(tree4,concancl,Selected) THEN
IF copyyes THEN
ObjectChange(tree4ptr,cpyyes,0,x,y,w,h,selected,0);
ObjectChange(tree4ptr,cpyno,0,x,y,w,h,Normal,0);
ELSE
ObjectChange(tree4ptr,cpyyes,0,x,y,w,h,Normal,0);
ObjectChange(tree4ptr,cpyno,0,x,y,w,h,selected,0);END;
IF deleteyes THEN
ObjectChange(tree4ptr,dltyes,0,x,y,w,h,selected,0);
ObjectChange(tree4ptr,dltno,0,x,y,w,h,Normal,0);
ELSE
ObjectChange(tree4ptr,dltyes,0,x,y,w,h,Normal,0);
ObjectChange(tree4ptr,dltno,0,x,y,w,h,selected,0);END;
ObjectChange(tree4ptr,concancl,0,x,y,w,h,Normal,0);
END;
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
ObjectChange(tree1ptr,options,0,x,y,w,h,Normal,0);
ObjectDraw(tree1ptr,fileopts,4,x,y,w,h);
tree1ptr^[verify + 1].spec^.ptext := ADR(gverifystr);
ObjectDraw(tree1ptr,verify,1,x,y,w,h);
END GetOptions;
PROCEDURE ConfirmCopys;
VAR
stx,sty,stw,sth,ewidth,eheight,xoff,yoff : INTEGER;
BEGIN
ObjectOffset(tree1ptr,filedlg,xoff,yoff);
tree5ptr^[copydlg + 1].x := xoff;
tree5ptr^[copydlg + 1].y := yoff;
ewidth := tree5ptr^[copydlg + 1].width;
eheight := tree5ptr^[copydlg + 1].height;
stx := (xoff + ewidth) DIV 2;
sty := (yoff + eheight) DIV 2;
stw := 5;
sth := 2;
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
ObjectDraw(tree5ptr,copydlg,2,xx,yy,ww,hh);
showit := FormDo(tree5ptr,0);
IF GetObjectState(tree5,condlgcl,Selected) THEN
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);END;
ObjectChange(tree5ptr,condlgcl,0,x,y,w,h,Normal,0);
ObjectChange(tree1ptr,options,0,x,y,w,h,Normal,0);
END ConfirmCopys;
PROCEDURE ConfirmDeletes;
VAR
stx,sty,stw,sth,ewidth,eheight,xoff,yoff : INTEGER;
BEGIN
ObjectOffset(tree1ptr,filedlg,xoff,yoff);
tree6ptr^[dltdlg + 1].x := xoff;
tree6ptr^[dltdlg + 1].y := yoff;
ewidth := tree6ptr^[dltdlg + 1].width;
eheight := tree6ptr^[dltdlg + 1].height;
stx := (xoff + ewidth) DIV 2;
sty := (yoff + eheight) DIV 2;
stw := 5;
sth := 2;
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
ObjectDraw(tree6ptr,copydlg,2,xx,yy,ww,hh);
showit := FormDo(tree6ptr,0);
IF GetObjectState(tree6,dltdlgcl,Selected) THEN
GrafShrinkBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);
GrafGrowBox(stx,sty,stw,sth,xoff,yoff,ewidth,eheight);END;
ObjectChange(tree6ptr,dltdlgcl,0,x,y,w,h,Normal,0);
ObjectChange(tree1ptr,options,0,x,y,w,h,Normal,0);
END ConfirmDeletes;
PROCEDURE CheckDrivesAvail;
BEGIN
FOR d := 0 TO 15 DO
ObjectChange(tree1ptr,drivea + d,0,x,y,w,h,disabled,0);
END;
drv := DriveMap();
FOR d := 0 TO 15 DO
IF d IN drv THEN
ObjectChange(tree1ptr,drivea + d,0,x,y,w,h,Normal,0);END;
END; (* FOR *)
END CheckDrivesAvail;
PROCEDURE SelectDrive;
BEGIN
ObjectChange(tree1ptr,drivea + INTEGER(defaultdrive),0,x,y,w,h,selected,0);
END SelectDrive;
PROCEDURE LoadResource;
CONST
CRFilename = ':\THEACCC.RSC';
MRFilename = ':\THEACCM.RSC';
VAR
rname,pathdrive,path : String;
BEGIN
GEMDOS.GetDrv(defaultdrive);
pathdrive := CHR(ORD(defaultdrive) + ORD('A'));
IF resolution = 1 THEN
rname := CRFilename;
ELSE
rname := MRFilename;
END;
Concat(pathdrive,rname,path);
ResourceLoad(path);
IF AESCallResult = 0 THEN
loaded := FALSE; ELSE loaded := TRUE; END;
END LoadResource;
PROCEDURE Initialize;
VAR
fromobspec : etree;
path,blank : String;
objflagsint,x,y,w,h,showit,objstate,objtype,objx,objy,
xoff,yoff : INTEGER;
objflags : BITSET;
BEGIN
blank := '';
sectorspertrack := 9;
fcount := 12;
count := 0;
tracksperdisk := 79;
nine := 1;
ResourceGetAddr(0,tree1,tree1ptr);
ResourceGetAddr(0,tree2,tree2ptr);
ResourceGetAddr(0,tree3,tree3ptr);
ResourceGetAddr(0,tree4,tree4ptr);
ResourceGetAddr(0,tree5,tree5ptr);
ResourceGetAddr(0,tree6,tree6ptr);
initialized := FALSE;
clearfirst := TRUE;
tree1ptr^[ftrack + 1].width := 82;
tree1ptr^[fslider + 1].width := 80;
tree1ptr^[fslider + 1].x := tree1ptr^[ftrack + 1].x + 1;
SuperExec(PROC(GetVerifyFlag));
vint := INTEGER(verifyflag);
DoVerify;
CheckDrivesAvail;
GEMDOS.GetDrv(defaultdrive);
GEMDOS.SetDrv(defaultdrive,drivemap);
fnametemp := fname2;
fffpath := '\*.*';
ClearArray;
MakeArray(fffpath);
globlepath := fffpath;
Directory;
pathdrive := CHR(ORD(defaultdrive) + ORD('A'));
Concat(pathdrive,':\*.*',presult);
pathstr := presult;
sourcepathstr := pathstr;
tree1ptr^[ftoname + 1].spec^.ptext := ADR(blank);
tree1ptr^[filename + 1].spec^.ptext := ADR(blank);
CalcSliderSize;
initialized := TRUE;
confirmcopy := TRUE;
confirmdlt := TRUE;
therewasanerror := FALSE;
index := 12;
ObjectChange(tree1ptr,fset,0,x,y,w,h,Normal,0);
END Initialize;
PROCEDURE EventLoop;
BEGIN
CheckDrivesAvail;
GEMDOS.GetDrv(appldrive);
GEMDOS.SetDrv(defaultdrive,drivemap);
SelectDrive;
newwind := WindowCreate(0,0,0,640,200);
FormCenter(tree1ptr,x,y,w,h);
FormDialogue(1,0,0,0,0,x,y,w,h);
WindowOpen(newwind,x,y,w,h);
ObjectDraw(tree1ptr,0,5,x,y,w,h);
tree1ptr^[verify + 1].spec^.ptext := ADR(gverifystr);
ObjectDraw(tree1ptr,verify,1,x,y,w,h);
GrafMouse(Arrow,NIL);
REPEAT
selobspec := etree(tree1ptr^[ftoname + 1].spec);
selection := selobspec^.ptext;
(*selection := tree1ptr^[ftoname].spec^.ptext;*)
selpathstr := selection^;
selobspec^.ptext := ADR(selpathstr);
(* tree1ptr^[ftoname + 1].spec^.ptext := ADR(selpathstr);*)
IF GetObjectState(tree1,cpyscr,Selected) THEN
sourcepathstr := pathstr;
globlepath := fffpath; END;
showit := FormDo(tree1ptr,ftoname);
CASE showit OF
format : Formatdisk(tree1,fslider,tree1ptr);|
drvfree : GetFreeSpace;|
verify : DoVerify;|
cpycopy : CopyDiskorFile;|
fspt : Changespt;|
fup : ScrollUp;|
fdown : ScrollDown;|
fname2..fname13 : MoveName(showit);|
finfo : FileInfo;|
fset : RenameOrSetAttrib;|
fpath : FilePath;|
fprint : HardCopy;|
fnslider : MoveSlider;|
cpycancl : CancelCopy;|
fntrack : Scroll12;|
erase : ErasetheFile;|
fldok : EraseOrCreate;|
options : GetOptions;|
drivea..drivep : SetTheDrive;|
END; (* CASE *)
UNTIL GetObjectState(tree1,mainexit,Selected);
WindowClose(newwind);
WindowDelete(newwind);
FormDialogue(2,0,0,0,0,x,y,w,h);
ObjectChange(tree1ptr,mainexit,0,x,y,w,h,Normal,0);
GEMDOS.SetDrv(appldrive,drivemap);
END EventLoop;
BEGIN
SETREG(15,ADR(stack[stacksize]));
apid := ApplInitialise();
accname := ' The Accessory';
menuid := MenuRegister(apid,accname);
resolution := GetResolution();
IF apid >= 0 THEN
IF resolution # 0 THEN LoadResource; END;
IF loaded THEN Initialize ;END;
WHILE TRUE DO
event := EventMultiple(MesageEvent,0,0,0,0,0,0,0,0,0,0,0,0,0,
ADR(pbuffer[0]),
0,0,dummy,dummy,dummy,dummy,dummy,
dummy);
IF (event = MesageEvent) THEN
IF resolution # 0 THEN
IF loaded THEN
CASE pbuffer[0] OF
40 : EventLoop;
END;(* CASE *)
ELSE
CASE pbuffer[0] OF
40 : showit := FormAlert(1,'[1][Resource File not Loaded!][ OK ]');
END;(* CASE *)
END; (* IF loaded *)
ELSE
CASE pbuffer[0] OF
40 : showit := FormAlert(1,'[1][This accessory operates|in only medium or|high resolution!][ OK ]');
END; (* CASE *)
END; (* IF resolution *)
END; (* IF event *)
END; (* WHILE *)
END; (* IF apid *)
END TRYIT.