home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUIN / WHERE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  3KB  |  101 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 462 of 587
  3. From : Raphael Vanney                      2:320/7.0            02 Jun 93  00:41
  4. To   : Frank Livaudais
  5. Subj : Tree?
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Hi !
  8.  
  9. FL>Is there a tree type function is pascal?  I want to find all the
  10. FL>directories on a given drive so i can search for files but am unsure of
  11. FL>how to go about it, i can find files in given directories but i wanna
  12. FL>search the whole drive, so is there a way to find out how many and what
  13. FL>directories there are?
  14.  
  15. Here follows the source of a 'where' program :}
  16.  
  17. {$A-,B-,D+,E-,F-,I+,L-,N-,O-,R-,S-,V-}
  18. {$M 16384,0,0}
  19.  
  20. uses DOS , Crt ;
  21.  
  22. var Mask   : String[12] ;
  23.     t      : DateTime   ;
  24.     n      : integer    ;
  25.     Sortie : Text       ;
  26.     as     : string[5]  ;
  27.  
  28. procedure Fouille_Rep( NomRep : PathStr ) ;
  29. var s : SearchRec ;
  30. begin
  31.      Write(NomRep);ClrEol;write(#13);
  32.  
  33.      FindFirst(NomRep+'*.*',AnyFile,s);
  34.      while DosError=0 do
  35.      begin
  36.           if (s.name[1]<>'.') and ((s.attr and Directory)=Directory)
  37.              then Fouille_Rep(NomRep+s.name+'\');
  38.           FindNext(s)
  39.      end;
  40.  
  41.      FindFirst(NomRep+Mask,AnyFile,s);
  42.      while DosError=0 do
  43.      with s do
  44.      begin
  45.           UnPackTime(time,t);
  46.           inc(n);
  47.           write (Sortie, name : 12,' ');
  48.           if (attr and Directory)<>Directory then
  49.           begin
  50.                as:='     ';
  51.                write(Sortie, size : 8);
  52.                if (attr and ReadOnly)=ReadOnly then as[2]:='R';
  53.                if (attr and Hidden  )=Hidden   then as[3]:='H';
  54.                if (attr and SysFile )=SysFile  then as[4]:='S';
  55.                if (attr and Archive )=Archive  then as[5]:='A';
  56.                write(Sortie, as)
  57.           end else write(Sortie, '  Rpertoire ');
  58.           write(Sortie, t.day:3,'/');
  59.           if t.month<10 then write(Sortie, '0');
  60.           write(Sortie, t.month,'/',t.year:4,' ',t.hour:2,':');
  61.           if t.min<10 then write(Sortie, '0');
  62.           write(Sortie, t.min);
  63.           writeln(Sortie, ' ',NomRep);
  64.           if KeyPressed then exit;
  65.           FindNext(s)
  66.      end
  67. end;
  68.  
  69. var dir, nom, ext : string ;
  70.  
  71. begin
  72.      if paramcount<>1 then
  73.      begin
  74.           writeln(' - WHERE [disque:][repertoire]<nom_fichier>');
  75.           writeln('   jockers autoriss.');
  76.           writeln;
  77.           halt
  78.      end;
  79.  
  80.      Assign(Sortie, '');
  81.      ReWrite(Sortie);
  82.      FSplit(ParamStr(1),dir,nom,ext);
  83.      if ext='' then ext:='.*';
  84.      if nom='' then nom:='*';
  85.      if dir[length(dir)]<>'\' then dir:=dir+'\';
  86.      { notez que ce test est valable si dir='' (dir[0]=#0, <>'\') }
  87.  
  88.      mask:=nom+ext;
  89.      write(Sortie, 'Recherche de '+mask);
  90.      if dir='\' then writeln(Sortie, ' dans tous les rpertoires')
  91.                 else writeln(Sortie, ' dans '+dir);
  92.      writeln;
  93.      n:=0;
  94.      Fouille_Rep(dir);
  95.      if KeyPressed then writeln('Recherche interrompue par l''utilisateur.');
  96.      while KeyPressed do write(ReadKey,#8);
  97.      ClrEol;
  98.      writeln;
  99.      writeln(n,' fichier(s) trouv(s)');
  100.      Close(Sortie);
  101. end.