home *** CD-ROM | disk | FTP | other *** search
/ Carousel / CAROUSEL.cdr / mactosh / code / p_hfslis.sit < prev    next >
Text File  |  1988-06-20  |  5KB  |  190 lines
  1. 18-Jun-88 14:31:00-MDT,5082;000000000000
  2. Return-Path: <u-lchoqu%sunset@cs.utah.edu>
  3. Received: from cs.utah.edu by SIMTEL20.ARPA with TCP; Sat, 18 Jun 88 14:30:53 MDT
  4. Received: by cs.utah.edu (5.54/utah-2.0-cs)
  5.     id AA22250; Sat, 18 Jun 88 14:30:55 MDT
  6. Received: by sunset.utah.edu (5.54/utah-2.0-leaf)
  7.     id AA24629; Sat, 18 Jun 88 14:30:53 MDT
  8. Date: Sat, 18 Jun 88 14:30:53 MDT
  9. From: u-lchoqu%sunset@cs.utah.edu (Lee Choquette)
  10. Message-Id: <8806182030.AA24629@sunset.utah.edu>
  11. To: rthum@simtel20.arpa
  12. Subject: HFSlist.Pas
  13.  
  14. { Recursive HFS folder search }
  15.  
  16. PROGRAM FileList (Input, Output) ;
  17.  
  18. {$i MemTypes.Ipas  }
  19. {$i QuickDraw.Ipas }
  20. {$i OSIntf.Ipas    }
  21. {$i ToolIntf.Ipas  }
  22. {$i PackIntf.Ipas  }
  23. {$i HFS.Ipas       }
  24. {   MacPrint.Ipas  }
  25. {   FixMath.Ipas   }
  26. {   Graf3D.Ipas    }
  27. {   Speech.Ipas    }
  28.  
  29.  
  30. {$A+} { include code as comments in assembly generation }
  31. {$B-} { (Bundle Bit)  We don't have an icon yet. }
  32.       { T 'APPLUoUZ'} { No special type stuff yet }
  33. {$O-} { Overflow checks }
  34. {$R-} { Range Checks }
  35.  
  36.  
  37. Var
  38.    TextOut : Text;
  39.    PrintPos: Integer;
  40. { --------------------------------------------------------------------  }
  41.  
  42. PROCEDURE DumpOut (This: STR255);
  43. Begin
  44. Write (This);
  45. PrintPos := PrintPos + Length (This);
  46. if PrintPos >= 75 Then
  47.    Begin
  48.    Writeln; PrintPos := 0;
  49.    End;
  50. End;
  51. { --------------------------------------------------------------------  }
  52. { --------------------------------------------------------------------  }
  53. { --------------------------------------------------------------------  }
  54.  
  55. { The following code adapted from Apple's Macintosh Technical Note 68 }
  56.  
  57. PROCEDURE EnumerHFS (WhereToStart: LongInt);
  58. VAR
  59.    myCPB: CInfoPBRec;
  60.    err:   OSerr;
  61.    myWDPB: WDPBRec;
  62.    TotalFiles, TotalDirectories, TotalAny: integer;
  63.    FNAME :   STR255;
  64.    
  65.    PROCEDURE EnumerateCatalog (dirIDToSearch: LongInt);
  66.    VAR
  67.       index: integer;
  68.    Begin {EnumerateCatalog}
  69.       index := 1;
  70.       repeat
  71.            FName := '';
  72.        myCPB.ioFDirIndex:= index;
  73.        myCPB.ioNamePtr  := @Fname;
  74.        myCPB.ioDrDirID:= dirIDToSearch;  {We need to do this every time}
  75.        err := PBGetCatInfo (@myCPB, FALSE);
  76.        
  77.        if err = noErr then
  78.           if BitTst (@myCPB.ioFlAttrib,3) then {we have dir}
  79.              Begin
  80.          Writeln (TextOut,'<<', myCPB.ioNamePtr^);
  81.          DumpOut ('<');
  82.          EnumerateCatalog (myCPB.ioDrDirID);
  83.          DumpOut ('>');
  84.          TotalDirectories := TotalDirectories+1;
  85.          Writeln (TextOut,'>>');
  86.          err:= 0;
  87.          End
  88.           else {must be file}
  89.              Begin
  90.          Writeln (TextOut,'-- ', myCPB.ioNamePtr^);
  91.          DumpOut ('.');
  92.          TotalFiles := TotalFiles + 1;
  93.          End;
  94.        TotalAny := TotalFiles + TotalDirectories;
  95.        index := index + 1;
  96.        until err <> noErr;
  97.    End; {EnumerateCatalog}
  98.  
  99. Begin {EnumerHFS}
  100.    TotalFiles := 0;
  101.    TotalDirectories := 0;
  102.    
  103.    myWDPB.ioCompletion := NIL;
  104.    myWDPB.ioNamePtr    := @FName;
  105.    err := PBHgetVol (@myWDPB, FALSE);  { Get Default Volume }
  106.    Writeln (TextOut, Fname); 
  107.    
  108.    with MyCPB do Begin
  109.         iocompletion := NIL;
  110.     ioNamePtr := @FNAME;
  111.     ioVRefNum:= myWDPB.ioVRefNum; {Default Vol}
  112.    End; {With}
  113.    
  114.    EnumerateCatalog(WhereToStart);
  115.    
  116.    Writeln;
  117.    Writeln ('Total files: ', TotalFiles);
  118.    Writeln ('in ', TotalDirectories, ' folders');
  119. End; {EnumerHFS}
  120.  
  121. { --------------------------------------------------------------------  }
  122.  
  123. { Enumerate Flat File Structure }
  124. PROCEDURE  EnumerFlat;
  125. Var
  126.    Index: integer;
  127.    Err:   OSerr;
  128.    Block: ParamBlockRec;
  129.    Fname: Str255;
  130.    Reference: Integer;
  131. Begin
  132.    index := 1;
  133.    
  134.    Fname := '';
  135.    Block.ioNamePtr := @Fname;
  136.    Block.ioCompletion := NIL;
  137.    err := PBgetVol (@Block, FALSE);
  138.    Reference := Block.ioVRefNum;
  139.    Writeln (TextOut, Block.ioNamePtr^);
  140.    
  141.    Repeat
  142.        Fname := '';
  143.        Block.ioNamePtr    := @Fname;
  144.        Block.ioCompletion := Nil;
  145.        Block.ioVRefNum    := Reference;
  146.        Block.ioFversNum   := 0;
  147.        Block.ioFDirIndex  := index;
  148.        err := PBGetFInfo (@Block, FALSE);
  149.        if err = noErr then
  150.           Begin
  151.       Writeln (TextOut,'-- ', Block.ioNamePtr^);
  152.       DumpOut ('.');
  153.       Index := Index + 1;
  154.       End
  155.        else
  156.           Begin
  157.       Writeln;
  158.       Writeln ('Total Files: ', Index);
  159.       End;
  160.    until err <> noErr;
  161. End;
  162.  
  163. { --------------------------------------------------------------------  }
  164.  
  165. PROCEDURE Enumerate;
  166. VAR
  167.    HFSPTR: ^Integer;
  168. Begin
  169. Write (TextOut, '== Start Volume ');
  170. HFSPTR :=  POINTER ($3F6); {FSFCBLen}
  171. if HFSPTR^>0 Then EnumerHFS(2)
  172.              Else EnumerFlat;
  173. Writeln (TextOut, '== End Volume');
  174. End;
  175.  
  176. { --------------------------------------------------------------------  }
  177. { --------------------------------------------------------------------  }
  178.  
  179.  
  180. Begin
  181. PrintPos := 0;
  182. Open (TextOut, 'Directory List');
  183. Writeln ('(c) Copyright 1986 University of Utah Computer Center');
  184. Writeln ('Written by John Halleck');
  185. Writeln ('Sending file list to file     Directory List');
  186. Enumerate;
  187. Close (TextOut);
  188. Writeln ('Done. <CR> to continue'); Readln;
  189. End.
  190.