home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MFM_119C.ZIP / COMPRESS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-03  |  7KB  |  220 lines
  1. Unit Compress;
  2. {========================================================================}
  3. Interface
  4.   Uses
  5.     Dos;
  6.   Procedure DisplayPageHeader;
  7.   Procedure DirOfArj(InFileName : PathStr);
  8.   Procedure DirOfZip(InFileName : PathStr);
  9.   Procedure DirOfArchive(InFileName : PathStr);
  10. {========================================================================}
  11. Implementation
  12.   Uses
  13.     Display, General, MfmDefs, MfmStr, Screen;
  14. {========================================================================}
  15. Procedure DisplayPageHeader;
  16.   Begin
  17.     AnsiClearScreen;
  18.     WriteLn('Directory for file '+CurrentEntry^.FileName);
  19.   End;
  20. {========================================================================}
  21. Procedure DirOfArj(InFileName : PathStr);
  22.   Const
  23.     HeaderSignature = $EA60;
  24.   Type
  25.     ArjHeaderType = Record
  26.       FirstHdrSize : Byte;
  27.       ArchiverVersionNumber : Byte;
  28.       MinArchiverVersion2Extract : Byte;
  29.       HostOS : Byte;
  30.       ArjFlags : Byte;
  31.       Method : Byte;
  32.       FileType : Byte;
  33.       Reserved : Byte;
  34.       DateTime : LongInt;
  35.       CompressedSize : LongInt;
  36.       OriginalSize : LongInt;
  37.       OriginalCrc : LongInt;
  38.       FilespecPos : Word;
  39.       FileAccessMode : Word;
  40.       HostData : Word;
  41.     End;
  42.     FileNameType = Array[1..255] Of Char;
  43.   Var
  44.     ArjFile : File;
  45.     SigOk : Boolean;
  46.     NewPos : LongInt;
  47.     Signature, HeaderSize, ExtHeaderSize : Word;
  48.     HeaderBuffer : Pointer;
  49.     HeaderBufferPtr : ^ArjHeaderType;
  50.     FileNameStr : String;
  51.     FileNamePtr : ^FileNameType;
  52.     LineCounter : Byte;
  53.   {==============================}
  54.   Procedure DisplayArjHeader;
  55.     Var
  56.       Dahb : Byte;
  57.     Begin
  58.       BlockRead(ArjFile,Signature,SizeOf(Signature));
  59.       If Signature = HeaderSignature Then
  60.       Begin
  61.         BlockRead(ArjFile,HeaderSize,SizeOf(HeaderSize));
  62.         If HeaderSize > 0 Then
  63.         Begin
  64.           SigOk := True;
  65.           GetMem(HeaderBuffer,HeaderSize);
  66.           BlockRead(ArjFile,HeaderBuffer^,HeaderSize);
  67.           HeaderBufferPtr := HeaderBuffer;
  68.           FileNamePtr := HeaderBuffer;
  69.           Dahb := 1;
  70.           While FileNamePtr^[Dahb+SizeOf(ArjHeaderType)] <> #0 Do
  71.           Begin
  72.             FileNameStr[Dahb] := FileNamePtr^[Dahb+SizeOf(ArjHeaderType)];
  73.             Inc(Dahb);
  74.           End;
  75.           FileNameStr[0] := Char(Dahb-1);
  76.           If Length(FileNameStr) > 12 Then
  77.           Begin
  78.             WriteLn(FileNameStr);
  79.             Write('            ');
  80.             Inc(LineCounter);
  81.           End
  82.           Else
  83.           Begin
  84.             Write(Copy(FileNameStr+'          ',1,12));
  85.           End;
  86.           Write(MyStr(HeaderBufferPtr^.OriginalSize,8)+' ');
  87.           Write(GetDateString(HeaderBufferPtr^.DateTime)+' ');
  88.           Write(GetTimeString(HeaderBufferPtr^.DateTime)+' ');
  89.           Write(HexDw(HeaderBufferPtr^.OriginalCrc));
  90.           WriteLn;
  91.           Seek(ArjFile,FilePos(ArjFile)+4);
  92.           BlockRead(ArjFile,ExtHeaderSize,SizeOf(ExtHeaderSize));
  93.           If ExtHeaderSize > 0 Then Seek(ArjFile,FilePos(ArjFile)+ExtHeaderSize);
  94.           Seek(ArjFile,FilePos(ArjFile)+HeaderBufferPtr^.CompressedSize);
  95.           FreeMem(HeaderBuffer,HeaderSize);
  96.         End
  97.         Else
  98.         Begin
  99.           SigOk := False;
  100.         End;
  101.       End
  102.       Else
  103.       Begin
  104.         SigOk := False;
  105.       End;
  106.     End;
  107.   {==============================}
  108.   Begin
  109.     DisplayPageHeader;
  110.     LineCounter := 0;
  111.     SigOk := True;
  112.     Assign(ArjFile,InFileName);
  113.     Reset(ArjFile,1);
  114.     BlockRead(ArjFile,Signature,SizeOf(Signature));
  115.     BlockRead(ArjFile,HeaderSize,SizeOf(HeaderSize));
  116.     Seek(ArjFile,FilePos(ArjFile)+HeaderSize+4);
  117.     BlockRead(ArjFile,ExtHeaderSize,SizeOf(ExtHeaderSize));
  118.     If ExtHeaderSize > 0 Then Seek(ArjFile,FilePos(ArjFile)+ExtHeaderSize);
  119.     While SigOk Do
  120.     Begin
  121.       DisplayArjHeader;
  122.       Inc(LineCounter);
  123.       If LineCounter >= 23 Then
  124.       Begin
  125.         If UpCase(Char(AnyKey)) = 'Q' Then SigOk := False;
  126.         DisplayPageHeader;
  127.         LineCounter := 0;
  128.       End;
  129.     End;
  130.     If LineCounter > 0 Then AnyKey;
  131.     Close(ArjFile);
  132.     DisplayScreen;
  133.   End;
  134. {========================================================================}
  135. Procedure DirOfZip(InFileName : PathStr);
  136.   Var
  137.     ZipFile : File;
  138.     SigOk : Boolean;
  139.     NewPos : LongInt;
  140.     LineCounter : Byte;
  141.   {==============================}
  142.   Procedure DisplayZipHeader;
  143.     Const
  144.       HeaderSignature = $04034b50;
  145.     Type
  146.       ZipHeaderType = Record
  147.         Version, Flag, Method, Time, Date : Word;
  148.         Crc32, CompressedSize, UncompressedSize : LongInt;
  149.         FileNameLength, ExtraFieldLength : Word;
  150.       End;
  151.       FileNameType = Array[1..255] Of Char;
  152.     Var
  153.       Dzhb : Byte;
  154.       Signature, PosInFile : LongInt;
  155.       ZipHeader : ZipHeaderType;
  156.       HeaderBuffer, FileNameBuffer : Pointer;
  157.       HeaderBufferPtr : ^ZipHeaderType;
  158.       FileNameStr : String;
  159.       FileNamePtr : ^FileNameType;
  160.     Begin
  161.       BlockRead(ZipFile,Signature,SizeOf(Signature));
  162.       If Signature = HeaderSignature Then
  163.       Begin
  164.         SigOk := True;
  165.         GetMem(HeaderBuffer,SizeOf(ZipHeader));
  166.         BlockRead(ZipFile,HeaderBuffer^,SizeOf(ZipHeader));
  167.         HeaderBufferPtr := HeaderBuffer;
  168.         GetMem(FileNameBuffer,HeaderBufferPtr^.FileNameLength);
  169.         BlockRead(ZipFile,FileNameBuffer^,HeaderBufferPtr^.FileNameLength);
  170.         FileNamePtr := FileNameBuffer;
  171.         For Dzhb := 1 To HeaderBufferPtr^.FileNameLength Do FileNameStr[Dzhb] := FileNamePtr^[Dzhb];
  172.         FileNameStr[0] := Chr(Lo(HeaderBufferPtr^.FileNameLength));
  173.         AnsiClearToEol;
  174.         WriteLn(Copy(FileNameStr+'          ',1,12)+' '+MyStr(HeaderBufferPtr^.UncompressedSize,8)+' '+
  175.           FormatDate(HeaderBufferPtr^.Date)+' '+FormatTime(HeaderBufferPtr^.Time)+' '+
  176.           HexDw(HeaderBufferPtr^.Crc32));
  177.         PosInFile := FilePos(ZipFile);
  178.         NewPos := PosInFile+HeaderBufferPtr^.CompressedSize+HeaderBufferPtr^.ExtraFieldLength;
  179.         FreeMem(FileNameBuffer,HeaderBufferPtr^.FileNameLength);
  180.         FreeMem(HeaderBuffer,SizeOf(ZipHeader));
  181.       End
  182.       Else
  183.       Begin
  184.         SigOk := False;
  185.       End;
  186.     End;
  187.   {==============================}
  188.   Begin
  189.     DisplayPageHeader;
  190.     LineCounter := 0;
  191.     SigOk := True;
  192.     Assign(ZipFile,InFileName);
  193.     Reset(ZipFile,1);
  194.     While SigOk Do
  195.     Begin
  196.       DisplayZipHeader;
  197.       Seek(ZipFile,NewPos);
  198.       Inc(LineCounter);
  199.       If LineCounter >= 23 Then
  200.       Begin
  201.         If UpCase(Char(AnyKey)) = 'Q' Then SigOk := False;
  202.         DisplayPageHeader;
  203.         LineCounter := 0;
  204.       End;
  205.     End;
  206.     If LineCounter > 0 Then AnyKey;
  207.     Close(ZipFile);
  208.     DisplayScreen;
  209.   End;
  210. {========================================================================}
  211. Procedure DirOfArchive(InFileName : PathStr);
  212.   Begin
  213.     If FileExt(InFileName) = '.ARJ' Then DirOfArj(InFileName);
  214.     If FileExt(InFileName) = '.ZIP' Then DirOfZip(InFileName);
  215.   End;
  216. {========================================================================}
  217. Begin
  218. End.
  219. {========================================================================}
  220.