[Back to ARCHIVES SWAG index]  [Back to Main SWAG index]  [Original]

{
   Hmmmm, I thought I responded to you on this before.  Whether I did or
not, I will post what I did before (in the next two messages), but I
don't want to post the entire Program - I'm building a ShareWare
progream I plan to market, and I don't think I should give it _all_
away.  The code I post is pertinent to reading the headers and Filename
info in the Various archive Types, and I Really think you can work out
the rest without much trouble.  If you can't, please post a specific
question...
}

Const
      BSize    = 4096;                                      { I/O Buffer Size }
      HMax     = 512;                                   { Header Maximum Size }
Var
      I,J,K        : Integer;
      CT,RC,TC     : Integer;
      RES          : Word;                                   { Buffer Residue }
      N,P,Q        : LongInt;
      C            : LongInt;                                 { Buffer Offset }
      FSize        : LongInt;                                     { File Size }
      DEVICE       : Char;                                      { Disk Device }
      F            : File;
      SNAME        : String;
      DATE         : String[8];                  { formatted date as YY/MM/DD }
      TIME         : String[5];                  {     "     time as HH:MM    }
      DirInfo      : SearchRec;                       { File name search Type }
      SR           : SearchRec;                       { File name search Type }
      DT           : DateTime;
      PATH         : PathStr;
      DIR          : DirStr;
      FNAME        : NameStr;
      EXT          : ExtStr;
      Regs         : Registers;
      BUFF         : Array[1..BSize] of Byte;

Procedure FDT (LI : LongInt);                       { Format Date/Time fields }
begin
  UnPackTime (LI,DT);
  DATE := FSI(DT.Month,2)+'/'+FSI(DT.Day,2)+'/'+Copy(FSI(DT.Year,4),3,2);
  if DATE[4] = ' ' then DATE[4] := '0';
  if DATE[7] = ' ' then DATE[7] := '0';
  TIME := FSI(DT.Hour,2)+':'+FSI(DT.Min,2);
  if TIME[4] = ' ' then TIME[4] := '0';
end;  { FDT }

Procedure  MY_FFF;
Var I,J,K : LongInt;

(**************************** ARJ Files Processing ***************************)
Type ARJHead = Record
                 FHeadSize : Byte;
                 ArcVer1,
                 ArcVer2   : Byte;
                 HostOS,
                 ARJFlags,
                 Method    : Byte;   { MethodType = (Stored, LZMost, LZFast); }
                 R1,R2     : Byte;
                 Dos_DT    : LongInt;
                 CompSize,
                 UCompSize,
                 CRC       : LongInt;
                 ENP, FM,
                 HostData  : Word;
               end;
Var ARJ1     : ARJHead;
    ARJId    : Word;                                     { 60000, if ARJ File }
    HSize    : Word;                                            { Header Size }
Procedure GET_ARJ_ENTRY;
begin
  FillChar(ARJ1,SizeOf(ARJHead),#0); FillChar(BUFF,BSize,#0);
  Seek (F,C-1); BlockRead(F,BUFF,BSIZE,RES);        { read header into buffer }
  Move (BUFF[1],ARJId,2);  Move (BUFF[3],HSize,2);
  if HSize > 0 then
    With ARJ1 do
      begin
        Move (BUFF[5],ARJ1,SizeOf(ARJHead));
        I := FHeadSize+5; SNAME := B40;
        While BUFF[I] > 0 do Inc (I);
        I := I-FHeadSize-5;
        Move (BUFF[FHeadSize+5],SNAME[1],I); SNAME[0] := Chr(I);
        FSize := CompSize; Inc (C,HSIZE);
      end;
end;  { GET_ARJ_ENTRY }

Procedure DO_ARJ (FN : String);
begin
  Assign (F,FN); Reset (F,1); C := 1;
  GET_ARJ_ENTRY;                                            { Process File
Header }
  Repeat
    Inc(C,FSize+10);
    GET_ARJ_ENTRY;
    if HSize > 0 then
      begin
        Inc (WPX); New(SW[WPX]);       { store Filename info in dynamic Array }
        With SW[WPX]^ do
          begin
            FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
            SIZE := ARJ1.UCompSize;
            RType := 4; D_T := ARJ1.Dos_DT; ANUM := ADX; VNUM := VDX;
            ADD_CNAME;
          end;
        Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
      end;
  Until HSize <= 0;
  Close (F);
end;  { DO_ARJ }

(**************************** ZIP Files Processing ***************************)
Type ZIPHead = Record
                 ExtVer : Word;
                 Flags  : Word;
                 Method : Word;
                 Fill1  : Word;
                 Dos_DT        : LongInt;
                 CRC32         : LongInt;
                 CompSize      : LongInt;
                 UCompSize     : LongInt;
                 FileNameLen   : Word;
                 ExtraFieldLen : Word;
               end;
Var ZIPCSize : LongInt;
    ZIPId    : Word;
    ZIP1     : ZIPHead;
Procedure GET_ZIP_ENTRY;
begin
  FillChar(ZIP1,SizeOf(ZIPHead),#0); Move (BUFF[C+1],ZIPId,2);
  if ZIPId > 0 then
    begin
      Move (BUFF[C+1],ZIP1,SizeOf(ZIPHead));
      Inc (C,43); SNAME := '';
      With ZIP1 do
        begin
          Move (BUFF[C],SNAME[1],FileNameLen); SNAME[0] := Chr(FileNameLen);
          FSize := CompSize;
        end;
    end;
end;  { GET_ZIP_ENTRY }

Procedure DO_ZIP (FN : String);
Const CFHS : String[4] = 'PK'#01#02;          { CENTRAL_File_HEADER_SIGNATURE }
      ECDS : String[4] = 'PK'#05#06;        { end_CENTRAL_DIRECTORY_SIGNATURE }
Var S4     : String[4];
    FOUND  : Boolean;
    QUIT   : Boolean;                            { "end" sentinel encountered }
begin
--- GOMail v1.1 [DEMO] 03-09-93
 * Origin: The Private Reserve - Phoenix, AZ (602) 997-9323 (1:114/151)
<<<>>>


Date: 03-23-93 (22:30)              Number: 16806 of 16859 (Echo)
  To: EDDIE BRAITER                 Refer#: NONE
From: MIKE COPELAND                   Read: NO
Subj: FORMAT VIEWER - PART 2 of     Status: PUBLIC MESSAGE
Conf: F-PASCAL (1221)            Read Type: GENERAL (+)

(**************************** ARC Files Processing ***************************)
Type ARCHead = Record
                 ARCMark   : Char;
                 ARCVer    : Byte;
                 FN        : Array[1..13] of Char;
                 CompSize  : LongInt;
                 Dos_DT    : LongInt;
                 CRC       : Word;
                 UCompSize : LongInt;
               end;
Const ARCFlag : Char = #26;                                        { ARC mark }
Var WLV   : LongInt;                               { Working LongInt Variable }
    ARC1  : ARCHead;
    QUIT  : Boolean;                             { "end" sentinel encountered }

Procedure GET_ARC_ENTRY;
begin
  FillChar(ARC1,SizeOf(ARCHead),#0); L := SizeOf(ARCHead);
  Seek (F,C); BlockRead (F,BUFF,L,RES);
  Move (BUFF[1],ARC1,L);
  With ARC1 do
    if (ARCMark = ARCFlag) and (ARCVer > 0) then
      begin
        SNAME := ''; I := 1;
        While FN[I] <> #0 do
          begin
            SNAME := SNAME+FN[I]; Inc(I)
          end;
        WLV := (Dos_DT Shr 16)+(Dos_DT Shl 16);              { flip Date/Time }
        FSize := CompSize;
      end;
    QUIT := ARC1.ARCVer <= 0;
end;  { GET_ARC_ENTRY }

Procedure DO_ARC (FN : String);
begin
  Assign (F,FN); Reset (F,1); C := 0;
  Repeat
    GET_ARC_ENTRY;
    if not QUIT then
      begin
        Inc (WPX); New(SW[WPX]);       { store Filename info in dynamic Array }
        With SW[WPX]^ do
          begin
            FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
            SIZE := ARC1.UCompSize; RType := 4;                   { comp File }
            D_T := WLV; ANUM := ADX; VNUM := VDX;
            ADD_CNAME;
          end;
        Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
      end;
    Inc (C,FSize+SizeOf(ARCHead))
  Until QUIT;
  Close (F);
end;  { DO_ARC }

(************************* LZH Files Processing ******************************)
Type LZHHead = Record
                 HSize       : Byte;
                 Fill1       : Byte;
                 Method      : Array[1..5] of Char;
                 CompSize    : LongInt;
                 UCompSize   : LongInt;
                 Dos_DT      : LongInt;
                 Fill2       : Word;
                 FileNameLen : Byte;
                 FileName    : Array[1..12] of Char;
               end;

Var LZH1     : LZHHead;

Procedure GET_LZH_ENTRY;
begin
  FillChar(LZH1,SizeOf(LZHHead),#0); FillChar (DT,SizeOf(DT),#0);
  L := SizeOf(LZHHead);
  Seek (F,C); BlockRead (F,BUFF,L,RES);
  Move (BUFF[1],LZH1,L);
  With LZH1 do
    if HSize > 0 then
      begin
        Move (FileNameLen,SNAME,FileNameLen+1);
        UnPackTime (Dos_DT,DT);
        FSize := CompSize;
      end
    else QUIT := True
end;  { GET_LZH_ENTRY }

Procedure DO_LZH (FN : String);
begin
  Assign (F,FN); Reset (F,1);
  FSize := FileSize(F); C := 0; QUIT := False;
  Repeat
    GET_LZH_ENTRY;
    if not QUIT then
      begin
        Inc (WPX); New(SW[WPX]);       { store Filename info in dynamic Array }
        With SW[WPX]^ do
          begin
            FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
            SIZE := LZH1.UCompSize;
            RType := 4; ANUM := ADX; VNUM := VDX; D_T := LZH1.Dos_DT;
            ADD_CNAME;
          end;
        Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
      end;
    Inc (C,FSize+LZH1.HSize+2)
  Until QUIT;
  Close (F);
end;  { DO_LZH }

[Back to ARCHIVES SWAG index]  [Back to Main SWAG index]  [Original]