program FileList (Input, Output);

{ uses    HFS;= }

	var
		TextOut: Text;
		PrintPos: Integer;


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

	function MyBitTst (APtr: Ptr; ABit: Integer): Boolean;
		var
			Lower: Integer;
	begin
		Lower := Abit mod 8;
		MyBitTst := BitTst(Aptr, (Abit - Lower) + (7 - Lower));
	end;

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

	procedure DumpOut (This: STR255);
	begin
		Write(This);
		PrintPos := PrintPos + Length(This);
		if PrintPos >= 75 then
			begin
				Writeln;
				PrintPos := 0;
			end;
	end;

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

	procedure FLUSH;
	begin
		if PrintPos <> 0 then
			begin
				Writeln;
				PrintPos := 0
			end
	end;

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


	procedure SayFile (TheName: STR255; TheFlags: Finfo);
	begin
		DumpOut('.');
	end;

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

	procedure SayFolder (TheName: STR255);
	begin
		DumpOut('<');
	end;

	procedure EndFolder;
	begin
		DumpOut('>');
	end;

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

	procedure SayVolume (TheName: STR255);
	begin
		WriteLn('Volume: ', TheName);
		DumpOut('(');
	end;

	procedure EndVolume;
	begin
		DumpOut(')');
		Flush;
	end;

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

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

	procedure EnumerHFS;
		var
			myCPB: CInfoPBRec;
			err, Verr: OSerr;
			myWDPB: HparamBlockRec;
			TotalVolumes: Integer;
			FNAME: STR255;
			WorkingName: STR255;
			TempParam: HparamBlockRec;
			TempCPB: CInfoPBRec;
			Worked: Boolean;
			WorkingDir, TempDir: WDPBrec;

		function EnumerateCatalog (dirIDToSearch: LongInt): Boolean;
			var
				TotalFiles, TotalFolders, TotalAny: integer;
				Worked: Boolean;
				index: integer;
		begin {EnumerateCatalog}
			TotalFiles := 0;
			TotalFolders := 0;
			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 MyBitTst(@myCPB.ioFlAttrib, 4) then {we have dir}
						begin
							SayFolder(myCPB.ioNamePtr^);
							Worked := EnumerateCatalog(myCPB.ioDrDirID);
							EndFolder;
							if Worked then
								TotalFolders := TotalFolders + 1;
							err := 0;
						end
					else {must be file}
						begin
							dumpout('.');
							TotalFiles := TotalFiles + 1;
						end;
				TotalAny := TotalFiles + TotalFolders;
				index := index + 1;
			until err <> noErr;
{    if  totalany = 0 then             This used to delete empty folders , }
{    begin }
{    Fname := ' ';}
{Flush;}
{TempCPB . iocompletion := nil;}
{TempCPB . ioNamePtr := @ FNAME;}
{TempCPB . ioVRefNum := myWDPB . ioVRefNum;}
{TempCPB . ioFDirIndex := - 1;}
{TempCPB . ioNamePtr := @ Fname;}
{TempCPB . ioDrDirID := dirIDToSearch;}
{    err := PBGetCatInfo ( @ TempCPB , FALSE );}
{writeln ( 'Empty: ' , Fname );}
{TempDir := WorkingDir;}
{TempDir . iocompletion := nil;}
{TempDir . ioNamePtr := nil;}
{TempDir . ioVrefNum := myWDPB . ioVRefNum;}
{TempDir . ioWDDirID := TempCPB . ioDrParID;}
{TempDir . ioWDProcID := 0;}
{err := PBOpenWd ( @ TempDir , false );}
{TempParam . ioFVersNum := 0;}
{TempParam . iocompletion := nil;}
{TempParam . ioNamePtr := @ FNAME;}
{TempParam . ioVRefNum := TempDir . ioVRefNum;}
{TempParam . ioDirID := TempCPB . ioDrDirID;}
{err := PBDelete ( @ TempParam , False );}
{err := PBCloseWD ( @ TempDir , false );}
{    end;}
			EnumerateCatalog := TotalAny <> 0;
		end; {EnumerateCatalog}

	begin {EnumerHFS}
		TotalVolumes := 0;

		repeat
			WorkingDir.ioCompletion := nil;
			WorkingDIr.ioNamePtr := @WorkingName;
			verr := PBHGetVol(@WorkingDir, false);

			myWDPB.ioCompletion := nil;
			myWDPB.ioNamePtr := @FName;
			myWDPB.ioVolIndex := TotalVolumes + 1;
			Verr := PBHgetVinfo(@myWDPB, FALSE);  { Get a volume }
			if Verr = NoErr then
				begin
					TotalVolumes := TotalVolumes + 1;
					SayVolume(Fname);

					with MyCPB do
						begin
							iocompletion := nil;
							ioNamePtr := @FNAME;
							ioVRefNum := myWDPB.ioVRefNum;
						end; {With}

					Worked := EnumerateCatalog(2);
					EndVolume;

				end;
		until Verr <> noErr;

		if TotalVolumes > 1 then
			Writeln('(', TotalVolumes, ' Volumes)');
	end; {EnumerHFS}

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

{ Enumerate Flat File Structure }
	procedure EnumerFlat;
		var
			Index: integer;
			Err, Verr: OSerr;
			Block: ParamBlockRec;
			Fname: Str255;
			Reference: Integer;
			ThisVol: Integer;
	begin
		ThisVol := 0;

		repeat
			Fname := '';
			Block.ioNamePtr := @Fname;
			Block.ioCompletion := nil;
			Block.ioVolIndex := ThisVol + 1;
			Verr := PBgetVinfo(@Block, FALSE);
			if Verr = NoErr then
				begin
					ThisVol := ThisVol + 1;
					Reference := Block.ioVRefNum;
					SayVolume(Block.ioNamePtr^);
					Index := 0;

					repeat
						Fname := '';
						Block.ioNamePtr := @Fname;
						Block.ioCompletion := nil;
						Block.ioVRefNum := Reference;
						Block.ioFversNum := 0;
						Block.ioFDirIndex := index + 1;
						err := PBGetFInfo(@Block, FALSE);
						if err = noErr then
							begin
								Index := Index + 1;
								SayFile(Block.ioNamePtr^, Block.ioFlFndrInfo);
							end
						else
							begin
								EndVolume;
								Writeln('Total Files: ', Index);
							end;
					until err <> noErr;
				end
			else if ThisVol <> 1 then
				Writeln('Total Volumes: ', ThisVol);
		until Verr <> NoErr;

	end;

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

	procedure Enumerate;
		var
			HFSPTR: ^Integer;
	begin
		HFSPTR := POINTER($3F6); {FSFCBLen}
		if HFSPTR^ > 0 then
			EnumerHFS
		else
			EnumerFlat;
	end;

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


begin
	ShowText;
	PrintPos := 0;
	Open(TextOut, 'Directory List');
	ReWrite(TextOut);
	Writeln('© Copyright 1986 University of Utah Computer Center');
	Writeln('             Written by John Halleck');
	Writeln;
	Writeln('Sending file list to file     Directory List');
	Enumerate;
	Close(TextOut);
	Writeln('Done. Click Mouse to Continue');
	while not Button do
		;
end.