home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 2 BBS / 02-BBS.zip / foss10.zip / DEVELOP / UTILCOLL / DIRDUMP.PAS next >
Pascal/Delphi Source File  |  1995-10-20  |  6KB  |  223 lines
  1. program DirDump;
  2. uses
  3.   Types,
  4.   ApiInt,
  5.   TParam,
  6.   TFileIO,
  7.   TOSInt,
  8.   Bits;
  9.  
  10. type
  11.   PDirListing      = ^TDirListing;
  12.   TDirListing      = object
  13.     Language       : Char;
  14.     AreaCode       : string;
  15.     ListPath       : string;
  16.  
  17.     constructor Init;
  18.     destructor Done;
  19.  
  20.     procedure ReadParams;
  21.     procedure CreateList;
  22.   end;
  23.  
  24. var
  25.   DirListing       : PDirListing;
  26.  
  27. constructor TDirListing.Init;
  28. begin
  29.   dllInit( '', 0 );
  30. end; { contructor Init }
  31.  
  32. destructor TDirListing.Done;
  33. begin
  34. end; { destructor Done }
  35.  
  36. procedure TDirListing.ReadParams;
  37. begin
  38.   if Par^.SwAct['L'] then
  39.     case UpCh( Par^.SwStr['L', 1] ) of
  40.       'A': Language := 'A';
  41.       'E': Language := 'E';
  42.     else
  43.       Language := 'E';
  44.     end
  45.   else Language := 'E';
  46.  
  47.   if Par^.SwAct['A'] then AreaCode := Par^.SwStr['A']
  48.   else AreaCode := 'MAIN';
  49.  
  50.   ListPath := Par^.Str[1];
  51. end; { procedure ReadParams }
  52.  
  53. procedure TDirListing.CreateList;
  54. var
  55.   AreaRec          : Area_Config_Record;
  56.   DirRec           : Area_Directory_Record;
  57.   FileRec          : TFileRec;
  58.   DPos             : LongInt;
  59.   FPos             : LongInt;
  60.   ListF            : TFile;
  61.   fDate            : string[6];
  62.   fSize            : string[4];
  63.   dCount           : string[3];
  64.   TInt             : LongInt;
  65.   CurLine          : string;
  66.   FirstLine        : Boolean;
  67.   WL               : Byte;
  68.   TotalFiles       : LongInt;
  69.   TotalSize        : LongInt;
  70.   DirFiles         : LongInt;
  71.   DirSize          : LongInt;
  72.  
  73. begin
  74.   fioFindAreaCode( AreaRec, AreaCode, 0 );
  75.  
  76.   with ListF do
  77.   begin
  78.     Assign( ListPath,
  79.             fmWriteOnly or fmExclusive,
  80.             1,
  81.             faNormalAccess,
  82.             ftMaxTimeout );
  83.     ReWrite;
  84.  
  85.     TotalFiles := 0;
  86.     TotalSize := 0;
  87.     DPos := 0;
  88.     while fioReadDirCfg( DirRec, AreaRec, DPos ) do
  89.     begin
  90.       Inc( DPos );
  91.  
  92.       Writeln( DirRec.DirName );
  93.       WriteTextln( 'Directory of ' + DirRec.DirName + ' in ' + AreaRec.AreaName + ' ...' );
  94.       WriteTextln( '' );
  95.       WriteTextln( '    File name     Size  Date  Dls Min               Description' );
  96.       WriteTextln( ' ──────────────── ──── ────── ─── ─── ────────────────────────────────────────' );
  97.  
  98.       DirFiles := 0;
  99.       DirSize := 0;
  100.       FPos := DirRec.FirstRec;
  101.       while fioReadFileRec( FileRec, AreaRec, FPos ) do
  102.       begin
  103.         OS^.Sleep( 2 );
  104.         Inc( FPos );
  105.         if ( KilledFile in FileRec.FileFlags ) then Continue;
  106.         if not ( FileRec.DirNo = DirRec.DirNo ) then
  107.         begin
  108.           if ( FPos < DirRec.NextRec ) then FPos := DirRec.NextRec;
  109.           Continue;
  110.         end;
  111.  
  112.         FirstLine := TRUE;
  113.         with FileRec do
  114.         begin
  115.           repeat
  116.             if ( Length( Description ) > 40 ) then
  117.             begin
  118.               CurLine := Copy( Description, 1, 41 );
  119.               for WL := 41 downto 1 do
  120.                 if ( CurLine[WL] in [' ', '-'] ) then
  121.                 begin
  122.                   if ( WL  = 41 ) then
  123.                   begin
  124.                     Delete( CurLine, 41, 1 );
  125.                     Delete( Description, 1, 41 );
  126.                   end
  127.                   else
  128.                   begin
  129.                     Delete( CurLine, WL, 42 - WL );
  130.                     Delete( Description, 1, WL );
  131.                   end;
  132.                   Break;
  133.                 end;
  134.  
  135.               if ( WL = 1 ) then
  136.               begin
  137.                 Delete( CurLine, 41, 1 );
  138.                 Delete( Description, 1, 40 );
  139.               end;
  140.             end
  141.             else
  142.             begin
  143.               CurLine := Description;
  144.               Description := '';
  145.             end;
  146.  
  147.             if FirstLine then
  148.             begin
  149.               with FileRec.Date.Date do
  150.                 fDate := I2S( Day, 2 ) +
  151.                          I2S( Month, 2 ) +
  152.                          I2S( Year - 1900, 2 );
  153.  
  154.               if ( FileRec.Size < 1000 ) then fSize := I2S( FileRec.Size, 0 ) + 'B'
  155.               else
  156.               begin
  157.                 TInt := FileRec.Size div 1024;
  158.                 if TInt < 10000 then fSize := I2S( TInt, 0 )
  159.                 else fSize := I2S( TInt Div 1024, 0 ) + 'M';
  160.               end;
  161.               fSize := PreFill( fSize, 4, ' ' );
  162.  
  163.               if ( FileRec.Downloads < 1000 ) then dCount := I2S( FileRec.Downloads, 0 )
  164.               else dCount := '999';
  165.               dCount := PreFill( dCount, 3, ' ' );
  166.  
  167.               CurLine := ' ' + Fill( FileRec.FileName, 16, ' ' ) +
  168.                          ' ' + fSize +
  169.                          ' ' + fDate +
  170.                          ' ' + dCount +
  171.                          ' n/a ' + CurLine;
  172.               FirstLine := FALSE;
  173.             end
  174.             else CurLine := Fill( '', 38, ' ' ) + CurLine;
  175.  
  176.             WriteTextln( CurLine );
  177.           until ( Description = '' );
  178.  
  179.           Inc( TotalFiles );
  180.           Inc( DirFiles );
  181.           Inc( TotalSize, Size div 1024 );
  182.           Inc( DirSize, Size div 1024 );
  183.         end;
  184.       end;
  185.  
  186.       WriteTextln ( Fill( '', 32, ' ' ) +
  187.                     PreFill( I2S( DirFiles, 254 ), 13, ' ' ) + ' file(s)  ' +
  188.                     PreFill( I2S( DirSize, 254 ), 13, ' ' ) + ' KByte(s)' );
  189.       WriteTextln ( '' );
  190.     end;
  191.  
  192.     WriteTextln ( Fill( '', 32, ' ' ) +
  193.                   PreFill( I2S( TotalFiles, 254 ), 13, ' ' ) + ' file(s)  ' +
  194.                   PreFill( I2S( TotalSize, 254 ), 13, ' ' ) + ' KByte(s)' );
  195.  
  196.     Close;
  197.   end;
  198. end; { procedure CreateList }
  199.  
  200. begin
  201.   Writeln;
  202.   Writeln( 'DirDump v1.01 - Generate AscII file listing from FOSS system files' );
  203.   Writeln;
  204.  
  205.   if not ( Par^.Count = 1 ) then
  206.   begin
  207.     Writeln( 'Usage:' );
  208.     Writeln( '   DIRDUMP {-L[E|N] {-A[area]} [listpath]' );
  209.     Writeln;
  210.     Writeln( '   -L           Requested file list language (English or Norwegian)' );
  211.     Writeln( '                (Default: English)' );
  212.     Writeln( '   -A           Area code of area to collect info from' );
  213.     Writeln( '                (Default: MAIN)' );
  214.     Writeln( '   listpath     Path of file to write file list into' );
  215.     Exit;
  216.   end;
  217.  
  218.   New( DirListing, Init );
  219.   DirListing^.ReadParams;
  220.   DirListing^.CreateList;
  221.   Dispose( DirListing, Done );
  222. end.
  223.