home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AMIGA PD 1
/
AMIGA-PD-1.iso
/
Programme_zum_Heft
/
Programmieren
/
Kurztests
/
PascalPCQ
/
Examples
/
Find.p
< prev
next >
Wrap
Text File
|
1990-07-19
|
5KB
|
196 lines
Program Find;
{
Find.p searches through an AmigaDOS directory structure for files
matching the pattern given. The command line format is:
Find BaseDirectory Pattern
This program shows how to use the SameName pattern matching routine,
as well as how to work with AmigaDOS a bit. If you don't already have
a utility like this, Find can actually be useful. Kinda scary....
By the way: if you want to start your search on the current
directory, just type: Find "" FilePattern
}
{$I "Include:Utils/Break.i"}
{$I "Include:Libraries/DOS.i"}
{$I "Include:Utils/Parameters.i"}
{$I "Include:Utils/StringLib.i"}
{$I "Include:Utils/SameName.i"}
type
{
When I'm searching through a directory for files matching the
pattern, I also come across directories. When I do I keep them in a
linked stack, using the record below, then print all the subdirectories
after I'm finished with the current directory. That way the files from
the subdirectory aren't printed in the middle of files from the current
directory.
}
DirRec = record
Previous : ^DirRec;
Name : Array [0..109] of Char;
end;
DirRecPtr = ^DirRec;
var
FullPath : String;
Directory : String;
FileName : String;
TestName : String;
Function DirEnded(FName : String) : Boolean;
{
returns false if you would want to append a '\' to the end
of FName before added a file name.
}
var
l : Short;
begin
l := strlen(FName);
if l = 0 then
DirEnded := True;
DirEnded := (FName[l - 1] = ':') or (FName[l - 1] = '/');
end;
Procedure Display(FileInfo : FileInfoBlockPtr);
{
Displays whatever information you want from the FileInfoBlock
}
var
l : Short;
begin
with FileInfo^ do begin
Write(FullPath);
l := strlen(FullPath);
if l > 0 then
if not DirEnded(FullPath) then begin
Write('/');
l := Succ(l);
end;
l := l + strlen(Adr(fib_FileName));
Write(String(ADR(fib_FileName)), ' ':40-l);
WriteLn(fib_Size:6)
end;
end;
Procedure UpCase(str : String);
{
Converts a string to uppercase
}
var
i : Integer;
begin
i := 0;
while str[i] <> '\0' do begin
str[i] := toupper(str[i]);
i := Succ(i);
end;
end;
Procedure SearchDirectory(DirName : String);
{
The big routine. Runs through the named directory, printing
file names that match the global variable FileName, and making a list
of directories. When it has finished looking through the directories,
it calls itself recursively to print its subdirectories.
}
var
FL : FileLock;
FB : FileInfoBlockPtr;
Stay : Boolean;
LastPos : Short;
FirstDir,
TempDir : DirRecPtr;
DOSError : Integer;
begin
if CheckBreak then
return;
LastPos := StrLen(FullPath);
FirstDir := Nil;
if not DirEnded(FullPath) then
strcat(FullPath, "/");
strcat(FullPath, DirName);
FL := Lock(FullPath, ACCESS_READ);
if FL = Nil then begin
FullPath[LastPos] := '\0';
return;
end;
New(FB); { Since New() uses AllocMem, FB is longword aligned }
if not Examine(FL, FB) then begin
Unlock(FL);
FullPath[LastPos] := '\0';
return;
end;
if FB^.fib_DirEntryType < 0 then begin { means it's a file, not a dir }
Unlock(FL);
FullPath[LastPos] := '\0';
return;
end;
repeat
Stay := ExNext(FL, FB);
if Stay then begin
with FB^ do begin
if fib_DirEntryType < 0 then begin { file }
StrCpy(TestName, Adr(fib_FileName));
UpCase(TestName);
if SameName(FileName, TestName) then
Display(FB);
end else begin { a dir }
new(TempDir); { add it to the list }
with TempDir^ do begin
strcpy(Adr(Name), Adr(fib_FileName));
Previous := FirstDir;
end;
FirstDir := TempDir;
end;
end;
end else begin
DOSError := IoErr; { expect Error_No_More_Entries - not an error }
if DOSError <> ERROR_NO_MORE_ENTRIES then
Writeln('DOS Error number ', DOSError);
end;
if CheckBreak then begin { user pressed Ctrl-C? }
while FirstDir <> Nil do begin
TempDir := FirstDir^.Previous; { don't go through subs }
Dispose(FirstDir);
FirstDir := TempDir;
end;
Stay := False;
end;
until not Stay;
Unlock(FL);
while FirstDir <> Nil do begin { print sub-directories }
SearchDirectory(Adr(FirstDir^.Name));
TempDir := FirstDir^.Previous;
Dispose(FirstDir);
FirstDir := TempDir;
end;
FullPath[LastPos] := '\0'; { restore global path name }
end;
Procedure Usage;
begin
Writeln('Usage: FIND BaseDirectory FilePattern');
Writeln('\t\tWhere BaseDirectory specifies the root search');
Writeln('\t\tDirectory, and FilePattern is the file name,');
Writeln('\t\tpossibly containing wildcards, to be compared.');
Exit(20);
end;
begin
Directory := AllocString(128);
FileName := AllocString(40);
TestName := AllocString(110);
FullPath := AllocString(300); { allocate plenty of space }
FullPath[0] := '\0';
GetParam(1, Directory);
GetParam(2, FileName);
if StrLen(FileName) = 0 then
Usage;
UpCase(FileName);
SearchDirectory(Directory);
end.