home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PAS_0493.ZIP / LZHV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-15  |  7.1 KB  |  249 lines
  1. { LzhV.Pas: Unit to view contents of .LZH files.  By Steve Wierenga. Released
  2.   to the Public Domain.                                                      }
  3. Unit Lzhv;
  4. (**) INTERFACE (**)
  5. Uses Dos,Crt;
  6. Type
  7.   Fileheadertype = record  { Lzh file header }
  8.     Headsize,Headchk : byte;
  9.     HeadID : packed array[1..5] of char;
  10.     Packsize,Origsize,Filetime : longint;
  11.     Attr : word;
  12.     filename : String[12];
  13.     f32 : PathStr;
  14.     dt : DateTime;
  15.   end;
  16.  
  17. var
  18.   Fh : fileheadertype;
  19.   Fha: array[1..sizeof(fileheadertype)] of byte absolute fh;
  20.   crc: word;   { CRC value }
  21.   crcbuf : array[1..2] of byte absolute CRC;
  22.   crc_table : array[0..255] of word; { Table of CRC's }
  23.   infile : file; { File to be processed }
  24.   registered : boolean; { Is registered? }
  25.  
  26. Procedure Make_crc_table; { Create table of CRC's }
  27. Function Mksum: byte;     { Get CheckSum }
  28. Procedure ViewLzh(LZHfile : string);  { View the file }
  29. Function GAN(LZHfile: String): string;  { Get the LZH filename }
  30.  
  31.  
  32. (**) IMPLEMENTATION (**)
  33. Procedure Terminate; { Exit the program }
  34. Begin
  35.   Write('ARCHPEEK could not find specified file.  Aborting...');
  36.   Halt;
  37. End;
  38.  
  39. Procedure Make_crc_table;
  40. var
  41.   i,index,ax : word;
  42.   carry : boolean;
  43. begin
  44.   index := 0;
  45.   repeat
  46.     ax := index;
  47.     for i := 1 to 8 do
  48.       begin
  49.         carry := odd(ax);
  50.         ax := ax shr 1;
  51.         if carry then ax := ax xor $A001;
  52.       end;
  53.     crc_table[index] := ax;
  54.     inc(index);
  55.   until index > 255;
  56. end;
  57.  
  58. { use this to calculate the CRC value of the original file }
  59. { call this function afer reading every byte from the file }
  60. Procedure calccrc(data : byte);
  61. var
  62.   index : integer;
  63. begin
  64.   crcbuf[1] := crcbuf[1] xor data;
  65.   index := crcbuf[1];
  66.   crc := crc shr 8;
  67.   crc := crc xor crc_table[index];
  68. end;
  69.  
  70.  
  71. Function Mksum : byte;  {calculate check sum for file header }
  72. var
  73.   i : integer;
  74.   b : byte;
  75. begin
  76.   b := 0;
  77.   for i := 3 to fh.headsize+2 do
  78.     b := b+fha[i];
  79.   mksum := b;
  80. end;
  81.  
  82.  
  83. Procedure viewlzh(LZHfile : string); { View the LZH file }
  84. var
  85.   l1,l2,oldfilepos,a,b,a1,b1,totalorig,totalpack : longint;
  86.   count,z : integer;
  87.   numread,i,year1,month1,day1,hour1,min1,sec1 : word;
  88.   s1 : string[50];
  89.   s2 : string[20];
  90.    l : string[80];
  91.   sss  :  string;
  92. begin
  93.   registered  :=  false; { Unregistered }
  94.   if not registered then { Registered? }
  95.   begin
  96.     Writeln('ArchPeek 0.01Alpha [UNREGISTERED] Copyright 1993 Steve Wierenga');
  97.     Delay(200);
  98.   end;
  99.   assign(infile,LZHfile);
  100.   {$I-}
  101.   reset(infile,1);   { Open LZH file }
  102.   {$I+}
  103.   If IOResult <> 0 then Terminate;   { Specified file exists? }
  104.   sss  :=  GAN(LZHFile);  { Get filename of LZH file }
  105.   Writeln( 'Lzh FileName: ',sss);
  106.   WriteLn( '    Name           Length      Size  Saved',
  107.           '    Date      Time    ');
  108.   WriteLn( '   ____________________________________________________',
  109.          '______');
  110.   oldfilepos := 0;       { Init variables }
  111.   count := 1;
  112.   z  :=  0; a1  :=  0;
  113.   repeat
  114.     z  :=  z + 1;
  115.     seek(infile,oldfilepos);                              { Goto start of file}
  116.     blockread(infile,fha,sizeof(fileheadertype),numread); { Read fileheader}
  117.     oldfilepos := oldfilepos+fh.headsize+2+fh.packsize;   { Where are we? }
  118.    i := Mksum; { Get the checksum }
  119.    if fh.headsize <> 0 then
  120.      begin
  121.        if i <> fh.headchk then
  122.          begin
  123.            Writeln('Error in file. Unable to read. Aborting...');
  124.            Close(infile);
  125.            Exit;
  126.          end;
  127.        Case Length(Fh.FileName) Of          { Straigthen out string }
  128.          1  : Fh.FileName  :=  Fh.FileName + '           ';
  129.          2  : Fh.FileName  :=  Fh.FileName + '          ';
  130.          3  : Fh.FileName  :=  Fh.FileName + '         ';
  131.          4  : Fh.FileName  :=  Fh.FileName + '        ';
  132.          5  : Fh.FileName  :=  Fh.FileName + '       ';
  133.          6  : Fh.FileName  :=  Fh.FileName + '      ';
  134.          7  : Fh.FileName  :=  Fh.FileName + '     ';
  135.          8  : Fh.FileName  :=  Fh.FileName + '    ';
  136.          9  : Fh.FileName  :=  Fh.FileName + '   ';
  137.          10 : Fh.FileName  :=  Fh.FileName + '  ';
  138.          11 : Fh.FileName  :=  Fh.FileName + ' ';
  139.          12 : Fh.FileName  :=  Fh.FileName + '';
  140.        End;
  141.        UnPackTime(Fh.FileTime,Fh.DT);
  142.        a1 := a1 + Fh.OrigSize;            { Increase Uncompressed Size }
  143.        Write( '   ',fh.filename:2,fh.origsize:9,fh.packSize:10,
  144.                     (100-fh.packSize/fh.origSize*100):5:0,'%');
  145.        { Display info }
  146.     Case fh.dt.month of  { Get date and time }
  147.      1..9   : Write( '0':4,fh.dt.month);
  148.      10..12 : Write( ' ',fh.dt.month:4);
  149.     End;
  150.     Write( '/');
  151.     Case fh.dt.day of
  152.      1..9   : Write( '0',fh.dt.day);
  153.      10..31 : Write( fh.dt.day);
  154.     End;
  155.     Write( '/');
  156.     Case fh.dt.year of
  157.      1980 : Write( '80');
  158.      1981 : Write( '81');
  159.      1982 : Write( '82');
  160.      1983 : Write( '83');
  161.      1984 : Write( '84');
  162.      1985 : Write( '85');
  163.      1986 : Write( '86');
  164.      1987 : Write( '87');
  165.      1988 : Write( '88');
  166.      1989 : Write( '89');
  167.      1990 : Write( '90');
  168.      1991 : Write( '91');
  169.      1992 : Write( '92');
  170.      1993 : Write( '93');
  171.      1994 : Write( '94');
  172.      1995 : Write( '95');
  173.      1996 : Write( '96');
  174.     End;
  175.     Case fh.dt.hour of
  176.      0..9   : Write( '0':3,fh.dt.hour,':');
  177.      10..23 : Write( ' ',fh.dt.hour:3,':');
  178.     End;
  179.     Case fh.dt.min of
  180.      0..9   : Write( '0',fh.dt.min,':');
  181.      10..59 : Write( fh.dt.min,':');
  182.     End;
  183.     Case fh.dt.sec of
  184.      0..9   : Writeln( '0',fh.dt.sec);
  185.      10..59 : Writeln( fh.dt.sec);
  186.     End;
  187.       end;
  188.   until   (fh.headsize=0);
  189.   Writeln( '  ======================================================',
  190.           '=====');
  191.   GetFTime(infile,l1);
  192.   UnPackTime(l1,fh.dt);
  193.   Write( '  ',z,' Files  ',a1:12,FileSize(infile):10,
  194.           (100-FileSize(infile)/a1*100):5:0,'%');
  195.   Case fh.dt.month of
  196.      1..9   : Write( '0':4,fh.dt.month);
  197.      10..12 : Write( ' ',fh.dt.month:4);
  198.     End;
  199.     Write( '/');
  200.     Case fh.dt.day of
  201.      1..9   : Write( '0',fh.dt.day);
  202.      10..31 : Write( fh.dt.day);
  203.     End;
  204.     Write( '/');
  205.     Case fh.dt.year of
  206.      1980 : Write( '80');
  207.      1981 : Write( '81');
  208.      1982 : Write( '82');
  209.      1983 : Write( '83');
  210.      1984 : Write( '84');
  211.      1985 : Write( '85');
  212.      1986 : Write( '86');
  213.      1987 : Write( '87');
  214.      1988 : Write( '88');
  215.      1989 : Write( '89');
  216.      1990 : Write( '90');
  217.      1991 : Write( '91');
  218.      1992 : Write( '92');
  219.      1993 : Write( '93');
  220.      1994 : Write( '94');
  221.      1995 : Write( '95');
  222.      1996 : Write( '96');
  223.     End;
  224.     Case fh.dt.hour of
  225.      0..9   : Write( '0':3,fh.dt.hour,':');
  226.      10..23 : Write( ' ',fh.dt.hour:3,':');
  227.     End;
  228.     Case fh.dt.min of
  229.      0..9   : Write( '0',fh.dt.min,':');
  230.      10..59 : Write( fh.dt.min,':');
  231.     End;
  232.     Case fh.dt.sec of
  233.      0..9   : Writeln( '0',fh.dt.sec);
  234.      10..59 : Writeln( fh.dt.sec);
  235.     End;
  236.    End;
  237.  
  238. FUNCTION GAN(LZHfile : String): string;
  239.   Var
  240.     Dir  : DirStr;
  241.     Name : NameStr;
  242.     Exts : ExtStr;
  243.   Begin
  244.     FSplit(LZHFile,Dir,Name,Exts);
  245.     GAN := Name + Exts;
  246.   End;
  247.  
  248.  
  249. End.