home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / INCRBACK.ZIP / LARC.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1986-12-21  |  7.8 KB  |  303 lines
  1. {$P1024}
  2. Program List_ARChives;
  3. {
  4.   The basis for this program and the 'GetList' procedure
  5.   was an outgrowth of the DIRECTRY.PAS from Turbo Tutor by Borland
  6.   and List_Files_for_Archive by Joseph W. Kalinski Ver 1.1 7/12/86
  7.  
  8.   Parameters are: LARC [d:] [/p]
  9.  
  10.     [d:] =   drive to search
  11.     [/p] =   pause list every 23 lines
  12. }
  13. Type
  14.  
  15.   Char12arr   = array [ 1..12 ] of Char;
  16.   String13    = string[ 13 ];
  17.   String05    = String[ 05 ];
  18.   String08    = String[ 08 ];
  19.  
  20.   RegisterSet = Record Case Integer Of
  21.                   1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  22.                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  23.                 End;
  24.  
  25.   DTA_Record  = Record Case Integer of
  26.                   1: (DTA_Buffer     : Array [ 1..43 ] of Byte);
  27.                   2: (DOS_Area       : Array [ 0..20 ] of Byte;
  28.                       Attr           : Byte;
  29.                       Time           : Integer;
  30.                       Date           : Integer;
  31.                       Size           : Array [ 1..4 ] of Byte;
  32.                       Name           : Array [ 1..13 ] of Char);
  33.                 End;
  34.  
  35.   ARC_Record  = Record
  36.                   FileName           : String[13];
  37.                   FileDate           : String[08];
  38.                   FileTime           : String[05];
  39.                   FileSize           : Real;
  40.                 End;
  41.  
  42. Var
  43.  
  44.   Regs        : RegisterSet;
  45.   DTA         : DTA_Record;
  46.   Mask        : Char12arr;
  47.   NamR        : String13;
  48.   I           : Integer;
  49.  
  50.   SubList     : Array[1..250] of String[63];
  51.   ArcList     : Array[1..250] of Arc_Record;
  52.  
  53.   SaveDir     : String[63];
  54.  
  55.   Files,
  56.   k,o,p       : Integer;
  57.   Pause       : Boolean;
  58.   Ans         : Char;
  59.   Tot_Files   : Integer;
  60.   Tot_Bytes   : Real;
  61.   Tot_Floppies: Real;
  62.  
  63. Const
  64.  
  65.   lim         = 23;          {number of lines before pause}
  66.  
  67. Procedure Parse_Parm;
  68.  
  69.   Begin
  70.     for i := 1 to paramcount do
  71.         begin
  72.           if (paramstr(i)='/p') or (paramstr(i)='/P') then pause:=true;
  73.           if (pos(':',paramstr(i)) <> 0) and
  74.              (pos('\',paramstr(i)) =  0)
  75.               then sublist[1]:= paramstr(i)+'\';
  76.         end;
  77.   end;
  78.  
  79. Procedure WaitKey;
  80.  
  81.   Begin
  82.     p := 1;
  83.     writeln;
  84.     writeln ('Press any key to continue...');
  85.     Read(Kbd,ans);
  86.     writeln(' ');
  87.   end;
  88.  
  89. Function TTime(FTime: Integer): String05;
  90.  
  91. Var
  92.   FHR,
  93.   FMin   :    String[2];
  94.   HR     :    Integer;
  95.  
  96.   Begin;
  97.  
  98.     str ((FTime shr 11):2, FHr);
  99.     str (((FTime shl 5) shr 10):2, FMin);
  100.  
  101.     If FHR[1]  = ' ' then FHR[1]  := '0';
  102.     If FMin[1] = ' ' then FMin[1] := '0';
  103.  
  104.     TTime :=  FHR + ':' + FMin;
  105.   End;
  106.  
  107. Function TDate(FDate: Integer): String08;
  108.  
  109. Var
  110.   FYr,
  111.   FMo,
  112.   FDay   :    String[2];
  113.  
  114.   Begin
  115.     str (((FDate shr 9) +80):2, FYr);
  116.     str (((FDate shl 7)  shr 12):2, FMo);
  117.     str (((FDate shl 11) shr 11):2, FDay);
  118.  
  119.     If FMo[1]  = ' ' then FMo[1]  := '0';
  120.     If FDay[1] = ' ' then FDay[1] := '0';
  121.  
  122.     TDate := FMo + '/' + FDay + '/' + FYr;
  123.  
  124.   End;
  125.  
  126. Function SysDate: String08;
  127.  
  128.   Var
  129.     Month,
  130.     Day,
  131.     Year    : string[2];
  132.  
  133.   begin
  134.     Regs.AX := $2A00;          { Get System Date      }
  135.     MSDos(Regs);
  136.  
  137.     str(Regs.DH: 2,month);
  138.     str(Regs.DL: 2,day);
  139.     str((Regs.CX - 1900): 2,year);
  140.  
  141.     If Month[1] = ' ' Then Month[1] := '0';
  142.     If Day[1]   = ' ' Then Day[1]   := '0';
  143.  
  144.     SysDate := Month + '/' + Day + '/' + Year;
  145.     End;
  146.  
  147. Function TSize(FSize1, FSize2, FSize3: Byte): Real;
  148.  
  149. Var
  150.   RSize1,
  151.   RSize2,
  152.   RSize3      :    Real;
  153.  
  154.   Begin
  155.  
  156.     RSize1 := FSize1;
  157.     RSize2 := FSize2 * 256.0;
  158.     RSize3 := FSize3 * 65536.0;
  159.     TSize  := RSize1 + RSize2 + RSize3;
  160.  
  161.   End;
  162.  
  163. Procedure SaveIt(Attr: Byte);
  164.  
  165.   Begin
  166.  
  167.     If (Attr = 16)
  168.        then begin
  169.             If o = 1
  170.                then sublist[k] := sublist[o] + NamR
  171.                else begin
  172.                     For I := K downto O + 1
  173.                         Do Sublist[I] := Sublist[I-1];
  174.                     Sublist[O+1] := sublist[o] + '\' + NamR;
  175.                     end;
  176.             k:=k+1;
  177.             end
  178.        else begin
  179.             Files := Files + 1;
  180.             ArcList[Files].FileName := NamR;
  181.             ArcList[Files].FileDate := TDate(DTA.Date);
  182.             ArcList[Files].FileTime := TTime(DTA.Time);
  183.             ArcList[Files].FileSize := TSize(DTA.Size[1],DTA.Size[2],
  184.                                              DTA.Size[3]);
  185.             Tot_Bytes := Tot_Bytes  + ArcList[Files].FileSize;
  186.             end;
  187.   end;
  188.  
  189. Procedure PrintArc;
  190.  
  191.   Begin
  192.     If Files > 0 then begin
  193.        WriteLn;
  194.        WriteLn('Dir: ',SubList[O]);
  195.        if pause then
  196.           begin
  197.             p := p + 2;
  198.             if p >= lim then waitkey;
  199.           end;
  200.  
  201.        for i := 1 to Files do
  202.            begin
  203.              writeln('   ',ArcList[I].FileName:15,
  204.                            ArcList[I].FileDate:12,
  205.                            ArcList[I].FileTime:10,
  206.                            ArcList[I].FileSize:08:0);
  207.              if pause then begin p:=p+1; if p=lim then waitkey; end;
  208.             end;
  209.     end;
  210.   end;
  211.  
  212. Procedure getlist;
  213.  
  214.   Begin { main body of program DirList }
  215.  
  216.     FillChar(DTA,SizeOf(DTA),0);        { Initialize the DTA buffer }
  217.     FillChar(Mask,SizeOf(Mask),0);      { Initialize the mask }
  218.     FillChar(NamR,SizeOf(NamR),0);      { Initialize the file name }
  219.  
  220.     Regs.AX := $1A00;          { Function used to set the DTA }
  221.     Regs.DS := Seg(DTA);       { store the parameter segment in DS }
  222.     Regs.DX := Ofs(DTA);       {   "    "      "     offset in DX }
  223.     MSDos(Regs);
  224.  
  225.     Mask := '????????.???';    { Use global search }
  226.     Regs.AX := $4E00;          { Start file search }
  227.     Regs.DS := Seg(Mask);      { Point to the file Mask }
  228.     Regs.DX := Ofs(Mask);
  229.     Regs.CX := 22;             { Look for Hidden, System, Directory, Files }
  230.     MSDos(Regs);
  231.  
  232.     If (Regs.AX) > 0 Then Exit;
  233.  
  234.     Repeat
  235.       If (DTA.Attr = 16) or    { Directory Entry  }
  236.          (DTA.Attr > 31)       { Archived Bit Set }
  237.          Then Begin
  238.            I := 1;
  239.            repeat
  240.              NamR[I] := DTA.Name[I];
  241.              I := I + 1;
  242.            until not (NamR[I-1] in [' '..'~']) or (I > 13);
  243.            NamR[0] := Chr(I-2);   { set string length because assigning }
  244.                                   { by element does not set length }
  245.            If NamR[1] <> '.'
  246.               Then SaveIt(DTA.Attr);
  247.            End;
  248.  
  249.       Regs.AX := $4F00;           { Continue File Search }
  250.       Regs.CX := 22;              { Set the file option }
  251.       MSDos( Regs );
  252.  
  253.     Until (Regs.AX) > 0;
  254.  
  255.   end;
  256.  
  257. Begin
  258.  
  259.   getdir(0,SaveDir);
  260.   sublist[1] := '\';
  261.   pause      := false;
  262.   Parse_Parm;
  263.  
  264.   Tot_Bytes := 0.0;
  265.   K := 1;
  266.   O := 1;
  267.   Tot_Files := 0;
  268.   Tot_Floppies := 0;
  269.   Clrscr;
  270.   WriteLn('List ARChive ..... Ver 1.01 ..... LARC [d:] [/p]',SysDate:10);
  271.   P := 2;
  272.   repeat
  273.     ChDir(SubLIst[o]);
  274.     K := K + 1;
  275.     Files := 0;
  276.     GetList;
  277.     K := K - 1;
  278.     Tot_Files := Tot_Files + Files;
  279.     Printarc;
  280.     O := O + 1;
  281.   until O > K;
  282.   If Tot_Bytes > 0 Then
  283.      Begin
  284.        Tot_Bytes := Tot_Bytes + (Tot_Files * 128);
  285.        Tot_Bytes := Tot_Bytes + ((Tot_Bytes / 362496.0) * 128.0);
  286.        Tot_Floppies := INT(Tot_Bytes / 362496.0) + 1.0;
  287.      End;
  288.   O := O - 1;
  289.   ChDir(SaveDir); {Restore starting Directory}
  290.  
  291.   If Pause
  292.      Then Begin
  293.        If P + 5 >= Lim Then WaitKey;
  294.        end;
  295.  
  296.   writeln('|-----------------------------------------------------|');
  297.   writeln('| Total Directories : ',o:3,' | Total files listed: ',tot_files:5,' |');
  298.   writeln('|-----------------------------------------------------|');
  299.   WriteLn('| Approximately ',Tot_Floppies:3:0,' floppies needed for Backup        |');
  300.   Writeln('|-----------------------------------------------------|');
  301.  
  302. end.
  303.