home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0600 / CCE_0632.ZIP / CCE_0632 / GOBJ_111.ZIP / GOBJECTS.111 / SOURCE / FILELIST.PAS < prev    next >
Pascal/Delphi Source File  |  1994-03-03  |  2KB  |  120 lines
  1. program FileLister; {$X+}
  2.                                         { Idee aus TP/Win-ObjectWindows (Sybex) }
  3.  
  4. uses
  5.  
  6.     Dos,OProcs,OTypes,Objects;
  7.  
  8. type
  9.  
  10.     NameExtStr = string[12];
  11.     PFileList  = ^TFileList;
  12.  
  13.     TFileList = object(TStrCollection)
  14.         constructor Init(Path: PathStr; Attr: byte; SubDirs: boolean);
  15.         function First: string; virtual;
  16.         function Next: string; virtual;
  17.         procedure PrintAll; virtual;
  18.         private
  19.         Counter: integer
  20.     end;
  21.  
  22.  
  23. { *** Object TFILELIST *** }
  24.  
  25. constructor TFileList.Init(Path: PathStr; Attr: byte; SubDirs: boolean);
  26.  
  27.     procedure BuildList(Path: PathStr);
  28.         var Search: SearchRec;
  29.             Dir   : DirStr;
  30.             Name  : NameStr;
  31.             Ext   : ExtStr;
  32.  
  33.         function ValidDir: boolean;
  34.  
  35.             begin
  36.                 ValidDir:=(Search.Name<>'.') and
  37.                                     (Search.Name<>'..') and
  38.                                     (Search.Attr=Directory)
  39.             end;
  40.  
  41.         begin
  42.             Attr:=Attr and AnyFile;
  43.             FSplit(FExpand(Path),Dir,Name,Ext);
  44.             Dos.FindFirst(Path,Attr,Search);
  45.             while DosError=0 do
  46.                 begin
  47.                     Insert(ChrNew(Dir+Search.Name));
  48.                     FindNext(Search)
  49.                 end;
  50.             if SubDirs then
  51.                 begin
  52.                     Dos.FindFirst(Dir+'*.*',Directory,Search);
  53.                     while DosError=0 do
  54.                         begin
  55.                             if ValidDir then BuildList(Dir+Search.Name+'\'+Name+Ext);
  56.                             FindNext(Search)
  57.                         end
  58.                 end
  59.         end;
  60.  
  61.     begin
  62.         if not(TStringCollection.Init(100,10)) then fail;
  63.         BuildList(Path);
  64.         Counter:=0
  65.     end;
  66.  
  67.  
  68. function TFileList.First: string;
  69.  
  70.     begin
  71.         Counter:=0;
  72.         First:=Next
  73.     end;
  74.  
  75.  
  76. function TFileList.Next: string;
  77.  
  78.     begin
  79.         if Counter>=Count then Next:=''
  80.         else
  81.             begin
  82.                 if At(Counter)=nil then Next:=''
  83.                 else
  84.                     Next:=PString(At(Counter))^;
  85.                 inc(Counter)
  86.             end
  87.     end;
  88.  
  89.  
  90. procedure TFileList.PrintAll;
  91.  
  92.     procedure Print(p: PChar);
  93.  
  94.         begin
  95.             writeln(p)
  96.         end;
  97.  
  98.     begin
  99.         ForEach(@Print)
  100.     end;
  101.  
  102. { *** TFILELIST *** }
  103.  
  104.  
  105.     var FileList: PFileList;
  106.         i       : longint;
  107.  
  108.  
  109. begin
  110.     clrscr;
  111.     FileList:=new(PFileList,Init('C:\*.*',ReadOnly,true));
  112.     if FileList<>nil then
  113.         begin
  114.             FileList^.PrintAll;
  115.             writeln;
  116.             writeln(FileList^.Count,' Dateien');
  117.             dispose(FileList,Done)
  118.         end;
  119.     readkey
  120. end.