Contributor: MIKE COPELAND            



const
      BSize    = 4096;                                      { I/O Buffer Size }
      HMax     = 512;                                   { Header Maximum Size }
      DLM      = #32#179;
      HexDigits: array[0..15] of char = '0123456789ABCDEF';
type
      MEDBUF       = array[1..4096] of char;
var
      DISKNUM      : Word;                     { Disk # - offset to Disk Info }
      WVN          : Word;                                 { Working Volume # }
      DIDX         : Word;                              { Files Display Index }
      VIDX         : Word;                            { Volumes Display Index }
      AIDX         : Word;                           { Archives Display Index }
      CIDX         : Word;                   { Compressed Files Display Index }
      ADX          : Word;                            { comPressed file Index }
      RES          : Word;                                   { Buffer Residue }
      N,P,Q        : Longint;
      ASZ,USZ,FSZ  : LongInt;              { Disk Available, Used, Free sizes }
      SEQNUM       : LongInt;                               { File Sequence # }
      C            : LongInt;                                 { Buffer Offset }
      FSize        : LongInt;                                     { File Size }
      CH, CH1      : char;
      DEVICE       : char;                                      { Disk Device }
      BIN,BOUT,
      BWORK        : ^MEDBUF;
      F            : File;
      SNAME        : String;
      DATE         : string[8];                  { formatted date as YY/MM/DD }
      TIME         : string[5];                  {     "     time as HH:MM    }
      X1,X2,X3,X4,
      X5,X6,X7,X8,
      X9,X10,X11,
      X12          : string;
      DISKNAME     : string[15];
      CMD          : string;                             { DOS Command string }
      INDENT       : string;                        { Report Indention string }
      GARB         : string[6];                        { extraneous device id }
      PRIORAN      : STR12;                              { Prior Archive Name }
      DirInfo      : SearchRec;                       { File name search type }
      SR           : SearchRec;
      DT           : DateTime;
      PATH         : PathStr;
      DIR          : DirStr;
      FNAME        : NameStr;
      EXT          : ExtStr;
      Regs         : Registers;
      Temp         : String[1];
      BUFF         : array[1..BSize] of Byte;
      IB           : InfoBuffer;
      S            : string[11];
      SNAME        : string[12];

Var I,J,K : LongInt;
(**************************** ARJ Files Processing ***************************)
Type  AHMain = record                                           { ARJ Headers }
                 HeadId  : Word;                                      { 60000 }
                 BHdrSz  : Word;                          { Basic Header Size }
                 FHdrSz  : Byte;                           { File Header Size }
                 AVNo    : Byte;
                 MAVX    : Byte;
                 HostOS  : Byte;
                 Flags   : Byte;
                 SVer    : Byte;
                 FType   : Byte;                 { must be 2 for basic header }
                 Res1    : Byte;
                 DOS_DT  : LongInt;
                 CSize   : LongInt;                         { Compressed Size }
                 OSize   : LongInt;                           { Original Size }
                 SEFP    : LongInt;
                 FSFPos  : Word;
                 SEDLgn  : Word;
                 Res2    : Word;
                 NameDat : array[1..120] of char;       { start of Name, etc. }
                 Res3    : array[1..10] of char;
               end;
Var ARJ1     : AHMain;
procedure GET_ARJ_ENTRY;
begin
  FillChar(ARJ1,SizeOf(AHMain),#0); FillChar(BUFF,BSize,#0);
  Seek (F,C-1); BlockRead(F,BUFF,BSIZE,RES);        { read header into buffer }
  Move (BUFF[1],ARJ1,SizeOf(AHMain)); FSize := 0;
  with ARJ1 do
    begin
      if BHdrSz > 0 then
        begin
          I := 1; SNAME := B40;
          while NameDat[I] > #0 do Inc (I);       { scan for end of file name }
          Move (NameDat[1],SNAME[1],I-1); SNAME[0] := Chr(I-1);
          FSize := BHdrSz+CSize;
          if FType = 2 then FSize := BHdrSz;
          if BHdrSz = 0 then FSize := 0;
        end;  { if }
    end;  { with }
end;  { GET_ARJ_ENTRY }

procedure DO_ARJ (FN : string);
begin
  Assign (F,FN); Reset (F,1); C := 1;
  GET_ARJ_ENTRY;                                        { Process file Header }
  while FSize > 0 do
    begin
      Inc(C,FSize+10); GET_ARJ_ENTRY;                         { get file info }
      if FSize > 0 then
        begin
          with ARJ1 do
            begin
              FSplit (SNAME,DIR,FNAME,EXT);
              if Length(EXT) <= 0 then EXT := '    ';
              while Pos(#00,FNAME) > 0 do FNAME[Pos(#00,FNAME)] := ' ';
              F := Copy(FNAME+B40,1,8); E := Copy(EXT+'    ',1,4);
              SIZE := OSize; RTYPE := 4; D_T := DOS_DT;
              ANUM := ADX; VNUM := VDX;
            end;
        end;  { if }
    end;  { while }
  Close (F);
end;  { DO_ARJ }