home *** CD-ROM | disk | FTP | other *** search
- /*MAC2E triton.e*/
-
- /*
- ** Written by Karol Bryd of BlaBla
- **
- ** 1.0 - 28.08.96 - first public version, this version used only unpack.library
- ** 1.1 - 23.01.97 - added posibility of using xfdmaster.library
- **
- */
-
- OPT OSVERSION=37
- OPT PREPROCESS
-
- MODULE 'triton','utility/tagitem','unpack','libraries/unpack', 'exec/memory'
- MODULE 'ReqTools','libraries/reqtools','intuition/intuition', 'xfdmaster', 'libraries/xfdmaster'
- MODULE 'exec/lists', 'exec/nodes','dos/dos','exec/io','gadtools','libraries/gadtools'
- MODULE 'intuition/gadgetclass','devices/trackdisk','exec/io','exec/ports'
-
- ENUM ERR_OK,ERR_LIB,ERR_PRJ,ERR_APP,ERR_LIBT,ERR_LIBU,ERR_INFOC,ERR_KICK,
- ERR_LIBR,ERR_LOCK,ERR_WIN,ERR_VISUAL,ERR_LIBG,ERR_RTALLOC
-
- ENUM NONE,DETER,UNPACK,LOAD,SAVE
-
- OBJECT tr_Message
- trm_Project:LONG
- trm_ID
- trm_Class
- trm_Data
- trm_Code
- trm_Qualifier
- trm_Seconds
- trm_Micros
- trm_App:LONG
- ENDOBJECT
-
- DEF name[250]:STRING,
- file[250]:STRING,
- path[250]:STRING,
- path2[250]:STRING,
- loaddir[250]:STRING,
- length,address,
- application=NIL,project,
- list=NIL:PTR TO mlh,sver,
- cinfo:PTR TO unpackinfo,
- err=NIL,openhd=NIL,
- string[200]:STRING,
- cnt=NIL,dinfo=NIL,tracknr=NIL,
- abort=FALSE,
- win=NIL:PTR TO window,
- glist=NIL,visual,scr,
- gad:PTR TO gadget,len,
- mainwin=NIL,reql:PTR TO rtfilerequester,
- flist:PTR TO rtfilelist,pos=NIL,unit=NIL,
- reqs:PTR TO rtfilerequester,
- xfdbuffer:PTR TO xfdbufferinfo,
- password:PTR TO CHAR, unpackl, xfdl, slaves, over, saved=TRUE
-
-
- PROC main() HANDLE
-
- sver:='$VER: Unpack Utility 1.1 (23.01.97)\0'
-
- IF (KickVersion(37))=NIL THEN Raise(ERR_KICK)
- IF (tritonbase:=OpenLibrary('triton.library',1))=NIL THEN Raise(ERR_LIBT)
-
- xfdl:=unpackl:=TRUE
- IF (unpackbase:=OpenLibrary('unpack.library',34))=NIL THEN unpackl:=0
- IF (xfdmasterbase:=OpenLibrary('xfdmaster.library', 37))=NIL THEN xfdl:=0
-
- IF xfdl=unpackl=NIL THEN Raise(ERR_LIB)
-
- IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))=NIL THEN Raise(ERR_LIBR)
- IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise(ERR_LIBG)
-
- IF (application:=Tr_CreateApp([TRCA_Name,'Unpack Utility',
- TRCA_Info,'Program to decrunching files, uses unpack.library & xfdmaster.library',
- TRCA_Version,'1.1',TRCA_Date,'23.01.97',0]))=NIL THEN Raise(ERR_APP)
-
- IF (cinfo:=UpAllocCInfo())=NIL THEN Raise(ERR_INFOC)
-
- IF (reql:=RtAllocRequestA(0,0))=NIL THEN Raise(ERR_RTALLOC)
- IF (reqs:=RtAllocRequestA(0,0))=NIL THEN Raise(ERR_RTALLOC)
-
- NEW list;initlist(list)
-
- LEA store(PC),A0
- MOVE.L A4,(A0)
-
- StrCopy(path,'ram:',ALL)
-
- doMain(application)
- Raise(ERR_OK)
- EXCEPT
- SELECT exception
- CASE ERR_LIBT
- WriteF('No triton.library !\n')
- CASE ERR_KICK
- WriteF('Needed Kickstart v.2.04+\n')
- CASE ERR_APP
- WriteF('Could not create triton application\n')
- CASE ERR_PRJ
- WriteF('Could not create triton project\n')
- CASE ERR_LIB
- WriteF('No xfdmaster.library or unpack.library !\n')
- CASE ERR_INFOC
- WriteF('Could not create unpackinfo structure\n')
- CASE ERR_LIBR
- WriteF('No reqtools.library\n')
- CASE ERR_RTALLOC
- WriteF('Could not create rtallocrequest structure\n')
- ENDSELECT
- closeall()
- CleanUp(0)
- ENDPROC
-
- PROC closeall()
-
- IF reql THEN RtFreeRequest(reql)
- IF reqs THEN RtFreeRequest(reqs)
- IF mainwin THEN Tr_ReleaseWindow(mainwin)
- IF application THEN Tr_DeleteApp(application)
- IF cinfo THEN UpFreeCInfo(cinfo)
- IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
- IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
- IF unpackbase THEN CloseLibrary(unpackbase)
- IF xfdmasterbase THEN CloseLibrary(xfdmasterbase)
- IF tritonbase THEN CloseLibrary(tritonbase)
-
- ENDPROC
-
- PROC doMain(app)
-
- DEF trmsg:PTR TO tr_Message, close_me=FALSE, class, id
-
- slaves:=TRMF_CHECKIT
- over:=TRMF_CHECKIT
-
- project:=Tr_OpenProject(app,[WindowTitle('Unpack Utility 1.1'),WindowPosition(TRWP_CENTERDISPLAY),WindowUnderscore('_'), WindowID(1),
- BeginMenu('Information'), MenuItem('A_About', 11), ItemBarlabel, MenuItem('Q_Quit', 12),
- BeginMenu('Preferences'), MenuItem('U_Use external slaves', 13), TRMN_Flags, slaves, MenuItem('O_Overwrite?', 14), TRMN_Flags, over,
-
-
- VertGroupA,
- Space,
- HorizGroupA,
- Space, Button('_Unpack',1), Space,
- EndGroup,
- VertGroupA,
-
- -> Space,Button('Preferences',2), /* maybe somewhere in future... */
-
- SpaceS,
-
- HorizGroupA,
- Space, Button('_About',3), Space,
- EndGroup,
-
- SpaceS,
- HorizGroupA,
- Space,ListRO(list,4,0),Space,
- EndGroup,
-
- SpaceS, NamedSeparator('Actual File'), SpaceS,
-
- HorizGroupA,
- Space, StringGadget(0,5),Space,
- EndGroup,
-
- SpaceS, NamedSeparator('Path for LHA'), SpaceS,
-
- HorizGroupA,
- Space, StringGadget(path,6), GetDrawerButton(7), Space,
- EndGroup,
-
- EndGroup, Space, EndGroup, Space,
- EndProject])
-
- Tr_SetAttribute(project,6,0,path)
- mainwin:=Tr_ObtainWindow(project)
-
- WHILE (close_me=FALSE)
- Tr_Wait(app,NIL)
- IF (trmsg:=Tr_GetMsg(app))
- IF (trmsg.trm_Project=project)
- class:=trmsg.trm_Class
- id:=trmsg.trm_ID
- SELECT class
- CASE TRMS_CLOSEWINDOW
- close_me:=TRUE
-
- CASE TRMS_NEWVALUE
- IF id=13 THEN IF slaves=TRMF_CHECKED THEN slaves:=TRMF_CHECKIT ELSE slaves:=TRMF_CHECKED
- IF id=14 THEN IF over=TRMF_CHECKED THEN over:=TRMF_CHECKIT ELSE over:=TRMF_CHECKED
-
- IF id=6
- StrCopy(path2,Tr_GetAttribute(project,6,0),ALL)
-
- pos:=(StrLen(path2)-1)+path2
-
- IF (Char(pos)<>Char(':'))
- IF(Char(pos)<>Char('/'))
- StrCopy(path, path2, ALL)
- StrAdd(path, '/', 1)
- ELSE
- StrAdd(path, path2, ALL)
- ENDIF
- ELSE
- StrAdd(path, path2, ALL)
- ENDIF
- ENDIF
-
- CASE TRMS_ACTION
- SELECT id
-
- CASE 1
- IF StrLen(path)>1
- IF (request(LOAD))
- REPEAT
- IF flist THEN makeallnames(flist.name)
- flist:=flist.next
- tracknr:=0
- Tr_SetAttribute(project,5,0,file)
- StringF(string,'Loading and unpacking file:\s',file)
- dodaj(list,string)
- StringF(string,'File length:\d bytes',FileLength(name))
- dodaj(list,string)
-
-
- IF xfdl THEN err:=decrunchxfd(name)
-
- IF err<>0 AND unpackl
-
- err:=unpack(name)
-
- IF err=NONE
- StringF(string,'Unpacked length:\d bytes',length)
- dodaj(list,string)
- IF (cinfo.crunchtype<>1) AND (cinfo.crunchtype<>5)
- IF (request(SAVE))
- IF FileLength(name)<>-1
- IF over=TRMF_CHECKIT THEN cnt:=reqtoolsreq('Overwrite ?', 'YES|NO!')
- IF cnt=1
-
- IF (openhd:=Open(name,MODE_NEWFILE))
- IF Write(openhd,address,length)<>0 THEN saved:=TRUE ELSE saved:=FALSE
- Close(openhd)
- UpFreeFile(cinfo)
- ENDIF
-
- ELSE
- saved:=FALSE
- ENDIF
- ELSE
- IF (openhd:=Open(name,MODE_NEWFILE))
- IF Write(openhd,address,length)<>0 THEN saved:=TRUE ELSE saved:=FALSE
- Close(openhd)
- UpFreeFile(cinfo)
- ENDIF
- ENDIF
- ELSE
- saved:=FALSE
- ENDIF
- ENDIF
- IF saved=TRUE THEN dodaj(list,'File saved') ELSE dodaj(list, 'File not saved')
- ELSE
- whyfail(err)
- ENDIF
- ENDIF
- dodaj(list,'------------------------')
- UNTIL flist=NIL
- RtFreeFileList(flist)
- ENDIF
- ELSE
- reqtoolsreq('You MUST enter path(e.g. ram: or something else)','OK')
- ENDIF
- CASE 7
- Tr_SetAttribute(project,6,0,setpath())
- CASE 3
- about()
- CASE 11
- about()
- CASE 12
- close_me:=TRUE
- ENDSELECT
- ENDSELECT
- Tr_ReplyMsg(trmsg)
- ENDIF
- ENDIF
- ENDWHILE
- Tr_CloseProject(project)
- ENDPROC
-
- PROC about()
- ENDPROC reqtoolsreq('Unpack Utility v.1.1\n' +
- 'This program uses unpack.library\n' +
- 'and xfdmaster.library\n\n' +
- 'This is another production of...\n' +
- 'BlaBla\n\n' +
- 'This program is CardWare.\n' +
- 'If you like it, send me a postcard\n' +
- 'of your country or city.\n' +
- 'For bug reports, new ideas write to:\n\n' +
- 'Karol Bryd\nPiaski Brzustowskie 194a\n' +
- '27-520 Cmielow\n' +
- 'woj. tarnobrzeg\n' +
- 'POLAND\n\n' +
- 'email: thufor@zeus.polsl.gliwice.pl\n' +
- 'or kordi@lodz2.p.lodz.pl' ,'OK')
-
- PROC decrunchxfd(sourcename)
-
- DEF error, fh, maxpasswordlen
-
- IF (xfdbuffer:=XfdAllocObject(XFDOBJ_BUFFERINFO))=NIL THEN RETURN ERR_MEMORY
- len:=FileLength(sourcename)
- IF slaves=TRMF_CHECKED THEN xfdbuffer.flags:=XFDFF_RECOGEXTERN
-
- xfdbuffer.sourcebuflen:=len
- xfdbuffer.sourcebuffer:=New(len)
- IF xfdbuffer.sourcebuffer=NIL
- XfdFreeObject(xfdbuffer)
- RETURN ERR_MEMORY
- ENDIF
-
- IF (fh:=Open(sourcename, MODE_OLDFILE))=NIL THEN error:=ERR_OPEN
- IF (Read(fh, xfdbuffer.sourcebuffer, len))=NIL THEN error:=ERR_READWRITE
- IF fh THEN Close(fh)
-
- IF XfdRecogBuffer(xfdbuffer)
-
- dodaj(list, 'Unpacking file using xfdmaster.library')
- StringF(string, 'File packed with:\s', xfdbuffer.packername)
- dodaj(list, string)
-
- IF xfdbuffer.packerflags AND XFDPFF_PASSWORD
-
- IF xfdbuffer.error=-1 THEN maxpasswordlen:=63 ELSE maxpasswordlen:=xfdbuffer.error
-
- password:=String(maxpasswordlen)
-
- RtGetStringA(password, maxpasswordlen, 'Enter password:', NULL, NIL)
-
- xfdbuffer.special:=password
-
- ELSEIF xfdbuffer.packerflags AND XFDPFF_KEY16
- RtGetLongA(xfdbuffer.special, 'Enter password', NIL, [RTGL_MIN, 0, RTGL_MAX, $ffff, TAG_DONE])
-
- ELSEIF xfdbuffer.packerflags AND XFDPFF_KEY32
- RtGetLongA(xfdbuffer.special, 'Enter password', NIL, [RTGL_MIN, 0, RTGL_MAX, $ffffffff, TAG_DONE])
-
- ELSE
- xfdbuffer.special:=NIL
- ENDIF
-
- xfdbuffer.targetbufmemtype:=MEMF_ANY
-
- IF XfdDecrunchBuffer(xfdbuffer)
-
- IF request(SAVE)
- IF FileLength(name)<>-1
- maxpasswordlen:=1
- IF over=TRMF_CHECKIT THEN maxpasswordlen:=reqtoolsreq('Overwrite ?', 'YES|NO!')
- IF maxpasswordlen=1
-
- IF (fh:=Open(name, MODE_NEWFILE))=NIL
- FreeMem(xfdbuffer.targetbuffer, xfdbuffer.targetbuflen)
- RETURN ERR_OPEN
- ENDIF
-
- IF Write(fh, xfdbuffer.targetbuffer, xfdbuffer.targetbufsavelen)<>0 THEN saved:=TRUE ELSE saved:=FALSE
- IF fh THEN Close(fh)
- ELSE
- saved:=FALSE
- ENDIF
- ELSE
- IF (fh:=Open(name, MODE_NEWFILE))=NIL
- FreeMem(xfdbuffer.targetbuffer, xfdbuffer.targetbuflen)
- RETURN ERR_OPEN
- ENDIF
-
- IF Write(fh, xfdbuffer.targetbuffer, xfdbuffer.targetbufsavelen)<>0 THEN saved:=TRUE ELSE saved:=FALSE
- IF fh THEN Close(fh)
- ENDIF
-
- FreeMem(xfdbuffer.targetbuffer, xfdbuffer.targetbuflen)
- StringF(string, 'Length of unpacked file:\d', xfdbuffer.targetbufsavelen)
- IF saved=TRUE
- dodaj(list, string)
- dodaj(list, 'File saved')
- ELSE
- dodaj(list, 'File not saved')
- ENDIF
- error:=0
- ELSE
- dodaj(list,'File not saved')
- ENDIF
- ELSE
- error:=xfdbuffer.error
- ENDIF
-
- ELSE
- error:=xfdbuffer.error
- ENDIF
-
- Dispose(xfdbuffer.sourcebuffer)
- IF xfdbuffer THEN XfdFreeObject(xfdbuffer)
-
- ENDPROC error
-
- PROC moveup()
-
- cnt:=cnt+1
- Tr_SetAttribute(project,4,TAG_USER+1506,cnt)
-
- ENDPROC
-
- PROC makeallnames(nazwa)
-
- StrCopy(name,loaddir,ALL)
- StrCopy(file, nazwa, ALL)
- AddPart(name, nazwa, 150)
- ENDPROC
-
- /* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% */
- /* Procedury do obslugi list linkowalnych(laczonych) */
- /* */
- /* Przy pisaniu tych procedur opieralem sie czesciowo na kodzie zrodlowym */
- /* autorstwa Frank Verheyen */
- /* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% */
-
- PROC initlist(lista:PTR TO mlh)
-
- lista.head:=lista+4
- lista.tail:=0
- lista.tailpred:=lista
-
- ENDPROC
- PROC dodaj(lista:PTR TO mlh,string)
-
- DEF len=0,node:PTR TO ln,nnode:PTR TO ln
-
- len:=StrLen(string)
- nnode:=New(SIZEOF ln)
- nnode.name:=String(len)
- nnode.succ:=0
- StrCopy(nnode.name,string,ALL)
- node:=lista.head
- IF lista.tailpred=lista
- AddHead(lista,nnode)
- ELSE
- AddTail(lista,nnode)
- ENDIF
- Tr_SetAttribute(project,4,0,list)
- moveup()
-
- ENDPROC
- PROC unpack(filename)
-
- DEF id, class2, select, start, test=0
- DEF msg:PTR TO intuimessage, unittxt[25]:STRING
-
- cinfo.jump:=NIL
- cinfo.trackjump:={scantrack}
- cinfo.path:=path
- cinfo.filename:=filename
- cinfo.loadnamepoi:=NIL
- cinfo.lhapattern:=NIL
-
- IF UpDetermineFile(cinfo,filename)=NIL
- RETURN cinfo.errornum
- ENDIF
-
- IF cinfo.crunchtype<>1 THEN cinfo.flag:=5 ELSE cinfo.flag:=0
-
- StringF(string,'File crunched with:\s',cinfo.crunchername)
- dodaj(list,string)
- IF cinfo.crunchtype=5
- IF (scr:=LockPubScreen(0))=NIL THEN Raise(ERR_LOCK)
- IF (visual:=GetVisualInfoA(scr,0))=NIL THEN Raise(ERR_VISUAL)
- gad:=CreateContext({glist})
- gad:=CreateGadgetA(BUTTON_KIND,gad,[5,12,75,15,'ABORT',NIL,1,0,visual,0]:newgadget,[GA_DISABLED,FALSE,GA_RELVERIFY,TRUE,0])
- gad:=CreateGadgetA(BUTTON_KIND,gad,[82,12,72,15,'START',NIL,2,0,visual,0]:newgadget,[GA_DISABLED,FALSE,GA_RELVERIFY,TRUE,0])
- gad:=CreateGadgetA(CYCLE_KIND,gad,[5,30,150,15,NIL,NIL,3,0,visual,0]:newgadget,[GA_DISABLED,FALSE,GA_RELVERIFY,TRUE,GTCY_LABELS,['DF0:','DF1:','DF2:',NIL],NIL])
-
- IF (win:=OpenWindowTagList(0,[WA_IDCMP,IDCMP_CLOSEWINDOW+IDCMP_REFRESHWINDOW+IDCMP_GADGETUP+IDCMP_GADGETDOWN,
- WA_LEFT,220,
- WA_TOP,100,
- WA_WIDTH,160,
- WA_HEIGHT,60,
- WA_TITLE,'DMS Unpacking',
- WA_GADGETS,glist,
- WA_FLAGS,WFLG_DRAGBAR+WFLG_CLOSEGADGET+WFLG_SMART_REFRESH+WFLG_DEPTHGADGET+WFLG_ACTIVATE,
- 0,0]))=NIL THEN Raise(ERR_WIN)
- Gt_RefreshWindow(win,0)
- StrCopy(path,'df0:',ALL)
- start:=FALSE; abort:=FALSE; test:=NIL
- stdrast:=win.rport
- SetTopaz(8)
-
- REPEAT
-
- WaitPort(win.userport)
- IF (msg:=Gt_GetIMsg(win.userport))
- class2:=msg.class
- gad:=msg.iaddress
- id:=gad.gadgetid
- IF class2=IDCMP_GADGETDOWN OR IDCMP_GADGETUP
- IF id=1 THEN abort:=TRUE
- IF id=2
- test:=checkdisk()
- SELECT test
- CASE 10
- reqtoolsreq('Unprotect disk!','OK')
- CASE 100
- reqtoolsreq('Insert disk!','OK')
- CASE 1000
- StringF(unittxt,'DF\d is unavailable!',unit)
- reqtoolsreq(unittxt,'OK')
- ENDSELECT
- IF test=0 THEN start:=TRUE ELSE start:=FALSE
- ENDIF
- IF id=3
- select:=msg.code
- SELECT select
- CASE 0
- StrCopy(path,'df0:',ALL)
- unit:=0
- CASE 1
- StrCopy(path,'df1:',ALL)
- unit:=1
- CASE 2
- StrCopy(path,'df2:',ALL)
- unit:=2
- ENDSELECT
- ENDIF
- ENDIF
- Gt_ReplyIMsg(msg)
- ENDIF
-
- UNTIL (start=TRUE) OR (abort=TRUE)
-
- IF abort=TRUE
-
- closeall2()
-
- RETURN 999
- ENDIF
-
- dinfo:=UpUseDrive(cinfo,path)
- ENDIF
-
- dodaj(list, 'Unpacking file using unpack.library')
-
- IF (err:=UpUnpack(cinfo))=NIL
- err:=cinfo.errornum
-
- closeall2()
-
- RETURN err
- ENDIF
-
- closeall2()
-
- length:=cinfo.decrunchlen
- address:=cinfo.decrunchadr
-
- ENDPROC
-
- PROC closeall2()
-
- IF dinfo THEN UpUnuseDrive(dinfo)
- IF win THEN CloseWindow(win)
- IF glist THEN FreeGadgets(glist)
- IF visual THEN FreeVisualInfo(visual)
- IF scr THEN UnlockPubScreen(0,scr)
-
- ENDPROC
-
- store:LONG 0
-
- PROC send()
-
- DEF id,class2,msg:PTR TO intuimessage
-
- IF (msg:=Gt_GetIMsg(win.userport))
- class2:=msg.class
- gad:=msg.iaddress
- id:=gad.gadgetid
- IF class2=IDCMP_GADGETDOWN OR IDCMP_GADGETUP
- IF id=1
- abort:=TRUE
- ENDIF
- ENDIF
- Gt_ReplyIMsg(msg)
- ENDIF
-
- UpSendCmd(dinfo,cinfo.decrunchadr,cinfo.offset,cinfo.decrunchlen,CMD_WRITE)
- SetAPen(stdrast,1)
- TextF(11,53,'Unpacking track \d',tracknr)
-
- tracknr:=tracknr+1
- ENDPROC
-
- scantrack:
- LEA store(PC),A0
- MOVE.L (A0),A4
- send()
- IF abort=FALSE
- CLR.L D0
- ELSE
- MOVE.L #999,D0
- ENDIF
- RTS
-
- PROC checkdisk()
-
- DEF ioport,ioreq:PTR TO iostd,dev
-
- ioport:=CreateMsgPort()
- ioreq:=CreateIORequest(ioport,SIZEOF iostd)
- dev:=OpenDevice('trackdisk.device',unit,ioreq,0)
- IF dev=0
- ioreq.command:=TD_PROTSTATUS
- DoIO(ioreq)
- IF (ioreq.error<>TDERR_DISKCHANGED)
- IF (ioreq.actual=0)
- RETURN 0
- ELSE
- RETURN 10
- ENDIF
- ELSE
- RETURN 100
- ENDIF
- ELSE
- RETURN 1000
- ENDIF
- IF ioreq THEN CloseDevice(ioreq)
- IF ioport THEN DeleteMsgPort(ioport)
- IF ioreq THEN DeleteIORequest(ioreq)
- ENDPROC 0
-
- PROC reqtoolsreq(tekst,but)
- ENDPROC RtEZRequestA(tekst,but,0,0,
- [RT_UNDERSCORE,"_",
- RT_REQPOS,REQPOS_CENTERSCR,
- RT_WINDOW,mainwin,
- RT_SCREEN,0,
- RTEZ_FLAGS,EZREQF_CENTERTEXT,0])
-
- PROC whyfail(num)
- SELECT num
- CASE 999
- StrCopy(string, 'User abort', ALL)
- CASE ERR_OPEN
- StrCopy(string,'Can''t Open File',ALL)
- CASE ERR_READWRITE
- StrCopy(string,'Read/Write Error',ALL)
- CASE ERR_MEMORY
- StrCopy(string,'Allocation Error (Out Of Memory)',ALL)
- CASE ERR_DETERMINE
- StrCopy(string,'Can''t Determine File',ALL)
- CASE ERR_PASSWORD
- StrCopy(string,'Illegal Password',ALL)
- CASE ERR_HUNK
- StrCopy(string,'Hunk Error',ALL)
- CASE ERR_EXTERN
- StrCopy(string,'Extern File Error',ALL)
- CASE ERR_CORRUPT
- StrCopy(string,'Crunched File Is Corrupted',ALL)
- CASE ERR_DEVICE
- StrCopy(string,'Illegal Device',ALL)
- CASE ERR_DEVOPEN
- StrCopy(string,'Couldn''t Open Device Or Create Port',ALL)
- CASE ERR_CRC
- StrCopy(string,'CRC Checksum Error',ALL)
- CASE ERR_CHECKSUM
- StrCopy(string,'Checksum Error',ALL)
- CASE ERR_OLD
- StrCopy(string,'Decruncher In Lib. Too Old',ALL)
- CASE ERR_DEVERR
- StrCopy(string,'Error From Device',ALL)
- CASE ERR_PROTECT
- StrCopy(string,'Couldn''t Set Protection Bits',ALL)
- CASE ERR_OUTPUT
- StrCopy(string,'Output File Error',ALL)
- CASE ERR_OPENLIBRARY
- StrCopy(string,'Couldn''t Open Library',ALL)
- CASE ERR_UNKNOWN
- StrCopy(string,'Unknown Error',ALL)
- ENDSELECT
- dodaj(list, string)
- ENDPROC
-
- PROC setpath()
-
- RtFileRequestA(reql,NIL,'Select path',[RTFI_FLAGS,FREQF_NOFILES,0])
- StrCopy(path2,reql.dir,ALL)
- pos:=(StrLen(path2)-1)+path2
- IF Char(pos)<>Char(':')
- StrCopy(path,path2,ALL)
- StrAdd(path,'/',1)
- ELSE
- StrCopy(path,path2,ALL)
- ENDIF
-
- ENDPROC reql.dir
-
- PROC request(kind)
- DEF directory[255]:STRING, dir, out, req:PTR TO rtfilerequester
- GetCurrentDirName(directory,256)
- IF kind=LOAD THEN req:=reql ELSE req:=reqs
- IF (out:=RtFileRequestA(req,file,'Select file',[RTFI_FLAGS,IF kind=LOAD THEN FREQF_MULTISELECT ELSE FREQF_SAVE,0]))
- IF kind=LOAD
- flist:=out
- StrCopy(loaddir,req.dir,ALL)
- ENDIF
- dir:=req.dir
- StrCopy(directory,dir,ALL)
- AddPart(directory, file, 255)
- ELSE
- directory:=0
- ENDIF
- StrCopy(name,directory,ALL)
- ENDPROC out
-