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