[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]