Carousel Volume 2 #1/carousel.iso/mactosh/code/p_hfslis.sit

Text File | 1988-06-20 | 4.8 KB | 190 lines

18-Jun-88 14:31:00-MDT,5082;000000000000
Return-Path: <[e-mail]>
Received: from cs.utah.edu by SIMTEL20.ARPA with TCP; Sat, 18 Jun 88 14:30:53 MDT
Received: by cs.utah.edu (5.54/utah-2.0-cs)
    id AA22250; Sat, 18 Jun 88 14:30:55 MDT
Received: by sunset.utah.edu (5.54/utah-2.0-leaf)
    id AA24629; Sat, 18 Jun 88 14:30:53 MDT
Date: Sat, 18 Jun 88 14:30:53 MDT
From: [e-mail] (Lee Choquette)
Message-Id: <[e-mail]>
To: [e-mail]
Subject: HFSlist.Pas

{ Recursive HFS folder search }

PROGRAM FileList (Input, Output) ;

{$i MemTypes.Ipas  }
{$i QuickDraw.Ipas }
{$i OSIntf.Ipas    }
{$i ToolIntf.Ipas  }
{$i PackIntf.Ipas  }
{$i HFS.Ipas       }
{   MacPrint.Ipas  }
{   FixMath.Ipas   }
{   Graf3D.Ipas    }
{   Speech.Ipas    }


{$A+} { include code as comments in assembly generation }
{$B-} { (Bundle Bit)  We don't have an icon yet. }
      { T 'APPLUoUZ'} { No special type stuff yet }
{$O-} { Overflow checks }
{$R-} { Range Checks }


Var
   TextOut : Text;
   PrintPos: Integer;
{ --------------------------------------------------------------------  }

PROCEDURE DumpOut (This: STR255);
Begin
Write (This);
PrintPos := PrintPos + Length (This);
if PrintPos >= 75 Then
   Begin
   Writeln; PrintPos := 0;
   End;
End;
{ --------------------------------------------------------------------  }
{ --------------------------------------------------------------------  }
{ --------------------------------------------------------------------  }

{ The following code adapted from Apple's Macintosh Technical Note 68 }

PROCEDURE EnumerHFS (WhereToStart: LongInt);
VAR
   myCPB: CInfoPBRec;
   err:   OSerr;
   myWDPB: WDPBRec;
   TotalFiles, TotalDirectories, TotalAny: integer;
   FNAME :   STR255;

   PROCEDURE EnumerateCatalog (dirIDToSearch: LongInt);
   VAR
      index: integer;
   Begin {EnumerateCatalog}
      index := 1;
      repeat
           FName := '';
       myCPB.ioFDirIndex:= index;
       myCPB.ioNamePtr  := @Fname;
       myCPB.ioDrDirID:= dirIDToSearch;  {We need to do this every time}
       err := PBGetCatInfo (@myCPB, FALSE);

       if err = noErr then
          if BitTst (@myCPB.ioFlAttrib,3) then {we have dir}
             Begin
         Writeln (TextOut,'<<', myCPB.ioNamePtr^);
         DumpOut ('<');
         EnumerateCatalog (myCPB.ioDrDirID);
         DumpOut ('>');
         TotalDirectories := TotalDirectories+1;
         Writeln (TextOut,'>>');
         err:= 0;
         End
          else {must be file}
             Begin
         Writeln (TextOut,'-- ', myCPB.ioNamePtr^);
         DumpOut ('.');
         TotalFiles := TotalFiles + 1;
         End;
       TotalAny := TotalFiles + TotalDirectories;
       index := index + 1;
       until err <> noErr;
   End; {EnumerateCatalog}

Begin {EnumerHFS}
   TotalFiles := 0;
   TotalDirectories := 0;

   myWDPB.ioCompletion := NIL;
   myWDPB.ioNamePtr    := @FName;
   err := PBHgetVol (@myWDPB, FALSE);  { Get Default Volume }
   Writeln (TextOut, Fname);

   with MyCPB do Begin
        iocompletion := NIL;
    ioNamePtr := @FNAME;
    ioVRefNum:= myWDPB.ioVRefNum; {Default Vol}
   End; {With}

   EnumerateCatalog(WhereToStart);

   Writeln;
   Writeln ('Total files: ', TotalFiles);
   Writeln ('in ', TotalDirectories, ' folders');
End; {EnumerHFS}

{ --------------------------------------------------------------------  }

{ Enumerate Flat File Structure }
PROCEDURE  EnumerFlat;
Var
   Index: integer;
   Err:   OSerr;
   Block: ParamBlockRec;
   Fname: Str255;
   Reference: Integer;
Begin
   index := 1;

   Fname := '';
   Block.ioNamePtr := @Fname;
   Block.ioCompletion := NIL;
   err := PBgetVol (@Block, FALSE);
   Reference := Block.ioVRefNum;
   Writeln (TextOut, Block.ioNamePtr^);

   Repeat
       Fname := '';
       Block.ioNamePtr    := @Fname;
       Block.ioCompletion := Nil;
       Block.ioVRefNum    := Reference;
       Block.ioFversNum   := 0;
       Block.ioFDirIndex  := index;
       err := PBGetFInfo (@Block, FALSE);
       if err = noErr then
          Begin
      Writeln (TextOut,'-- ', Block.ioNamePtr^);
      DumpOut ('.');
      Index := Index + 1;
      End
       else
          Begin
      Writeln;
      Writeln ('Total Files: ', Index);
      End;
   until err <> noErr;
End;

{ --------------------------------------------------------------------  }

PROCEDURE Enumerate;
VAR
   HFSPTR: ^Integer;
Begin
Write (TextOut, '== Start Volume ');
HFSPTR :=  POINTER ($3F6); {FSFCBLen}
if HFSPTR^>0 Then EnumerHFS(2)
             Else EnumerFlat;
Writeln (TextOut, '== End Volume');
End;

{ --------------------------------------------------------------------  }
{ --------------------------------------------------------------------  }


Begin
PrintPos := 0;
Open (TextOut, 'Directory List');
Writeln ('(c) Copyright 1986 University of Utah Computer Center');
Writeln ('Written by John Halleck');
Writeln ('Sending file list to file     Directory List');
Enumerate;
Close (TextOut);
Writeln ('Done. <CR> to continue'); Readln;
End.