[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]
unit WCSearch; {wildcard search across specified path(s)}
{ DEMO AT BOTTOM !! }
{---------------------------------------------------------------------------->
Unit to search a specified path for one or more files. Multi-directory
paths (using standard DOS semicolon-delimited path strings) and wildcards
are allowed. Uses FindFirst/FindNext-type syntax for flexibility, and
uses the DOSError variable to return same error codes as FindFirst/Next.
Requires either Object Professional or Turbo Professional from TurboPower
Software. UNDEFine the conditional directive "UseOPro" below if using
Turbo Professional.
Written by Steve Sneed, 26-May-90. Released to TurboPower Software for
their use or general release. I wrote this to allow searching a provided
path string for wildcards to ease batch downloads in the BBS package I'm
updating; I hope you find it useful.
>----------------------------------------------------------------------------}
{$DEFINE UseOPro}
interface
uses
DOS,
{$IFDEF UseOPro}
OpString;
{$ELSE}
TpString;
{$ENDIF}
procedure FindFirstWC(SFile,SPath : String;
Attribs : Byte;
var R : SearchRec;
var Path : PathStr);
{-Search for first entry matching "SFile" on "SPath"}
procedure FindNextWC(var R : SearchRec; var Path : PathStr);
{-Search for subsequent entries on SPath}
implementation
var
SrchPath : String;
SrchName : PathStr;
SrchAttr : Byte;
procedure FindFirstWC(SFile,SPath : String;
Attribs : Byte;
var R : SearchRec;
var Path : PathStr);
var I : Integer;
First : Boolean;
begin
First := True;
SrchAttr := Attribs;
SrchPath := SPath;
SrchName := SFile;
repeat
{if first time thru the loop, allow for an empty SPath}
if (SrchPath = '') and (NOT(First)) then begin
DOSError := 18;
exit;
end;
First := False;
{retrieve the next path to search}
I := Pos(';',SrchPath);
if I > 0 then begin
Path := AddBackSlash(Copy(SrchPath,1,Pred(I)));
Delete(SrchPath,1,I);
end
else begin
Path := AddBackSlash(SrchPath);
SrchPath := '';
end;
{look for a matching entry}
FindFirst(Path+SrchName,SrchAttr,R);
until DOSError <> 18;
end;
procedure FindNextWC(var R : SearchRec; var Path : PathStr);
var I : Integer;
begin
{see if any matching entries from last search}
FindNext(R);
if DOSError = 0 then exit;
repeat
{if the original search path is enpty, we're done}
if SrchPath = '' then begin
DOSError := 18;
exit;
end;
{retrieve the next path to search}
I := Pos(';',SrchPath);
if I > 0 then begin
Path := AddBackSlash(Copy(SrchPath,1,Pred(I)));
Delete(SrchPath,1,I);
end
else begin
Path := AddBackSlash(SrchPath);
SrchPath := '';
end;
{look for a matching entry}
FindFirst(Path+SrchName,SrchAttr,R);
until DOSError <> 18;
end;
end.
{ ----------------- DEMO -------------------------- }
program Search_Path; {demo program for WCSearch unit}
{Example program for the WCSearch unit}
uses
DOS, WCSearch;
var
S : String;
R : SearchRec;
I : Integer;
procedure EndIt(S : String);
begin
WriteLn(S);
Halt(1);
end;
begin
if ParamCount < 1 then
EndIt('Syntax: SRCHPATH [filespec] {path_to_search | *}');
if ParamCount > 1 then begin
S := ParamStr(2);
if S[1] = '*' then S := GetEnv('PATH');
end
else
S := '';
I := 0;
FindFirstWC(ParamStr(1),S,AnyFile,R,S);
while DOSError = 0 do begin
WriteLn(S+R.Name);
inc(I);
FindNextWC(R,S);
end;
if I = 0 then
WriteLn('No matching files')
else begin
Write(I,' file');
if I > 1 then Write('s');
WriteLn(' found');
end;
end.
[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]