home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1992-08-18 | 3.0 KB | 96 lines |
- (*---------------------------------------------------------------------------
- :Program. ReqTFileReq.mod
- :Contents. Simple Benutzung des ReqTools Filerequesters
- :Author. Frank Lömker
- :Copyright. Public Domain
- :Language. Modula-2
- :Translator. M2Amiga V4.0d
- :Support. Basiert zu großen Teilen auf ARPFileReq von Bernd Preußing
- :Imports. ReqTools 2.0m [kai]
- :History. V1.0, [Frank Lömker] 24-Feb-92
- :History. V1.1, [Frank Lömker] 03-Jul-92 Requester nicht freigegeben
- :History. V1.2, [Frank Lömker] 10-Aug-92 Save-Mode, Patternrückgabe,
- :History. LockWindow
- :Bugs. keine bekannt
- ---------------------------------------------------------------------------*)
- IMPLEMENTATION MODULE ReqTFileReq;
-
- (*$ LargeVars:=FALSE StackParms:=FALSE RangeChk:=FALSE OverflowChk:=FALSE
- ReturnChk:=FALSE StackChk:=FALSE EntryClear:=FALSE *)
-
- FROM UtilityD IMPORT tagEnd;
- FROM SYSTEM IMPORT ADR,ADDRESS,TAG,LONGSET;
- FROM String IMPORT Copy, LastPos, Length, Concat;
- IMPORT rt:ReqTools;
-
- TYPE str110=ARRAY [0..110] OF CHAR;
- str110Ptr=POINTER TO str110;
-
- VAR filereq:rt.FileRequesterPtr;
- tagbuf:ARRAY [0..5] OF LONGINT;
- File, Dir: str110;
-
- PROCEDURE GetPath(VAR f,d:ARRAY OF CHAR);
- VAR pos,i:INTEGER;
- BEGIN
- Copy(d,f);
- pos:=LastPos(f,1000,'/');
- IF pos<0 THEN
- pos:=LastPos(f,1000,':');
- END;
- IF pos>=0 THEN
- IF d[pos]=':' THEN d[pos+1]:=0C ELSE d[pos]:=0C END;
- INC(pos);
- FOR i:=pos TO Length(f) DO
- f[i-pos]:=f[i]
- END;
- f[i]:=0C;
- ELSE
- d[0]:=0C
- END;
- END GetPath;
-
- PROCEDURE FileReq (VAR FName:ARRAY OF CHAR; Window:ADDRESS; Title:ARRAY OF CHAR;
- x,y:INTEGER;VAR pattern:ARRAY OF CHAR;save:BOOLEAN):BOOLEAN;
- VAR ok,pat:BOOLEAN;
- BEGIN
- ok:=FALSE; pat:=FALSE;
- filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
- IF filereq # NIL THEN
- Copy (File,FName);
- GetPath (File,Dir);
- IF Length (pattern)>0 THEN
- pat:=TRUE;
- rt.ChangeReqAttrA (filereq,TAG(tagbuf,rt.fiDir,ADR(Dir),
- rt.fiMatchPat,ADR(pattern),tagEnd));
- filereq^.flags:=filereq^.flags+LONGSET{rt.fReqPatGad,rt.fReqNoBuffer};
- ELSE
- rt.ChangeReqAttrA (filereq,TAG(tagbuf,rt.fiDir,ADR(Dir),tagEnd));
- INCL (filereq^.flags,rt.fReqNoBuffer);
- END;
- IF save THEN INCL (filereq^.flags,rt.fReqSave); END;
- IF x>=0 THEN filereq^.leftOffset:=x; END;
- IF y>=0 THEN filereq^.topOffset:=y; END;
- IF (x>=0) OR (y>=0) THEN filereq^.reqPos:=rt.ReqPosTopLeftScr; END;
- IF rt.FileRequest (filereq, ADR(File),ADR(Title),
- TAG(tagbuf,rt.Window,Window,rt.LockWindowTag,TRUE,tagEnd)) THEN
- Dir:=str110Ptr(filereq^.dir)^;
- IF (Length(Dir)>0) AND (Dir[Length(Dir)-1]#':') THEN
- Concat(Dir,'/');
- END;
- Concat(Dir,File);
- Copy(FName,Dir);
- IF pat THEN
- Copy (pattern,str110Ptr(filereq^.matchPat)^);
- END;
- ok:=TRUE;
- END;
- rt.FreeRequest (filereq);
- END;
- RETURN ok;
- END FileReq;
-
- BEGIN
- NoPat:="";
- END ReqTFileReq.mod
-