Power-Programmierung/CD1.mdf/pascal/library/dos/tug__002/scan.pas

Pascal/Delphi Source File | 1988-08-08 | 5.5 KB | 191 lines

{TUG PDS CERT 1.01 (Pascal)

==========================================================================

                  TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION

The Turbo User Group (TUG) is recognized by Borland International as the
official support organization for Turbo languages.  This file has been
compiled and verified by the TUG library staff.  We are reasonably certain
that the information contained in this file is public domain material, but
it is also subject to any restrictions applied by its author.

This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
DOMAIN, provided as a service of TUG for the use of its members.  The
Turbo User Group will not be liable for any damages, including any lost
profits, lost savings or other incidental or consequential damages arising
out of the use of or inability to use the contents, even if TUG has been
advised of the possibility of such damages, or for any claim by any
other party.

To the best of our knowledge, the routines in this file compile and function
properly in accordance with the information described below.

If you discover an error in this file, we would appreciate it if you would
report it to us.  To report bugs, or to request information on membership
in TUG, please contact us at:

             Turbo User Group
             PO Box 1510
             Poulsbo, Washington USA  98370

--------------------------------------------------------------------------
                       F i l e    I n f o r m a t i o n

* DESCRIPTION
Turbo Pascal V4.0 code to scan all directories on a disk. As configured
only displays the name of each directory (like DOS's TREE). But you can
add your own code to make it do whatever you want.

* ASSOCIATED FILES

* CHECKED BY
DRM - 08/08/88

* KEYWORDS
TURBO PASCAL V4.0 DIRECTORY TREE

==========================================================================
}
Program Scan;

{TP4 code to scan all directories on a disk and allow the
 program to do something in each directory.  The routine
 that works with the files in each directory is called
 ProcessFilesInFoundDirectory.  All it does here is
 display the pathname of the found directory.  Substitute
 your own code using FindFirst/FindNext within the found
 directory.}

Uses Dos,Crt;

const
  SignOn = 'Directory Scan';
  Notice = 'Copyright (c) 1988 Bayshore Designs, Inc.';
  Notice1= 'Permission given to modify and use for non-commercial purposes.';
  Notice2= 'All other rights reserved.';

var
  DirList    : array[1..500] of String[64]; {Array to hold names of previously found directories}
  DirInfo    : SearchRec; {Defined in DOS Unit for FindFirst call}
  i          : integer; {Index for DirList array}
  IsNewDir,
  done       : boolean;
  FoundDir,
  name       : string[64];
  TestDir,
  StartDir,
  CurDir     : string[64];

Procedure DoSignOns;
  begin
    Writeln(SignOn);
    Writeln(Notice);
    Writeln(Notice1);
    Writeln(Notice2);
    Writeln;
  end;

Function NotPreviouslyFound(d:string; s:string) : boolean;
  var
    j      : integer;
    f      : file;
    attrib : word;

  begin
    If (s = '.') or (s = '..') then {Eliminate 'dot' entries}
      begin
        NotPreviouslyFound:=false;
      end
      else
      begin
        j:=1;
        While j<i do
          begin
            If DirList[j]=d+s then {Check against previously found dirs}
              begin
                NotPreviouslyFound:=false;
                j:=i+1;
              end
              else
              begin
                j:=j+1;
              end;
          end;
        If j=i then
          begin
            Assign(f,s);
            GetFAttr(f,attrib);
            If attrib and Directory <> 0 then {Check that it's a directory}
              begin
                NotPreviouslyFound:=true;
              end
              else
              begin
                NotPreviouslyFound:=false;
              end;
          end;
      end;
  end;

Procedure ProcessFilesInFoundDir;
  begin

    {Substitute your specific FindFirst/FindNext code here to process
     files in this directory in whatever way you'd like.  The next
     two lines merely display the name of the found dir and do nothing
     with the actual files in that directory.}

    GetDir(0,TestDir);
    Writeln(TestDir);
  end;

BEGIN
DoSignOns;
{Initialize}
GetDir(0,StartDir);
CurDir:=StartDir;
ChDir('\');
FoundDir:='\';
i := 1; {index to DirList}
done:=false;

{Scan until attempt is made to go 'above' root dir}
While not done do
  begin
    IsNewDir:=false;
    FindFirst('*.*',Directory,DirInfo);
    FoundDir:=DirInfo.name;
    While (not IsNewDir) and (DosError=0) do
      begin
        IsNewDir := NotPreviouslyFound(CurDir,DirInfo.name);
        If (not IsNewDir) then
          begin
            FindNext(DirInfo);
            FoundDir:=DirInfo.name;
          end;
      end;

    If IsNewDir then {Save it and keep going down the chain}
      begin
        DirList[i] := CurDir+FoundDir;
        i := i+1;
        ChDir(FoundDir);
        GetDir(0,CurDir);
      end
      else
      begin
        ProcessFilesInFoundDir; {i.e., do whatever you want with them}
        GetDir(0,TestDir);
        If Copy(TestDir,Length(TestDir),1) <> '\' then {check if we're done...}
          begin
            Chdir('..');
            GetDir(0,CurDir);
          end
          else
            done:=true;
      end;
  end;
  Chdir(StartDir); {land the user in the starting directory...}
END.