home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 2 / LSD and 17bit Compendium Deluxe - Volume II.iso / a / prog / amigae / ged-e2.0.lha / GED-E / RtRequest.e < prev    next >
Encoding:
Text File  |  1994-11-03  |  3.7 KB  |  97 lines
  1. /* Sauve les noms complets ainsi que le chemin des fichiers choisis   */
  2. /* par l'intermédaire du filerequester de la la reqtools.library dans */
  3. /* les variables spécifiées.                                          */
  4.  
  5.     OPT OSVERSION=36
  6.  
  7.     MODULE 'dos/dos'
  8.     MODULE 'reqtools','libraries/reqtools'
  9.     MODULE 'utility/tagitem'
  10.     MODULE 'intuition/screens','intuition/intuitionbase'
  11.  
  12.     ENUM MEM_ERROR=21,IO_ERROR,FIND_ERROR
  13.  
  14.     DEF file[108]:STRING,req:PTR TO rtfilerequester,efile[255]:STRING,
  15.         epath[108]:STRING,path,bpath,filelist:PTR TO rtfilelist,
  16.         fstruct:PTR TO rtfilelist,rdargs,cliarg:PTR TO LONG,fhandle,phandle,
  17.         lock,ib:PTR TO intuitionbase
  18.  
  19. /*FOLDER "main()"*/
  20. PROC main()
  21.     cliarg:=[0,0,'Select files',0]
  22.     IF (rdargs:=ReadArgs('FILESVAR/A,PATHVAR,TITLE/K,EXIST/S',cliarg,NIL))
  23.         IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))
  24.             IF (req:=RtAllocRequestA(RT_FILEREQ,0))
  25.                 IF cliarg[1]
  26.                     IF (phandle:=Open(cliarg[1],MODE_OLDFILE))
  27.                         IF ReadStr(phandle,epath)<>-1 THEN RtChangeReqAttrA(req,[RTFI_DIR,epath,TAG_END])
  28.                         Close(phandle) ; phandle:=0
  29.                     ENDIF
  30.                 ENDIF
  31.                 ib:=intuitionbase
  32.                 IF (filelist:=RtFileRequestA(req,file,cliarg[2],[RTFI_FLAGS,FREQF_MULTISELECT,RT_SCREEN,ib.activescreen,TAG_DONE]))
  33.                     fstruct:=filelist
  34.                     path:=req.dir
  35.                     IF cliarg[1]
  36.                         IF (phandle:=Open(cliarg[1],MODE_NEWFILE))=0 THEN quit(IO_ERROR,cliarg[1])
  37.                         IF Fputs(phandle,path) THEN quit(IO_ERROR,cliarg[1])
  38.                     ENDIF
  39.                     IF StrLen(path)
  40.                         bpath:=TRUE
  41.                         StrCopy(epath,path,ALL)
  42.                         IF epath[EstrLen(epath)-1]<>$3A THEN StrAdd(epath,'/',ALL)
  43.                     ENDIF
  44.                     IF bpath THEN StrCopy(efile,epath,ALL)
  45.                     StrAdd(efile,fstruct.name,ALL)
  46.                     IF cliarg[3]
  47.                         IF (lock:=Lock(efile,ACCESS_READ))=0
  48.                             UnLock(lock)
  49.                             quit(RETURN_WARN,NIL)
  50.                         ELSE ; UnLock(lock)
  51.                         ENDIF
  52.                     ENDIF
  53.                     WHILE (fstruct:=fstruct.next)<>0
  54.                         StrAdd(efile,' ',ALL)
  55.                         IF bpath THEN StrCopy(efile,epath,ALL)
  56.                         StrAdd(efile,fstruct.name,ALL)
  57.                     ENDWHILE
  58.                     IF (fhandle:=Open(cliarg[0],MODE_NEWFILE))
  59.                         IF Fputs(fhandle,efile) THEN quit(IO_ERROR,cliarg[0])
  60.                     ELSE ; quit(IO_ERROR,NIL)
  61.                     ENDIF
  62.                 ELSE ; quit(RETURN_WARN,NIL)
  63.                 ENDIF
  64.             ELSE ; quit(MEM_ERROR,'RtAllocRequest()')
  65.             ENDIF
  66.         ELSE ; quit(FIND_ERROR,'reqtools.library!')
  67.         ENDIF
  68.     ELSE ; quit(IO_ERROR,NIL)
  69.     ENDIF
  70.     quit(RETURN_OK,NIL)
  71. ENDPROC
  72. /*FEND*/
  73. CHAR '$VER: RtRequest 1.007 (26 Oct 1994) © BURGHARD Eric | WANABOSO/AGOA'
  74.  
  75. /*FOLDER "quit(err,obj)"*/
  76. PROC quit(err,obj)
  77.     DEF flt=0
  78.  
  79.     IF (err<>RETURN_OK) AND (err<>RETURN_WARN)
  80.         SELECT err
  81.             CASE IO_ERROR  ; flt:=IoErr()
  82.             CASE MEM_ERROR ; flt:=ERROR_NO_FREE_STORE
  83.             CASE FIND_ERROR; flt:=ERROR_OBJECT_NOT_FOUND
  84.         ENDSELECT
  85.         err:=RETURN_ERROR
  86.         PrintFault(flt,obj)
  87.     ENDIF
  88.     IF rdargs THEN FreeArgs(rdargs)
  89.     IF fhandle THEN Close(fhandle)
  90.     IF phandle THEN Close(phandle)
  91.     IF req THEN RtFreeRequest(req)
  92.     IF filelist THEN RtFreeFileList(filelist)
  93.     CleanUp(err)
  94. ENDPROC
  95. /*FEND*/
  96.  
  97.