home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Amos / AmosProPatch.LHA / AmosProMultiEnv / GetAMOSProEnv11.e < prev    next >
Encoding:
Text File  |  1992-02-26  |  3.0 KB  |  120 lines

  1. /* Get AMOS Env Pro - V1.1 By Paul Hickman ©Mar 1994 */
  2.  
  3. /* Copies a selected Envoironment to T:AMOSPro_Interpreter_Config */
  4.  
  5. /* Changes from V1.0
  6.  
  7.  * Exception Handling for errors used now
  8.  
  9.  * If you press Cancel in the file requester, a WARN value is returned
  10.  
  11.  * If an error occurs, code 20 is returned, add a requester appears.
  12.  
  13.  * Allows initial pathname argument to be quoted with ""
  14. */
  15.  
  16. MODULE 'ReqTools','libraries/reqtools','utility/tagitem','Dos/Dos'
  17.  
  18. ENUM    ER_OPEN=20,ER_READ,ER_WRITE,ER_MEM,FR_LIB,FR_ALLOC
  19.  
  20. CONST    RW_ERR=-1
  21.  
  22. RAISE ER_OPEN IF Open()=NIL
  23. RAISE ER_READ IF Read()=RW_ERR
  24. RAISE ER_WRITE IF Write()=RW_ERR
  25. RAISE ER_MEM IF New()=NIL
  26.  
  27. DEF quitstring[5]:STRING
  28.  
  29.  
  30. PROC main() HANDLE
  31.  
  32.   DEF filename[256]:STRING
  33.   DEF infile,outfile,buffer,filesize
  34.   DEF amossys[256]:STRING
  35.  
  36.   /* Set the default AMOS_System path if no arguments */
  37.  
  38.   quitstring := 'Quit'
  39.  
  40.   IF arg [] <= 0
  41.     amossys := 'SYS:AMOS_Pro/APSystem/Interpreter_Configs'
  42.   ELSE
  43.     IF (arg[0] = 34) AND (arg[StrLen(arg)-1] = 34)
  44.       MidStr(amossys,arg,1,StrLen(arg)-2)
  45.     ELSE
  46.       StrCopy(amossys,arg,ALL)
  47.     ENDIF
  48.   ENDIF
  49.  
  50.   /* get The filename */
  51.  
  52.   IF (filename := filereq(amossys)) = '' THEN CleanUp(5)
  53.  
  54.   /* Copy the file */
  55.  
  56.   infile := Open(filename,MODE_OLDFILE)
  57.   outfile := Open('T:AMOSPro_Interpreter_Config',MODE_NEWFILE)
  58.   buffer := New(filesize := FileLength(filename))
  59.   Read(infile,buffer,filesize) 
  60.   Write(outfile,buffer,filesize) 
  61.  
  62.   Close(outfile)
  63.   Close(infile)
  64.  
  65.  
  66.  
  67. EXCEPT
  68.  
  69. SELECT exception
  70.   CASE ER_OPEN;      request('Error: Could Not Open A File',quitstring,NIL)
  71.   CASE ER_READ;      request('Error: Could Not Read The Envoironment File',quitstring,NIL)
  72.   CASE ER_WRITE;     request('Error: Could Not Write To The Temporary File',quitstring,NIL)
  73.   CASE ER_MEM;       request('Error: Out Of Memory Error',quitstring,NIL)
  74.   DEFAULT;           request('Error: An IO Error Has Occured',quitstring,NIL)
  75. ENDSELECT
  76.  
  77. ENDPROC
  78.  
  79.  
  80.  
  81. PROC filereq(amossys) HANDLE
  82.  
  83.   RAISE FR_LIB IF OpenLibrary()=NIL
  84.   RAISE FR_ALLOC IF RtAllocRequestA()=NIL
  85.  
  86.   CONST FILEREQ=0,REQINFO=1
  87.  
  88.   DEF filebuf[120]:STRING
  89.   DEF dirbuf[256]:STRING
  90.   DEF req:PTR TO rtfilerequester
  91.   DEF tempstr[1]:STRING
  92.  
  93.   reqtoolsbase:=OpenLibrary('reqtools.library',37)
  94.   req:=RtAllocRequestA(FILEREQ,0)
  95.   filebuf := 'Default.Config'
  96.   RtChangeReqAttrA(req,[RTFI_DIR,amossys,RTFI_MATCHPAT,'#?.Config',TAG_DONE])
  97.   IF RtFileRequestA(req,filebuf,'Select AMOS Pro Configuration',[RTFI_FLAGS,FREQF_PATGAD,TAG_DONE])=FALSE THEN CleanUp(5)
  98.  
  99.   /* combine the directory & filename */
  100.  
  101.   StrCopy(dirbuf,req.dir,ALL)
  102.   RtFreeRequest(req)
  103.   RightStr(tempstr,dirbuf,1)
  104.   IF StrCmp(tempstr,':',1)=FALSE THEN StrAdd(dirbuf,'/',ALL)
  105.   StrAdd(dirbuf,filebuf,ALL)
  106.   CloseLibrary(reqtoolsbase)
  107.  
  108. EXCEPT
  109.  
  110. SELECT exception
  111.   CASE FR_LIB;     request('Error: Could Not Open Reqtools Library',quitstring,NIL)
  112.   CASE FR_ALLOC;   request('Error: Could Not Open File Requester',quitstring,NIL)    
  113.   DEFAULT;       Raise(exception)
  114. ENDSELECT
  115.   
  116. ENDPROC dirbuf
  117.  
  118. PROC request(body,gadgets,args)
  119. ENDPROC EasyRequestArgs(0,[20,0,'AMOS Loader',body,gadgets],0,args)
  120.