home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / RCT1,62.DMS / in.adf / LIBS / MODULA2 / FileReq.mod < prev    next >
Encoding:
Modula Implementation  |  1992-01-05  |  2.3 KB  |  91 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    FileReq.mod
  3.     :Author.     Philip Losch
  4.     :Address.
  5.     :Phone.
  6.     :Shortcut.
  7.     :Version.    1.1
  8.     :Date.       12/1991
  9.     :Copyright.  Maxon Computer GmbH
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga V4.0d
  12.     :Imports.    Standard-Modulen, RCT.library, RctL, RctD
  13.     :UpDate.     1.0 Orginal von RCT V1.5
  14.     :UpDate.     1.1 M2 V4.0 angepasst  [Thomas Nolte]
  15.     :Contents.   FileRequester Modul
  16. ---------------------------------------------------------------------------*)
  17.  
  18. (* $S- $F- $N- $R- $V- *)
  19. IMPLEMENTATION MODULE FileReq;
  20.  
  21. FROM SYSTEM    IMPORT    ADR,ADDRESS;
  22. FROM RCT    IMPORT    FileReq,FileReqFlags,FileReqFlagSet,RCTFileRequester,
  23.                      DSIZE,FSIZE,WILDLENGTH,Alert;
  24. FROM Str    IMPORT    Length,Copy,Concat,LastPos;
  25. FROM IntuitionL    IMPORT    ScreenToFront;
  26. FROM IntuitionD    IMPORT    WindowPtr,IDCMPFlagSet, IntuiTextLength,ScreenPtr;
  27. FROM ExecL    IMPORT    AllocMem,FreeMem,CopyMem;
  28. FROM ExecD    IMPORT    MemReqs,MemReqSet;
  29.  
  30. VAR
  31.   fr    : RCTFileRequester;
  32.  
  33. PROCEDURE FR(VAR FName: ARRAY OF CHAR; text:INTEGER; win:WindowPtr):BOOLEAN;
  34.   PROCEDURE GetPath(VAR f,d:ARRAY OF CHAR);
  35.     VAR
  36.       pos,i:INTEGER;
  37.     BEGIN
  38.       Copy(d,f);
  39.       pos:=LastPos(f,-1,'/');
  40.       IF pos<0 THEN
  41.         pos:=LastPos(f,-1,':');
  42.       END;
  43.       IF pos>=0 THEN
  44.         INC(pos);
  45.         d[pos]:=0C;
  46.         FOR i:=pos TO Length(f) DO
  47.           f[i-pos]:=f[i]
  48.         END;
  49.         f[i]:=0C;
  50.       ELSE
  51.         d[0]:=0C
  52.       END;
  53.     END GetPath;
  54.  
  55.   VAR
  56.     ndir  : ARRAY [0..DSIZE] OF CHAR;
  57.     nfile : ARRAY [0..FSIZE] OF CHAR;
  58.     npath : ARRAY [0..DSIZE+FSIZE+1] OF CHAR;
  59.     field : ARRAY [0..24] OF CHAR;
  60.     i     : INTEGER;
  61.     ptr   : POINTER TO CARDINAL;
  62.     b     : BOOLEAN;
  63.   BEGIN
  64.     Copy(npath,FName);
  65.     Copy(nfile,FName);
  66.     GetPath(nfile,ndir);
  67.  
  68.     ptr:=ADR(fr);
  69.     FOR i:=1 TO SIZE(fr) DIV 2 DO
  70.       ptr^:=0; INC(ptr,2);
  71.     END;
  72.  
  73.     WITH fr DO
  74.       dir:=ADR(ndir); file:=ADR(nfile); path:=ADR(npath);
  75.       IF ld THEN
  76.         title:=ADR("Laden");
  77.         flags:=FileReqFlagSet{absolute,noHalfCache,load};
  78.       ELSE
  79.         title:=ADR("Speichern");
  80.         flags:=FileReqFlagSet{absolute,noHalfCache,save};
  81.       END;
  82.     END;
  83.     b:=FileReq(ADR(fr));
  84.     IF b THEN
  85.       Copy(FName,npath);
  86.     END;
  87.     RETURN b;
  88.   END FR;
  89.  
  90. END FileReq.
  91.