home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / packer / arc / arctool / scan.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-29  |  3.9 KB  |  152 lines
  1. {
  2.                        F i l e    I n f o r m a t i o n
  3.  
  4. * DESCRIPTION
  5. Turbo Pascal V4.0 code to scan all directories on a disk. As configured
  6. only displays the name of each directory (like DOS's TREE). But you can
  7. add your own code to make it do whatever you want.
  8.  
  9. }
  10. Program Scan;
  11.  
  12. {TP4 code to scan all directories on a disk and allow the
  13.  program to do something in each directory.  The routine
  14.  that works with the files in each directory is called
  15.  ProcessFilesInFoundDirectory.  All it does here is
  16.  display the pathname of the found directory.  Substitute
  17.  your own code using FindFirst/FindNext within the found
  18.  directory.}
  19.  
  20. Uses Dos,Crt;
  21.  
  22. const
  23.   SignOn = 'Directory Scan';
  24.   Notice = 'Copyright (c) 1988 Bayshore Designs, Inc.';
  25.   Notice1= 'Permission given to modify and use for non-commercial purposes.';
  26.   Notice2= 'All other rights reserved.';
  27.  
  28. var
  29.   DirList    : array[1..500] of String[64]; {Array to hold names of previously found directories}
  30.   DirInfo    : SearchRec; {Defined in DOS Unit for FindFirst call}
  31.   i          : integer; {Index for DirList array}
  32.   IsNewDir,
  33.   done       : boolean;
  34.   FoundDir,
  35.   name       : string[64];
  36.   TestDir,
  37.   StartDir,
  38.   CurDir     : string[64];
  39.  
  40. Procedure DoSignOns;
  41.   begin
  42.     Writeln(SignOn);
  43.     Writeln(Notice);
  44.     Writeln(Notice1);
  45.     Writeln(Notice2);
  46.     Writeln;
  47.   end;
  48.  
  49. Function NotPreviouslyFound(d:string; s:string) : boolean;
  50.   var
  51.     j      : integer;
  52.     f      : file;
  53.     attrib : word;
  54.  
  55.   begin
  56.     If (s = '.') or (s = '..') then {Eliminate 'dot' entries}
  57.       begin
  58.         NotPreviouslyFound:=false;
  59.       end
  60.       else
  61.       begin
  62.         j:=1;
  63.         While j<i do
  64.           begin
  65.             If DirList[j]=d+s then {Check against previously found dirs}
  66.               begin
  67.                 NotPreviouslyFound:=false;
  68.                 j:=i+1;
  69.               end
  70.               else
  71.               begin
  72.                 j:=j+1;
  73.               end;
  74.           end;
  75.         If j=i then
  76.           begin
  77.             Assign(f,s);
  78.             GetFAttr(f,attrib);
  79.             If attrib and Directory <> 0 then {Check that it's a directory}
  80.               begin
  81.                 NotPreviouslyFound:=true;
  82.               end
  83.               else
  84.               begin
  85.                 NotPreviouslyFound:=false;
  86.               end;
  87.           end;
  88.       end;
  89.   end;
  90.  
  91. Procedure ProcessFilesInFoundDir;
  92.   begin
  93.  
  94.     {Substitute your specific FindFirst/FindNext code here to process
  95.      files in this directory in whatever way you'd like.  The next
  96.      two lines merely display the name of the found dir and do nothing
  97.      with the actual files in that directory.}
  98.  
  99.     GetDir(0,TestDir);
  100.     Writeln(TestDir);
  101.   end;
  102.  
  103. BEGIN
  104. DoSignOns;
  105. {Initialize}
  106. GetDir(0,StartDir);
  107. CurDir:=StartDir;
  108. ChDir('\');
  109. FoundDir:='\';
  110. i := 1; {index to DirList}
  111. done:=false;
  112.  
  113. {Scan until attempt is made to go 'above' root dir}
  114. While not done do
  115.   begin
  116.     IsNewDir:=false;
  117.     FindFirst('*.*',Directory,DirInfo);
  118.     FoundDir:=DirInfo.name;
  119.     While (not IsNewDir) and (DosError=0) do
  120.       begin
  121.         IsNewDir := NotPreviouslyFound(CurDir,DirInfo.name);
  122.         If (not IsNewDir) then
  123.           begin
  124.             FindNext(DirInfo);
  125.             FoundDir:=DirInfo.name;
  126.           end;
  127.       end;
  128.  
  129.     If IsNewDir then {Save it and keep going down the chain}
  130.       begin
  131.         DirList[i] := CurDir+FoundDir;
  132.         i := i+1;
  133.         ChDir(FoundDir);
  134.         GetDir(0,CurDir);
  135.       end
  136.       else
  137.       begin
  138.         ProcessFilesInFoundDir; {i.e., do whatever you want with them}
  139.         GetDir(0,TestDir);
  140.         If Copy(TestDir,Length(TestDir),1) <> '\' then {check if we're done...}
  141.           begin
  142.             Chdir('..');
  143.             GetDir(0,CurDir);
  144.           end
  145.           else
  146.             done:=true;
  147.       end;
  148.   end;
  149.   Chdir(StartDir); {land the user in the starting directory...}
  150. END.
  151. 
  152.