home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_dxrf / sti_dxrf.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-12-03  |  7.8 KB  |  197 lines
  1. program STI_DXRF;                           { utility to print the tree     }
  2.                                             { of the disk                   }
  3. uses
  4.   STI_ERR,
  5.   Dos;                                      { standard dos unit             }
  6.  
  7. type
  8.   BuffPtr = ^Buffer;                        { pointer to a buffer           }
  9.   Buffer  = record                          { the actual record             }
  10.           Name  : string[13];
  11.               Attr  : byte;
  12.               Left  : BuffPtr;
  13.               Right : BuffPtr;
  14.         end;
  15.  
  16. var
  17.   Head        : BuffPtr;                    { head of the tree              }
  18.   Drive       : string[3];                  { current drive                 }
  19.   Path        : string;                     { current path                  }
  20.   FindRec     : SearchRec;                  { record for searching          }
  21.   PrintString : String;                     { output string                 }
  22.   Done        : boolean;                    { end flag                      }
  23.  
  24.   NoDirs      : word;                       { number of directories         }
  25.   NoFiles     : word;                       { number of files               }
  26.   FreeSpace   : longint;                    { how much free disk space      }
  27.   Size        : longint;                    { size of the disk              }
  28.  
  29. {---------------------------------------------------------------------------}
  30.  
  31. procedure GetFiles(Var List : Buffer);      { read file list                }
  32.  
  33. Var
  34.   OldPath     : string;                     { old path                      }
  35.   OldRec      : SearchRec;                  { old search record             }
  36.  
  37. begin
  38.   While(DosError = 0) do                    { loop until no files           }
  39.     begin
  40.       List.Name   :=  FindRec.Name;         { assign name to the buffer     }
  41.       List.Attr   :=  FindRec.Attr;         { assign attribute to the buffer}
  42.       if (FindRec.Attr = 16) then           { is it a directory             }
  43.         begin
  44.           Inc(NoDirs);                      { yes, inc the counter          }
  45.           if (FindRec.Name <> '.') and (FindRec.Name <> '..') then
  46.             begin                           { it is a child                 }
  47.               List.Name   := List.Name+'\'; { so we want to start a new     }
  48.               OldPath     := Path;          { branch on the tree            }
  49.               Path        := Path + List.Name;
  50.               List.Left   := NIL;
  51.               New(List.Right);              { directories branch to the     }
  52.               List.Right^.Name  := '';      { right. then we set up a new   }
  53.               List.Right^.Attr  := 0;       { record for findfirst          }
  54.               List.Right^.Left  := NIL;
  55.               List.Right^.Right := NIL;
  56.               OldRec := FindRec;
  57.               FindFirst(Drive+Path+'*.*',AnyFile,FindRec); { check for files}
  58.               GetFiles(List.Right^);        { note the recursion here       }
  59.               New(List.Left);               { we first traverse the files in}
  60.               List.Left^.Name  := '';       { the directory so we go right  }
  61.               List.Left^.Attr  := 0;        { note that this is the NEW     }
  62.               List.Left^.Left  := NIL;      { directory list                }
  63.               List.Left^.Right := NIL;
  64.               Path := OldPath;
  65.               FindRec := OldRec;
  66.               FindNext(FindRec);
  67.               GetFiles(List.Left^);         { continue in the directory     }
  68.             end;
  69.           FindNext(FindRec);                { get the next one              }
  70.         end
  71.       else
  72.         begin
  73.           Inc(NoFiles);                     { this is not a directory so    }
  74.           New(List.Left);                   { we boogy of on the left node  }
  75.           List.Left^.Name  := '';
  76.           List.Left^.Attr  := 0;
  77.           List.Left^.Left  := NIL;
  78.           List.Left^.Right := NIL;
  79.           FindNext(FindRec);                { and we get the next file      }
  80.           GetFiles(List.Left^);             { then do a recursive call      }
  81.         end;
  82.     end;
  83. end;
  84.  
  85. {---------------------------------------------------------------------------}
  86.  
  87. procedure TraversePrint(List : Buffer);     { print the tree                }
  88.  
  89. begin
  90.   while ((List.Left <> NIL) or (List.Right <> NIL)) and not(Done) do
  91.     begin
  92.       if List.Attr = 16 then
  93.         begin
  94.           writeln(PrintString,copy('--------------',1,13-length(List.Name)),
  95.                   List.Name,'<sub directory>');
  96.           PrintString := PrintString + '      |';
  97.           TraversePrint(List.Right^);
  98.           WriteLn(PrintString);
  99.           PrintString := copy(PrintString,1,length(PrintString)-7);
  100.           WriteLn(PrintString);
  101.           if List.Left <> NIl then
  102.             begin
  103.               Done := FALSE;
  104.               TraversePrint(List.Left^);
  105.             end;
  106.         end
  107.       else
  108.         if (List.Left <> NIL) and not(Done) then
  109.           begin
  110.             writeln(PrintString,copy('--------------',1,13-length(List.Name)),List.Name);
  111.             TraversePrint(List.Left^);
  112.           end;
  113.     end;
  114.   Done := TRUE;
  115. end;
  116.  
  117. {---------------------------------------------------------------------------}
  118.  
  119. procedure Do_Index;                         { this is where we start        }
  120.  
  121. begin
  122.   FindFirst(Drive+Path+'*.*',AnyFile,FindRec); { get the first file         }
  123.   New(Head);                                   { allocate and initialise    }
  124.   Head^.Name  := '';                           { the tree root              }
  125.   Head^.Attr  := 0;
  126.   Head^.Left  := NIL;
  127.   Head^.Right := NIL;
  128.   GetFiles(Head^);                             { then we get all the files  }
  129.   WriteLn;
  130.   WriteLn('                         DISKXREF Version 1.0');
  131.   WriteLn('         Copyright (C) 1990,1991 by Software Technology International');
  132.   WriteLn('                          All Rights Reserved');
  133.   WriteLn;
  134.   WriteLn;
  135.   WriteLn;
  136.   WriteLn('Structure of Drive : ',Drive);
  137.   WriteLn;
  138.   Write('Number of Directories : ',NoDirs:7,'         ');
  139.   WriteLn('Number of Files    : ',NoFiles);
  140.   Write('Disk Size             : ',Size:7,  ' bytes   ');
  141.   WriteLn('Free Space On Disk : ',FreeSpace,' bytes');
  142.   WriteLn;
  143.   WriteLn('\ <root directory>');
  144.   Done := FALSE;
  145.   TraversePrint(Head^);                     { and print the tree            }
  146. end;
  147.  
  148. {---------------------------------------------------------------------------}
  149.  
  150. procedure Usage;                            { messages for those out of the }
  151.                                             { know                          }
  152. begin
  153.   WriteLn;
  154.   WriteLn('Usage : DISKXREF <drive>');
  155.   WriteLn;
  156.   Halt;
  157. end;
  158.  
  159. {---------------------------------------------------------------------------}
  160.  
  161. function ValidateDrive(DriveString : string) : string; { check drive string }
  162.  
  163. begin
  164.   DriveString[1] := UpCase(DriveString[1]);
  165.   if DriveString[1] in ['A'..'Z'] then
  166.     begin
  167.       FreeSpace := DiskFree(ord(DriveString[1])-64);
  168.       Size      := DiskSize(ord(DriveString[1])-64);
  169.       if (FreeSpace < 0) or (Size < 0) then
  170.         begin
  171.           WriteLn('Illegal Drive : ',DriveString[1],':');
  172.           Halt;
  173.         end;
  174.       ValidateDrive := DriveString[1]+':'
  175.     end
  176.   else
  177.     begin
  178.       Writeln('Invalid Drive : Must be A to Z');
  179.       Halt;
  180.     end;
  181. end;
  182.  
  183. {---------------------------------------------------------------------------}
  184.  
  185. begin                                       { program body                  }
  186.   NoDirs       := 0;
  187.   NoFiles      := 0;
  188.   Drive        := '';
  189.   Path         := '\';
  190.   PrintString  := '|';
  191.   if ParamCount < 1 then                   { check the # of params          }
  192.     Usage;
  193.   Drive := ValidateDrive(ParamStr(1));     { chec for a legal drive         }
  194.   Do_Index;                                { boogy !!                       }
  195. end.
  196.  
  197.