home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / SORTDIR.PAS < prev    next >
Pascal/Delphi Source File  |  2000-06-30  |  25KB  |  561 lines
  1. Program TestSortedDirectory;
  2.  
  3.       {This program (barely) compiled in a 59.0 kilobyte TPA}
  4.  
  5. Procedure SortedDirectory;
  6.  
  7. {  Gets and writes an sorted vertically displayed CP/M directory of a
  8.   selected disk: gives file sizes in KiloBytes, sorts alphabetically,
  9.   correctly treats large files > 1 physical extent.  Also, this CP/M
  10.   procedure will accept any drive from "A:" to "P:", and any standard
  11.   CP/M wildcard file specification (i.e. *.COM, *.PAS, C:TUR*.*, etc).
  12.   Files with the "System" attribute set may be displayed if the option
  13.   "/s" is appended to the drive-spec & filename string.
  14.  
  15.    Based on original program by Mike Yarus, 2231 16th Street, Boulder,
  16.   CO 80302, Compuserve 73145,513.  I extend my thanks to Mike for his
  17.   program code and inspiration.  All I have done is add to his work.
  18.  
  19.    Somewhat modified, now will work with hard or floppy disks.  The file
  20.   size algorithm now correctly implemented for: Molecular's n/STAR, CP/M,
  21.   CP/M+, MP/M II.  Should also work for TurboDos and other MP/M derived
  22.   operating systems.
  23.    Will properly handle file sizes up to 32 megabytes for the following:
  24.   Molecular's "n/STAR", MP/M, or TurboDos.
  25.  
  26.    This procedure will add an additional 3,751 bytes code, and 615 bytes
  27.   data to any program which utilizes "SortedDirectory".  Please feel free
  28.   to reduce procedure size, and please let me know how to do so...
  29.  
  30.      Don V Wells, Jr.  Alexandria, Virginia 22309, CompuServe 72447,666.
  31.                   Turbo Pascal 3.00A CP/M  May 29, 1986
  32. }
  33.  
  34.                 { Version 1.0   May   29, 1986 by DVWjr }
  35.  
  36. Const
  37.   NO_MORE_FILES     = $FF;  {No more files found on Bdos search for first and next}
  38.   SEARCH_FOR_FIRST  = 17;   {Bdos Search for first function number}
  39.   SEARCH_FOR_NEXT   = 18;   {Bdos Search for Next function number}
  40.   SET_DMA_ADDRESS   = 26;   {Bdos Set DMA Address function number}
  41.   CMD_LINE          = 23;
  42.   MSG_LINE          = 24;
  43.  
  44. Type
  45.   Str16          = String[16];
  46.   Str14          = String[14];
  47.   Str12          = String[12];
  48.   AnyFcb         = Array[0..35] of Byte;
  49.   AnyDma         = Array[0..127] of Byte;
  50.   DirEntry_Ptr   = ^DirEntryRecord;
  51.   DirEntryRecord =
  52.     record
  53.       FileName    : Str12;         {file name}
  54.       FileSize    : Integer;       {file size in KiloBytes}
  55.       Left_Ptr    : DirEntry_Ptr;  {Left Pointer}
  56.       Right_Ptr   : DirEntry_Ptr;  {Right Pointer}
  57.     end; {DirEntryRecord}
  58.  
  59. Var
  60.   MyFcb  : AnyFcb;  {a masking File Control Block}
  61.   MyDma  : AnyDma;  {a directory entry buffer, (can not use $80, Turbo Uses!)}
  62.  
  63.   BdosFuncNum        : Byte;     {number of the CP/M Bdos function required}
  64.   DirPageNdex        : Byte;     {which of the 4 dir entries in MyDma is current?}
  65.  
  66.   TargetDrive        : Char;                {Drives "A:".."P:"}
  67.   TargetDriveAndFile : Str14;               {The file which will be our directory mask}
  68.  
  69.   Entry_Ptr          : DirEntry_Ptr;        {the new entry pointer}
  70.   Root_Ptr           : DirEntry_Ptr;        {the root entry pointer}
  71.  
  72.   BlockSizeInKb      : Byte;                {The variable block-size in kilo-bytes}
  73.   SysFiles           : Boolean;             {Flag for showing (or not) files with }
  74.                                             { the "System" attribute set.         }
  75.  
  76.   NumOfDirEntries    : Integer;     {number of directory entries, including >1 extents}
  77.   NumOfFiles         : Integer;     {Number of files; controls screen print position;
  78.                                     { and in most casees will be 2048 max}
  79.  
  80. {***************************************************************************}
  81.  
  82. Procedure ClrEos;
  83.  begin
  84.   CrtInit;  {I have "Corruptly" used Turbo's CrtInit as a Wyse-50    }
  85.             {Clear-to-End-of-Screen command via Turbo Pascal's Tinst }
  86.             {install program, since there is no formal ClrEos defined}
  87.  
  88.                       {You must find some way to get a}
  89.             {Terminal-Clear-to-End-of-Screen, or equivalent here}
  90.  end; {Procedure ClrEos}
  91.  
  92.  
  93. Function UpperCase(InputStr : Str16) : Str16;
  94.    Var
  95.      index : Byte;
  96.  
  97.   begin { of function UpperCase}
  98.     For index := 1 to Length(InputStr) do
  99.      InputStr[index] := Upcase(InputStr[index]);
  100.     UpperCase := InputStr;
  101.   end;  { of function UpperCase}
  102.  
  103.  
  104. Function DriveLoggedIn(DriveLetter : Char) : Boolean;
  105.  
  106.    Const
  107.      RETURN_LOGIN_VECTOR   =  24;
  108.  
  109.    Var
  110.      Result          : Integer;
  111.      DriveNumber     : Byte;
  112.      DriveBitNumber  : Integer;
  113.  
  114.  begin  {of function DriveLoggedIn}
  115.   DriveLetter := UpCase(DriveLetter);
  116.   DriveNumber := Ord(DriveLetter) - $41;
  117.   DriveBitNumber :=  1 shl DriveNumber;
  118.   Result := BdosHL(RETURN_LOGIN_VECTOR);
  119.   DriveLoggedIn := ((Result and DriveBitNumber) = DriveBitNumber);
  120.  end;   {of function DriveLoggedIn}
  121.  
  122.  
  123. Procedure Get_DriveAndFileName_SysFlag(var DriveAndFileName : Str14;
  124.                                        var ShowSystemFiles  : Boolean);
  125. Var
  126.   DriveFileSysFlag  : Str16;
  127.   SlashPos          : Byte;
  128.  
  129.  
  130. begin   {Procedure Get_DriveAndFileName_SysFlag}
  131.   GotoXY(1,CMD_LINE); ClrEol;
  132.   write('Directory of drive: ');
  133.   LowVideo;
  134.   write('---> [X]:FileName.Typ >');
  135.   BufLen := 16;
  136.   HighVideo;
  137.   Read(DriveFileSysFlag);
  138.   LowVideo;
  139.   GotoXY(1,MSG_LINE); ClrEol;
  140.   write('working...');
  141.   DriveFileSysFlag := UpperCase(DriveFileSysFlag);
  142.   SlashPos := Pos('/S',DriveFileSysFlag);
  143.   if SlashPos = 0 then ShowSystemFiles := FALSE
  144.   else
  145.    begin
  146.     ShowSystemFiles := TRUE;
  147.     Delete(DriveFileSysFlag,SlashPos,2);
  148.   end; {if}
  149.   DriveAndFileName := DriveFileSysFlag;
  150. end;   {Procedure Get_DriveAndFileName_SysFlag}
  151.  
  152.  
  153.  
  154. Procedure Init_MyFcb(    InputDriveAndFile : Str14;
  155.                      var DriveLetter       : Char;
  156.                      var FcbToInit         : AnyFcb);
  157.  
  158.        {Note: This procedure, with some modifications, borrowed from }
  159.        {      the program: Turbo Kermit.                             }
  160.  
  161. { Initialize an FCB with a filename and filetype for use with BDOS calls.     }
  162. { File control block set for reading all masked files.                        }
  163. { Note that when only the first extent of a big file is needed (eg, for a     }
  164. { list of file names only) one sets 13th byte (Count = 12) of the fcb to zero.}
  165. { But, in our case, we NEED the 13th byte set to '?' for the FCB BDOS search, }
  166. { in order to get the file size by getting ALL of a file's physical extents.  }
  167.  
  168.  
  169. Type
  170.   Str8  = String[8];
  171.   Str3  = String[3];
  172.  
  173. Var
  174.   Count        : Byte;
  175.   FileName     : Str8;
  176.   FileType     : Str3;
  177.  
  178.  
  179. Procedure Parse_FileName(    InputFile   : Str14;
  180.                          var DriveLetter : Char;
  181.                          var FileName    : Str8;
  182.                          var FileType    : Str3 );
  183.  
  184.  
  185.     {Note: This procedure, with some modifications, borrowed from    }
  186.     {      the program: Turbo Kermit.                                }
  187.  
  188.     {This procedure converts a string into the standard CP/M format  }
  189.     {for processing. This format is all upper case, and inserts ?'s  }
  190.     {into the string if the wildcards ? or * are found in the string.}
  191.     { Finally, the string is expanded so spaces are placed in any    }
  192.     {unfilled positions in the name.  These are placed in the middle }
  193.     {of the filename. (i.e.  abc.de is converted to 'abc     .de ')  }
  194.  
  195.   Const
  196.     GET_CURRENT_DEFAULT_DISK = 25;  {Bdos Return Current Disk function number}
  197.  
  198.   Var
  199.     Insert_Position : Byte;
  200.     Count           : Byte;
  201.  
  202.  
  203.   begin {Procedure Parse_FileName}
  204.     InputFile := UpperCase(InputFile);
  205.     if Pos('.', InputFile) <> 0 then      {separate the file name and type}
  206.      begin
  207.       FileName := Copy(InputFile,1,Pos('.',InputFile) - 1);
  208.       FileType := Copy(InputFile,Pos('.',InputFile) + 1, 3);
  209.      end
  210.     else
  211.      begin
  212.       FileName := InputFile;
  213.       FileType := '';                     {no file type in this case}
  214.     end; {if}
  215.     if Pos(':', FileName) = 2 then        {check for drive spec}
  216.      begin
  217.       DriveLetter := Copy(FileName,1,1);  {The ":" must be at position #2, and drive spec directly before it.}
  218.       if not (DriveLetter in ['A'..'P']) then DriveLetter := Chr(Bdos(GET_CURRENT_DEFAULT_DISK) + $41);
  219.       Delete(FileName,1,2);               {Delete the Drive spec and the ":"}
  220.      end
  221.     else
  222.      DriveLetter := Chr(Bdos(GET_CURRENT_DEFAULT_DISK) + $41);   {fill in the drive-letter of the current disk}
  223.     {end if}
  224.     if FileName = '' then
  225.      begin
  226.       FileName := '????????';             {must be 8 "?" or := '*'}
  227.       FileType := '???';                  {must be 3 "?" or := '*'}
  228.     end; {if}
  229.     while (Pos('*',FileName) <> 0) do          {find any '*' wildcards}
  230.      begin
  231.       Insert_Position := Pos('*', FileName);   {find the spot}
  232.       Delete(FileName,Insert_Position,1);      {get rid of the "*"}
  233.       while(Length(FileName) < 8) do Insert('?',FileName,Insert_Position);
  234.     end; {while}                               {insert ?'s until filename is filled. Note that the first '*'}
  235.                                                {will fill the string, so any other *'s in the name will be  }
  236.                                                {deleted and replaced with a single '?'.  '*k*' will be      }
  237.                                                {converted to '??????k?'                                     }
  238.     while Pos('*',filetype) <> 0 do             {do the same for the filetype}
  239.       begin
  240.         Insert_Position := Pos('*',FileType);
  241.         Delete(FileType,Insert_Position,1);
  242.         while(Length(FileType) < 3) do Insert('?',FileType,Insert_Position);
  243.     end; {while}
  244.     while Length(FileName) < 8 do              {fill out the filename with spaces}
  245.       FileName := FileName + ' ';
  246.     while Length(FileType) < 3 do              {do the same for the filetype}
  247.       FileType := FileType + ' ';
  248.   end;  {Procedure Parse_FileName}
  249.  
  250.  
  251.   begin  {Procedure Init_MyFcb}
  252.     Parse_FileName(InputDriveAndFile,DriveLetter,FileName,FileType);  {put filespec in proper form}
  253.     FcbToInit[0] := Ord(DriveLetter) - $40;                           {store the drive spec}
  254.     for Count := 1 to 8 do                        {put in the filename. Array operation, not string}
  255.       FcbToInit[Count] := Ord(FileName[Count]);
  256.     for Count := 1 to 3 do                        {same for filetype. Must be integers here}
  257.       FcbToInit[8+Count] := Ord(FileType[Count]);
  258.     FcbToInit[12] := Ord('?');                    {must match ALL physical extents(directory entries)}
  259.     for Count := 13 to 35 do
  260.       FcbToInit[Count] := 0;                      {rest of the FCB must be set to 0's}
  261.   end; {Procedure Init_MyFcb}
  262.  
  263.  
  264.  
  265. Procedure Get_BlockSize(    DriveLetter : Char;
  266.                         var BlockSize   : Byte);
  267.  
  268.     {Block size = "BlockSizeInKb" so that the file sizes }
  269.     {may be calculated in later procedures.  It will also}
  270.     {reset any drive determined to be a removable floppy }
  271.     {for proper directory operation.                     }
  272.  
  273.  
  274.   Const
  275.     GET_DISK_PARAMETER_BLOCK_ADDRESS  = 31;
  276.     GET_CURRENT_DEFAULT_DISK          = 25;
  277.     SELECT_LOGICAL_DISK               = 14;
  278.     RESET_LOGICAL_DISK_DRIVE          = 37;   {This BDOS call is said "not" to}
  279.                                               {work for CP/M, but n/STAR does.}
  280.   Type
  281.     DskParmBlockRecord  =
  282.     record
  283.       SectorsPerTrack              : Integer;    { Sectors per Track }
  284.       BlockShiftFactor             : Byte;       { Data Allocation block shift factor }
  285.       BlockMask                    : Byte;       { Block Mask, used here to calculate the allocation block size }
  286.       ExtentMask                   : Byte;       { Extent Mask, not used by this procedure }
  287.       MaxAllocBlockLessOne         : Integer;    { Maximum Allocation blocks for this drive }
  288.       NumDirEntriesLessOne         : Integer;    { Number of Directory Entries less one }
  289.       DirAllocByte0                : Byte;       { Left Byte of Directory Allocation Blocks }
  290.       DirAllocByte1                : Byte;       { Right Byte of Directory Allocation Blocks }
  291.       NumBytesInDirCheckBuffer     : Integer;    { Check buffer for Floppys only }
  292.       ReservedTracks               : Integer     { Reserved System Tracks for OS, usually floppy }
  293.     end;  {DskParmBlockRecord}
  294.  
  295.   Var
  296.     DskParmBlock_Ptr  : ^DskParmBlockRecord;   {Pointer to DPB}
  297.     DriveNumber       : Byte;                  {CP/M Select disk #, 00 = A:, 01=B:, etc}
  298.     CurrentDisk       : Byte;                  {Remember your roots, from whence you came...}
  299.     DriveBitNumber    : Integer;               {16 drive bit-map}
  300.  
  301.  
  302. begin  {Procedure Get_BlockSize}
  303.  DriveLetter := UpCase(DriveLetter);
  304.  DriveNumber := Ord(DriveLetter) - $41;            {CP/M disk #, 00 = A:, etc}
  305.  CurrentDisk := Bdos(GET_CURRENT_DEFAULT_DISK);    {get the present disk #}
  306.  if DriveLoggedIn(DriveLetter) then
  307.   begin
  308.    Bdos(SELECT_LOGICAL_DISK,DriveNumber);          {select the new disk}
  309.    DskParmBlock_Ptr := Ptr(BdosHL(GET_DISK_PARAMETER_BLOCK_ADDRESS));
  310.    with DskParmBlock_Ptr^ do
  311.     begin
  312.      BlockSize := Succ(BlockMask) shr 3;
  313.      if NumBytesInDirCheckBuffer <> 0 then    {...it's a floppy drive}
  314.       begin
  315.        DriveBitNumber := 1 shl DriveNumber;
  316.        Bdos(RESET_LOGICAL_DISK_DRIVE,DriveBitNumber);  {Bdos call #37 works for n/STAR, maybe not for CP/M???}
  317.      end; {if}
  318.    end; {with}
  319.    Bdos(SELECT_LOGICAL_DISK,CurrentDisk);          {"clicking heels three times..." Select the Old disk before exiting}
  320.  end; {if}
  321. end;   {Procedure Get_BlockSize}
  322.  
  323.  
  324.  
  325. Procedure WriteFileNames (    AnyFileName    : Str12;
  326.                               KiloBytes      : Integer;
  327.                               CurrentDrive   : Char;
  328.                           var DisplayCounter : Integer);
  329.  
  330.     {   Output of directory file information in 4 columns,   }
  331.     {         Sorted Vertically for ease of Reading.         }
  332.     {    This output algorithm deduced by Stephen C. Hill    }
  333.  
  334. Const
  335.   NUMBER_OF_ROWS            = 13;    {Number of Rows of filenames displayed}
  336.   NUMBER_OF_COLUMNS         =  4;    {Number of Columns of filenames displayed}
  337.   START_OF_DISPLAY_ROW      =  9;    {Cannot be less than 3!}
  338.   CHARS_PER_DISPLAYED_FILE  = 20;    {Limits displayed file sizes to 999 Kb,}
  339.                                      { if Number of Columns displayed is 4, }
  340.                                      { but, file sizes of up to 32,768 Kb   }
  341.                                      { can be calculated and displayed with }
  342.                                      { the appropriate number of display    }
  343.                                      { columns.                             }
  344.  
  345. begin  {Procedure WriteFileNames}
  346.  if DisplayCounter = 0 then                        {DisplayCounter is a screen display variable}
  347.   begin
  348.    GotoXY(1,(START_OF_DISPLAY_ROW - 2));
  349.    ClrEos;
  350.    GotoXY(1,Pred(START_OF_DISPLAY_ROW));
  351.    HighVideo;
  352.    write('Directory of drive ',CurrentDrive,':');  {Display the directory drive letter}
  353.    LowVideo;
  354.  end; {if}
  355.  GotoXY(Succ((CHARS_PER_DISPLAYED_FILE * ((DisplayCounter div NUMBER_OF_ROWS) mod NUMBER_OF_COLUMNS))),
  356.    (START_OF_DISPLAY_ROW + (DisplayCounter mod NUMBER_OF_ROWS)));
  357.  Write('| ',AnyFileName,' ',KiloBytes:3,'k ');     {This line is where the CHARS_PER_DISPLAYED_FILE  = 20 comes from!}
  358.  DisplayCounter := Succ(DisplayCounter);           {Increment the File counter, as new Unique FCB discovered}
  359.  if (DisplayCounter mod (NUMBER_OF_COLUMNS * NUMBER_OF_ROWS)) = 0 then
  360.   begin
  361.    GotoXY(1,CMD_LINE);
  362.    write('Hit <Return> for more files...');
  363.    BufLen := 0;
  364.    Readln;                                        {The pause that refreshes...}
  365.    GotoXY(1,(START_OF_DISPLAY_ROW - 2));
  366.    ClrEos;
  367.    GotoXY(1,Pred(START_OF_DISPLAY_ROW));
  368.    HighVideo;
  369.    write('Directory of drive ',CurrentDrive,':');
  370.    LowVideo;
  371.  end; {if}
  372. end; {Procedure WriteFileNames}
  373.  
  374.  
  375.  
  376. {$A-}   {**** recursive reference needed around this procedure ****}
  377. Procedure BuildTree (var RootTree_ptr  : DirEntry_Ptr;
  378.                      var EntryTree_ptr : DirEntry_Ptr);
  379.  
  380. { Builds an ordered tree of directory entries.  Note that the replace   }
  381. { function in code takes care of duplicate entries in dictionary due to }
  382. { large files present in >1 "PHYSICAL" extent. (i.e. - Directory entry) }
  383.  
  384.  
  385. begin {Procedure BuildTree}
  386.   if RootTree_ptr = Nil then                                     {end of limb, place current entry}
  387.     RootTree_ptr := EntryTree_ptr
  388.   else
  389.     if RootTree_ptr^.FileName = EntryTree_ptr^.FileName then     {replace entry?, same filename, then skip duplicate}
  390.      begin
  391.       if EntryTree_ptr^.FileSize > RootTree_ptr^.FileSize then   {if the new directory entry file size is bigger, store it}
  392.         RootTree_ptr^.FileSize := EntryTree_ptr^.FileSize;
  393.       Dispose(EntryTree_ptr)
  394.      end {if}
  395.     else
  396.      begin
  397.       if RootTree_ptr^.FileName > EntryTree_ptr^.FileName then   {left for small}
  398.         BuildTree(RootTree_ptr^.Left_Ptr, EntryTree_ptr)
  399.       else
  400.         BuildTree(RootTree_ptr^.Right_Ptr, EntryTree_ptr)        {right for large}
  401.       {end if}
  402.     end {if}
  403.   {end the "top" if}
  404. end;  {Procedure BuildTree}
  405. {$A+}
  406.  
  407.  
  408. {$A-}   {**** recursive reference needed around this procedure ****}
  409. Procedure WriteTree (var RootTree_ptr   : DirEntry_Ptr;
  410.                      var DirDriveLetter : Char;
  411.                      var DisplayFileNum : Integer);
  412.  
  413.   {Recursively writes the directory in order, (alphabetically) from the top.}
  414.  
  415. begin {WriteTree}
  416.  if RootTree_ptr <> Nil then
  417.   begin
  418.    WriteTree(RootTree_ptr^.Left_Ptr,DirDriveLetter,DisplayFileNum);
  419.    WriteFileNames(RootTree_ptr^.FileName,RootTree_ptr^.FileSize,DirDriveLetter,DisplayFileNum);
  420.    WriteTree(RootTree_ptr^.Right_Ptr,DirDriveLetter,DisplayFileNum);
  421.  end; {if}
  422. end; {WriteTree}
  423. {$A+}
  424.  
  425.  
  426. {$A-}   {**** recursive reference needed around this procedure ****}
  427. Procedure DisposeTree (Var RootTree_ptr : DirEntry_Ptr);
  428.  
  429. { Disposes of the storage devoted to the directory tree Post-order. }
  430. { Required for repetitive execution of the program within a larger  }
  431. { program, even though the directory tree is fairly small.          }
  432.  
  433.  
  434. begin  {Procedure DisposeTree}
  435.  if RootTree_ptr <> Nil then
  436.   begin
  437.    DisposeTree(RootTree_ptr^.Left_Ptr);
  438.    DisposeTree(RootTree_ptr^.Right_Ptr);
  439.    Dispose(RootTree_ptr);
  440.  end; {if}
  441. end;  {Procedure DisposeTree}
  442. {$A+}
  443.  
  444.  
  445. Procedure GetEntry(    BdosFuncCode    : Byte;
  446.                        KbPerBlock      : Byte;
  447.                        ShowSystemFiles : Boolean;
  448.                    var MaskingFcb      : AnyFcb;
  449.                    var MyDma           : AnyDma;
  450.                    var DirectoryCode   : Byte;
  451.                    var NumDirEntries   : Integer;
  452.                    var RootTree_ptr    : DirEntry_Ptr;
  453.                    var EntryTree_ptr   : DirEntry_Ptr);
  454.  
  455.   { Finds and writes a single directory entry from the disk directory    }
  456.   { to the directory tree; calculates the proper file size; makes a tree }
  457.   { entry via the BuildTree procedure.                                   }
  458.  
  459.  
  460. Var
  461.    FreeMemory            : Integer;  {The positive amount of free memory in the heap}
  462.    SysAttributeSet       : Boolean;  {Flag if System attribute set on directory entry}
  463.    Ndex                  : Byte;     {Just an index counter byte}
  464.    FirstByteOfDirEntry   : Byte;     {Byte location in the MyDma of the first byte of the directory entry in question}
  465.    TempNumOfBlocks       : Real;     {Temporary holder of first-cut number of blocks}
  466.    NumberOfSectorsInFile : Real;     {Total number of 128 byte CP/M sectors in a file;}
  467.                                      { note the algorithm used to calulate!}
  468.  
  469. begin  {Procedure GetEntry}
  470.   DirectoryCode := Bdos(BdosFuncCode,Addr(MaskingFcb)); {get directory in MyDma}
  471.   if (DirectoryCode <> NO_MORE_FILES) then
  472.    begin                                                {the entry exists, the Bdos does NOT get deleted ($E5) dir entries!}
  473.     FirstByteOfDirEntry := DirectoryCode shl 5;         {Just a * 32}
  474.     if ShowSystemFiles then {skip-null}
  475.     else
  476.      begin
  477.       SysAttributeSet := (((MyDma[(FirstByteOfDirEntry + 10)]) and $80) = $80);
  478.       if SysAttributeSet then  Exit;  {...Skip this directory entry}
  479.     end; {if}
  480.     FreeMemory := Abs(MemAvail);
  481.     if FreeMemory <= 1000 then      {Leave ENOUGH bytes of Heap free...  Guess for now}
  482.      begin
  483.       GotoXY(1,MSG_LINE); ClrEol;
  484.       write('Not enough memory to sort and display all files...');
  485.       Exit;
  486.     end; {if}
  487.     New(EntryTree_ptr);                               {place for new entry}
  488.     with EntryTree_ptr^ do
  489.      begin
  490.       FileName[0] := Chr(12);                         {Set FileName Length to 12, as CP/M}
  491.                                                       {pads all filenames to full length.}
  492.       for Ndex := 1 to 8 do
  493.         FileName[Ndex] := Chr(MyDma[(FirstByteOfDirEntry + Ndex)]);        {get file name}
  494.       FileName[9] := '.';
  495.       for Ndex := 9 to 11 do
  496.         FileName[Succ(Ndex)] := Chr(MyDma[(FirstByteOfDirEntry) + Ndex]);  {get file extension}
  497.  
  498.       NumberOfSectorsInFile := (MyDma[(FirstByteOfDirEntry) + 14] * 32 * 128) +
  499.                                (MyDma[(FirstByteOfDirEntry) + 12] * 128) +
  500.                                (MyDma[(FirstByteOfDirEntry) + 15]);   {total n/STAR (CP/M,MP/M, TurboDos)}
  501.                                                                       {file-size in 128-byte CP/M sectors}
  502.       TempNumOfBlocks := NumberOfSectorsInFile/(8 * KbPerBlock);
  503.       if Frac(TempNumOfBlocks) <> 0 then
  504.         FileSize := Trunc((Int(TempNumOfBlocks) + 1) * KbPerBlock)
  505.       else
  506.         FileSize := Trunc(Int(TempNumOfBlocks) * KbPerBlock);
  507.       {end if}   {The above if statement: Recalculates file sizes to make}
  508.                  {them end on allocation block borders, as they must.    }
  509.       Left_Ptr := Nil;
  510.       Right_Ptr := Nil;
  511.      end;  {with EntryTree_ptr^}
  512.     NumDirEntries := Succ(NumDirEntries);
  513.     BuildTree(RootTree_ptr,EntryTree_ptr)                  {put the entry in the tree}
  514.   end; {if}
  515. end;  {Procedure GetEntry}
  516.  
  517.  
  518.  
  519. begin  {Procedure SortedDirectory}
  520.   Entry_Ptr := Nil;      {Initialize directory tree pointers}
  521.   Root_Ptr := Nil;       {Initialize directory tree pointers}
  522.   SysFiles := FALSE;     {Initialize the System Attribute Flag}
  523.   NumOfDirEntries := 0;  {Initialize the Number of disk directory entries counter}
  524.   NumOfFiles := 0;       {Initialize the Number of files counter; the output print control counter}
  525.  
  526.   Bdos(SET_DMA_ADDRESS,Addr(MyDma));                 {Define MyDma to allow directory entry buffering}
  527.   Get_DriveAndFileName_SysFlag(TargetDriveAndFile,SysFiles);
  528.   Init_MyFcb(TargetDriveAndFile,TargetDrive,MyFcb);
  529.   if DriveLoggedIn(TargetDrive) then
  530.    begin
  531.     Get_BlockSize(TargetDrive,BlockSizeInKb);        {BlockSizeInKb now passed.}
  532.     BdosFuncNum := SEARCH_FOR_FIRST;                 {BDOS Search for First file}
  533.     Repeat                                           {Get'em and tree'em}
  534.       GetEntry(BdosFuncNum,BlockSizeInKb,SysFiles,MyFcb,MyDma,
  535.                DirPageNdex,NumOfDirEntries,Root_Ptr,Entry_Ptr);
  536.       BdosFuncNum := SEARCH_FOR_NEXT;             {Switch to BDOS Search for Next after first file}
  537.     Until DirPageNdex = NO_MORE_FILES;            {No more directory entries left to search for}
  538.     WriteTree(Root_Ptr,TargetDrive,NumOfFiles);   {Sorted directory OUT to the screen}
  539.     GotoXY(1,CMD_LINE);                           {Wait for release}
  540.     DisposeTree(Root_Ptr);                        {Release dynamic storage}
  541.     writeln('Number of files: ',NumOfFiles);
  542.     write('Number of directory entries: ',NumOfDirEntries);
  543.    end
  544.   else
  545.    begin
  546.     GotoXY(1,MSG_LINE); ClrEol;            {The DisplayMsg procedure will not work here}
  547.     GotoXY(6,MSG_LINE);
  548.     write(^G'There is no ');
  549.     HighVideo;
  550.     write(TargetDrive,':');
  551.     LowVideo;
  552.     write(' logged drive.');
  553.     Delay(1599);                           {Let'em read the message}
  554.  end; {if}
  555.  NormVideo;
  556. end;  {Procedure SortedDirectory}
  557.  
  558. begin {Program TestSortedDirectory}
  559.  SortedDirectory;
  560. End. {Program TestSortedDirectory}
  561.