home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
160.lha
/
CMS.mod
< prev
next >
Wrap
Text File
|
1988-04-27
|
5KB
|
160 lines
MODULE CMS; (* CMS 2.0 Compile with Benchmark Modula-2 *)
(*
CMS 2.0 - ] Mike SCARY Scalora [ - PLink : SCARY
This MODULE is public domain. Freely distributable as long as this
notice stays in.
This program was originally uploaded to PeopleLink's Amiga Zone. The
Amiga Zone has well over 3000 members, and a library of thousands of
public domain files. If you're interested in joining us, call
800-524-0100 (voice)
or 800-826-8855 (modem).
2.0 - 11/28/87 - ] Mike SCARY Scalora [ -
Put in MAIN (saves space (allocates global vars on stack))
Took out RunTimeErrors
Took out WriteInt, not used
Added checking for CTRL-C
*)
FROM AmigaDOS IMPORT FileLock, FileInfoBlockPtr,
Lock, UnLock, Examine, ExNext, SharedLock;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM SYSTEM IMPORT ADR, ADDRESS;
FROM Terminal IMPORT WriteString;
FROM System IMPORT StdOutput, CmdLinePtr, CmdLineLength;
FROM Tasks IMPORT TaskPtr, FindTask;
PROCEDURE MAIN;
VAR
File,Path : ARRAY [0..256] OF CHAR;
MyLock : FileLock;
MyInfo : FileInfoBlockPtr;
Pat : BOOLEAN;
I,J : CARDINAL;
CmdLine : POINTER TO ARRAY [0..256] OF CHAR;
MyTask : TaskPtr;
PROCEDURE CleanUp;
BEGIN
IF MyInfo#NIL THEN DEALLOCATE(MyInfo,SIZE(MyInfo^)); END;
IF MyLock#FileLock(0) THEN UnLock(MyLock); END;
END CleanUp;
PROCEDURE Match(VAR P,S : ARRAY OF CHAR): BOOLEAN;
(* Input a pattern, P, and a string, S. Returns TRUE if S fits the
pattern P. For P, * will match to any number of any character and
? will match to any one character. *)
PROCEDURE IsAMatch(PN,CN : CARDINAL): BOOLEAN;
BEGIN
CASE P[PN] OF
0C : IF S[CN]=0C THEN RETURN(TRUE);
ELSE RETURN(FALSE); END; |
'*' : WHILE P[PN+1]='*' DO INC(PN); END;
IF S[CN]=0C THEN RETURN(IsAMatch(PN+1,CN));
ELSE
LOOP
IF IsAMatch(PN+1,CN) THEN RETURN(TRUE); END;
INC(CN);
IF S[CN]=0C THEN RETURN(IsAMatch(PN+1,CN)); END;
END;
END; |
'?' : IF S[CN]=0C THEN RETURN(FALSE)
ELSE RETURN(IsAMatch(PN+1,CN+1)); END;
ELSE
IF CAP(S[CN])=CAP(P[PN]) THEN RETURN(IsAMatch(PN+1,CN+1));
ELSE RETURN(FALSE); END;
END;
RETURN FALSE;
END IsAMatch;
BEGIN
RETURN(IsAMatch(0,0));
END Match;
BEGIN
MyTask := FindTask(NIL);
(* parse the first argument *)
I := 0; J := 0;
CmdLine := CmdLinePtr; CmdLine^[CARDINAL(CmdLineLength)-1] := 0C;
WHILE (CmdLine^[I]=' ') DO INC(I); END;
IF CmdLine^[I]='"' THEN
INC(I);
WHILE (CmdLine^[I]#'"') AND (CmdLine^[I]#0C) DO
File[J] := CmdLine^[I]; INC(I); INC(J); END;
IF CmdLine^[I]='"' THEN INC(I); END;
ELSE
WHILE (CmdLine^[I]#' ') AND (CmdLine^[I]#0C) DO
File[J] := CmdLine^[I]; INC(I); INC(J); END;
END;
File[J] := 0C;
J := 0;
WHILE (CmdLine^[I]=' ') DO INC(I); END;
IF CmdLine^[I]='"' THEN
INC(I);
WHILE (CmdLine^[I]#'"') AND (CmdLine^[I]#0C) DO
Path[J] := CmdLine^[I]; INC(I); INC(J); END;
ELSE
WHILE (CmdLine^[I]#' ') AND (CmdLine^[I]#0C) DO
Path[J] := CmdLine^[I]; INC(I); INC(J); END;
END;
Path[J] := 0C;
IF (File[0]=0C) THEN
WriteString('\nUsage:\n\n CMS [ pattern [ path ] ]\n\n');
WriteString("NOTE: Use '*' to select all files\n\n");
HALT;
END;
MyLock := FileLock(0);
WriteString('.key arg1,arg2\n');
WriteString('; Created by CMS 2.0 - ] Mike SCARY Scalora [ - PLink:SCARY\n');
IF File[0]#0C THEN
WriteString("; pattern used : '"); WriteString(File);
WriteString("'\n");
IF ((File[0]='*') AND (File[1]=0C)) THEN Pat := FALSE;
ELSE Pat := TRUE; END;
ELSE
Pat := FALSE;
END;
ALLOCATE(MyInfo,SIZE(MyInfo^));
IF MyInfo=NIL THEN WriteString('Not able to allocate FileInfoBlock!\n');
CleanUp; HALT; END;
MyLock := Lock(ADR(Path),SharedLock);
IF MyLock=FileLock(0) THEN
WriteString('Not able to get FileLock for "'); WriteString(Path);
WriteString('"!\n'); CleanUp; HALT;
END;
IF NOT(Examine(MyLock,MyInfo^)) THEN
WriteString('Not able to Examine directory!'); CleanUp; HALT; END;
WriteString("; directory searched : '");
WriteString(Path); WriteString("'\n");
WHILE ExNext(MyLock,MyInfo^) DO
IF (MyInfo^.fibEntryType<0D) AND
(NOT(Pat) OR Match(File,MyInfo^.fibFileName)) THEN
WriteString('<arg1> ');
WriteString(MyInfo^.fibFileName);
WriteString(' <arg2>\n');
END;
IF 12 IN MyTask^.tcSigRecvd THEN
WriteString('\33[33mCTRL-C!\33[31m\n'); CleanUp; HALT; END;
END;
CleanUp;
END MAIN;
BEGIN
MAIN;
END CMS.