{ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ}
{Û                                                       Û}
{Û      Virtual Pascal Examples. Version 2.1.            Û}
{Û      RAR archive unpacker                             Û}
{Û      ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÛ}
{Û      Original C version (C) 1994-95 Eugene Roshal     Û}
{Û      Copyright (C) 1995-2000 vpascal.com              Û}
{Û                                                       Û}
{ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}

Program UnRar;

{&Use32+,Delphi-,T-,H-,X+}

Uses
  Dos, Unpack;

Type
  Errors = ( eEmpty, eWrite, eRead, eOpen, eClose, eMemory, eArch );

  MarkHeader = Record
    Mark     : Array[0..4] of Byte;
    HeadSize : SmallWord;
  end;

  ArchiveHeader = Record
    HeadCRC  : SmallWord;
    HeadType : Byte;
    Flags    : SmallWord;
    HeadSize : SmallWord;
    Reserved : Array[0..5] of Byte;
  end;

  FileHeader = Record
    HeadCRC   : SmallWord;
    HeadType  : Byte;
    Flags     : SmallWord;
    HeadSize  : SmallWord;
    PackSize  : Word;
    UnpSize   : Word;
    HostOS    : Byte;
    FileCRC   : Word;
    FileTime  : Word;
    UnpVer    : Byte;
    Method    : Byte;
    NameSize  : SmallWord;
    FileAttr  : Word;
  end;

Const
  SD_MEMORY = 1;
  SD_FILES  = 2;
  SUCCESS     = 0;
  WARNING     = 1;
  FATAL_ERROR = 2;
  CRC_ERROR   = 3;
  LOCK_ERROR  = 4;
  WRITE_ERROR = 5;
  OPEN_ERROR  = 6;
  USER_ERROR  = 7;
  MEMORY_ERROR= 8;
  USER_BREAK  =255;

  UNP_VER = 15;

  MS_DOS = 0;
  OS2    = 1;
  DOSFA_RDONLY =  $01;
  DOSFA_HIDDEN =  $02;
  DOSFA_SYSTEM =  $04;
  DOSFA_LABEL  =  $08;
  DOSFA_DIREC  =  $10;
  DOSFA_ARCH   =  $20;

  MHD_MULT_VOL = 1;
  MHD_COMMENT  = 2;
  MHD_LOCK     = 4;
  MHD_SOLID    = 8;

  LHD_SPLIT_BEFORE =  1;
  LHD_SPLIT_AFTER  =  2;
  LHD_PASSWORD     =  4;
  LHD_COMMENT      =  8;
  SKIP_IF_UNKNOWN  =  $4000;
  LONG_BLOCK       =  $8000;

  ALL_HEAD  = 0;
  MARK_HEAD = $72;
  MAIN_HEAD = $73;
  FILE_HEAD = $74;
  COMM_HEAD = $75;

  COMPARE_PATH = 1;
  NOT_COMPARE_PATH = 2;

  PATHDIV      = '\';

Const
  MainCommand : Char = #0;
  ArcName : String[80] = '';
  ArgCount : Integer = 0;

Var
  ArcFPtr       : File;
  FileFPtr      : File;
  TmpMemory     : Pointer;
  NextBlockPos  : Word;
  UnpPackedSize : Word;
  UnpFileCRC    : Word;
  UnpVolume     : Boolean;
  TestMode      : Boolean;
  SolidType     : Boolean;
  CRC32_Table   : Array[0..255] of Word;
  Mhd           : ArchiveHeader;
  Lhd           : FileHeader;
  CurExtrFile   : String[80];
  ArcFileName   : String[80];
  ExtrPath      : String[80];
  ArgNames      : Array[0..15] of String[80];

const
  Digits : array[0..$F] of Char = '0123456789ABCDEF';

Function ZStr( x : Word; n : Byte ) : String;
Var
  s : String;
  i : Byte;

begin
  Str( x:n, s );
  For i := 1 to Length( s ) do
    If s[i] = ' ' then
      s[i] := '0';
  ZStr := s;
end;

Function LeftJustify( s : String; n : Integer ) : String;
begin
  While Length(s) < n do
    s := s + ' ';
  Leftjustify := s;
end;

function HexB(B : Byte) : string;
  {-Return hex string for byte}
begin
  HexB[0] := #2;
  HexB[1] := Digits[B shr 4];
  HexB[2] := Digits[B and $F];
end;

function HexW(W : Word) : string;
  {-Return hex string for word}
begin
  HexW[0] := #4;
  HexW[1] := Digits[hi(W) shr 4];
  HexW[2] := Digits[hi(W) and $F];
  HexW[3] := Digits[lo(W) shr 4];
  HexW[4] := Digits[lo(W) and $F];
end;

function HexL(L : LongInt) : string;
  {-Return hex string for LongInt}
begin
  HexL := HexW(L shr 16)+HexW(L and $FFFF);
end;

Function CmpName(Const Mask,Name : String) : Boolean;
Var
  MaskInx : Integer;
  NameInx : Integer;
  MaskLen : Byte;
  NameLen : Byte;

begin
  MaskInx := 1; MaskLen := Length( Mask );
  NameInx := 1; NameLen := Length( Name);
  while true do
  begin
    if Mask[ MaskInx ] = '*' then
    begin
      while (Mask[MaskInx] <> '.') and (MaskInx <= MaskLen) do
        Inc(MaskInx);
      while (Name[NameInx] <> '.') and (NameInx <= NameLen) do
        Inc(NameInx);
    end;
    if MaskInx > MaskLen then
      begin
        CmpName := ( NameInx > NameLen );
        Exit;
      end;

    if (NameInx > NameLen) and (Mask[MaskInx] = '.') then
    begin
      Inc( MaskInx );
      continue;
    end;

    if (UpCase(Mask[MaskInx]) = UpCase(Name[NameInx])) OR
       ( (Mask[MaskInx] = '?') and ( NameInx <= NameLen )) then
    begin
      Inc( MaskInx );
      Inc( NameInx );
    end
    else
      begin
        CmpName := False;
        Exit;
      end;
  end
end;

Procedure ShutDown(Mode : Integer);
begin
  if (Mode AND SD_FILES <> 0) then
    begin
      {$I-}
      if FileRec(ArcFPtr).Mode <> fmClosed then
        Close(ArcFPtr);
      {$I+}
      If IOResult = 0 then ;
      {$I-}
      if FileRec(FileFPtr).Mode <> fmClosed then
        Close(FileFPtr);
      {$I+}
      If IOResult = 0 then ;
    end;

  if (Mode AND SD_MEMORY <> 0) then
    begin
      if TmpMemory <> nil then
        FreeMem(TmpMemory, unp_Memory);
      Writeln;
    end
end;

Procedure ErrExit(ErrCode : Errors; Code : Integer);
Var
  ErrMsg : String;
begin
  Case ErrCode of
    eEmpty  : ErrMsg := '';
    eWrite  : ErrMsg := 'Write error. Disk full ?';
    eRead   : ErrMsg := 'Read error';
    eOpen   : ErrMsg := 'File open error';
    eClose  : ErrMsg := 'File close error';
    eMemory : ErrMsg := 'Not enough memory';
    eArch   : ErrMsg := 'Broken archive';
  end;
  if ( ErrCode <> eEmpty ) then
    Writeln( 'Program Aborted: ',ErrMsg );

  ShutDown(SD_FILES OR SD_MEMORY);
  Halt(Code);
end;

Procedure CreatePath(fpath : String);
Var
  ChPos : Integer;
  s,s1  : String[80];
begin
  s1 := '';
  Repeat
    ChPos := Pos( PathDiv, fPath );
    If ChPos <> 0 then
      begin
        s := s1+Copy( fPath, 1, ChPos-1 );
        {$I-}
        MkDir( s );
        {$I+}
        If IOResult = 0 then
          begin
            Writeln;
            Write( ' Creating    ',s );
          end;
        s1 := s+'\';
        Delete( fPath, 1, ChPos );
      end;
  Until ChPos = 0;
end;

Procedure NextVolumeName;
Var
  Dir     : DirStr;
  Name    : NameStr;
  Ext     : ExtStr;
  Number  : Integer;
  Err     : Integer;

begin
  fSplit( ArcName, Dir, Name, Ext );
  Val( Copy( Ext, 3, 2 ), Number, Err );
  If Err <> 0 then
    Number := 0
  else
    Inc( Number );
  Ext := Copy( Ext, 1, 2 ) + ZStr( Number, 2 );

  ArcName := Dir + Name + Ext;
end;

Procedure tclose(Var FPtr : File);
begin
  {$I-}
  Close( fPtr );
  {$I+}
  if IOResult <> 0 then
    ErrExit(ECLOSE,FATAL_ERROR);
end;

Function tread(Var f : File;Var buf; len : Word) : Integer;
Var
  Check : Word;

begin
  {$I-}
  BlockRead( f, Buf, Len, Check );
  {$I+}

  if (IOResult <> 0) or (Check <> Len) then;
    { ErrExit(EREAD,FATAL_ERROR); }

  tRead := Check;
end;

Procedure InitCRC;
Var
  I, J : Word;
  C : Word;
begin
  For i := 0 to 255 do
    begin
      C := I;
      For j := 0 to 7 do
        If Odd(C) then
          C := (C shr 1) XOR $EDB88320
        else
          C := C shr 1;
      CRC32_Table[I] := C;
    end
end;

Function CRC(StartCRC : Word;Addr : Pointer;Size : Word) : Word;
Var
  i : Word;

begin
  if CRC32_Table[1] = 0 then
    InitCRC;

  for i := 0 to Size-1 do
    StartCRC := CRC32_Table[ Byte(StartCRC) XOR
                pBuffer(Addr)^[I]] XOR (StartCRC shr 8);

  CRC := StartCRC;
end;

Function IsArchive : Boolean;
Var
  Mark : Array[0..6] of Byte;
  Header : Array[0..12] of Byte;
begin
  IsArchive := False;
  SolidType := False;

  if (tread(ArcFPtr,Mark,7)<>7) then
    Exit;

  if (Mark[0]<>$52) or (Mark[1]<>$61) or (Mark[2]<>$72) or (Mark[3]<>$21) or
     (Mark[4]<>$1a) or (Mark[5]<>$07) or (Mark[6]<>$00) then
    exit;

  if (tread(ArcFPtr,Header,13) <> 13) then
    exit;

  Mhd.HeadCRC   :=  SmallWord( (@Header[0])^ );
  Mhd.HeadType  :=  Header[2];
  Mhd.Flags     :=  SmallWord( (@Header[3])^ );
  Mhd.HeadSize  :=  SmallWord( (@Header[5])^ );
  if Mhd.HeadCRC <> not SmallWord(CRC($FFFFFFFF,@Header[2],11)) then
    writeln('Archive header broken');
  SolidType := (Mhd.Flags AND MHD_SOLID <> 0);
  Seek(ArcFPtr,FilePos(ArcFPtr)+Mhd.HeadSize-13);
  isArchive := True;
end;

Procedure CheckArc;
begin
  if not IsArchive then
    begin
      Writeln('Bad archive ',ArcName);
      ErrExit(EEMPTY,FATAL_ERROR);
    end
end;

Function ReadBlock(BlockType : Integer) : Integer;
Var
  HeadCRC : Word;
  Header  : Array[0..31] of byte;
  Size,I  : Integer;

begin
  FillChar( Lhd, Sizeof( Lhd ), 0 );
  FillChar( Header, Sizeof( Header ), 0 );
  while true do
    begin
      Size := tread( ArcFPtr, Header, 32 );
      Lhd.HeadCRC  := SmallWord( (@Header[0])^ );
      Lhd.HeadType := Header[2];
      Lhd.Flags    := SmallWord( (@Header[3])^ );
      Lhd.HeadSize := SmallWord( (@Header[5])^ );
      Lhd.PackSize := Word( (@Header[7])^ );
      Lhd.UnpSize  := Word( (@Header[11])^ );
      Lhd.HostOS   := Header[15];
      Lhd.FileCRC  := Word( (@Header[16])^ );
      Lhd.FileTime := Word( (@Header[20])^ );
      Lhd.UnpVer   := Header[24];
      Lhd.Method   := Header[25];
      Lhd.NameSize := SmallWord( (@Header[26])^ );
      Lhd.FileAttr := Word( (@Header[28])^ );
      if (Size <> 0) and ( (Size<7) or (Lhd.HeadSize<7) ) then
        ErrExit(EARCH,FATAL_ERROR);

      NextBlockPos := FilePos( ArcFPtr ) - Size + Lhd.HeadSize;
      if (Lhd.Flags AND LONG_BLOCK <> 0) then
        Inc( NextBlockPos, Lhd.PackSize );
      if (Size = 0) or (BlockType = ALL_HEAD) or (Lhd.HeadType = BlockType) then
        break;
      seek( ArcFPtr, NextBlockPos );
    end;

  if (Size>0) and (BlockType = FILE_HEAD) then
    begin
      tread(ArcFPtr,ArcFileName[1],Lhd.NameSize);
      ArcFileName[Lhd.NameSize+1] := #0;
      ArcFileName[0] := chr(Lhd.NameSize);
      Inc( Size, Lhd.NameSize );
      HeadCRC := CRC($FFFFFFFF,@Header[2],30);

      if Lhd.HeadCRC <> not SmallWord(CRC(HeadCRC,@ArcFileName[1],Lhd.NameSize)) then
        WriteLn(ArcFileName,': file header broken');

      for I := 1 to Length(ArcFileName) do
        if (ArcFileName[I] in ['\','/']) then
          ArcFileName[I] := PATHDIV;
    end;

  ReadBlock := Size;
end;

Procedure MergeArc(ShowFileName : Integer);
  {-Merge archive with next disk }
Var
  Ch  : Char;
  IOR : Integer;

begin
  tClose( ArcfPtr );
  NextVolumeName;
  Repeat
    Assign( ArcFPtr, ArcName );
    FileMode := $40;
    {$I-}
    Reset( ArcFPtr, 1 );
    {$I+}
    IOR := IOResult;
    If IOR <> 0 then
      begin
        Writeln;
        Write( ' Disk with ',ArcName,' is required. Continue ? ' );
        Readln( Ch );
        If UpCase( Ch ) = 'N' then
          ErrExit( EEMPTY, USER_BREAK );
      end;
  Until ( IOR = 0 );

  CheckArc;
  ReadBlock( FILE_HEAD );
  UnpVolume := ( Lhd.Flags AND LHD_SPLIT_AFTER ) <> 0;
  Seek( ArcFPtr, NextBlockPos-Lhd.PackSize );
  UnPpackedSize := LHd.PackSize;
end;

Function UnpRead(Addr : Pointer;Count : Word) : Integer;
Var
  RetCode  : Integer;
  Check    : Integer;
  ReadSize : Integer;
  ReadAddr : pByte;
  TotalRead : Word ;

begin
  totalRead := 0;
  RetCode := 0;
  ReadAddr := Addr;
  while (Count > 0) do
    begin
      If Count > UnpPackedSize then
        ReadSize := UnpPackedSize
      else
        ReadSize := Count;

      BlockRead( ArcFPtr, Addr^, ReadSize, Check );
      If ReadSize <> Check then
        begin
          RetCode := -1;
          Break;
        end;

      Inc( TotalRead, Check );
      Inc( ReadAddr, Check );
      Dec( Count, Check );
      Dec( UnpPackedSize, Check );
      if (UnpPackedSize  =  0 ) and UnpVolume then
        MergeArc(1)
      else
        break;
    end;

  if (RetCode<>-1) then
    RetCode := TotalRead;

  UnpRead := RetCode;
end;

Function UnpWrite(Addr : Pointer;Count : Word) : Integer;
Var
  RetCode  : Integer;
  Check    : Word;

begin
  RetCode := 0;
  if TestMode then
    RetCode := Count
  else
    begin
      BlockWrite( FileFPtr, Addr^, Count, Check );
      If Check <> Count then
        RetCode := -1
      else
        RetCode := Check;
    end;

  if RetCode <> -1 then
    UnpFileCRC := CRC(UnpFileCRC,Addr,RetCode);

  UnpWrite := RetCode;
end;

Procedure UnstoreFile;
Var
  Code : Integer;
begin
  while True do
    begin
      Code := UnpRead(TmpMemory,$7f00);
      If Code = -1 then
        ErrExit(EWRITE,WRITE_ERROR);

      if (Code = 0) then
        break;

      if (UnpWrite(TmpMemory,Code) = -1) then
        ErrExit(EWRITE,WRITE_ERROR);
    end
end;

Function strnicomp( Str1,Str2 : String; MaxLen : Integer ) : Boolean;
Var
  i : Integer;

begin
  i := 1;
  if MaxLen > 0 then
    while ( MaxLen > 0 ) do
    begin
      Dec( MaxLen );
      If UpCase( Str1[i] ) <> UpCase( Str2[i] ) then
        begin
          strnicomp := False;
          Exit;
        end;
      If i > Length( Str1 )  then
        begin
          strnicomp := True;
          Exit;
        end;
      Inc( i );
    end;
  strniComp := True;
end;

Function ToPercent(N1,N2 : Word) : Integer;
begin
  if (N1 > 10000) then
  begin
    N1 := N1 div 100;
    N2 := N2 div 100;
  end;
  if (N2 = 0) then
    ToPercent := 0
  else
    if (N2<N1) then
      ToPercent := 100
    else
      ToPercent := (N1*100) div N2;
end;

Procedure SplitCommandLine;
Var
  I,Len : Integer;
  Dir, Name, Ext : String;
  s  : String;

begin
  if (ParamCount = 1 ) then
    begin
      MainCommand := 'X';
      ArcName := ParamStr(1);
    end
  else
    for I := 1 to ParamCount do
      begin
        s := ParamStr(i);
        if (MainCommand = #0) then
          MainCommand := UpCase(s[1])
        else
          begin
            if ArcName = '' then
              ArcName := Copy( s, 1, 80 )
            else
              begin
                Len := Length( s );
                if ( Len>0 ) and
                   ((s[Len] = ':') or (s[Len] = '\') or (s[Len] = '/')) then
                  begin
                    ExtrPath := s;
                    ExtrPath[Len] := PATHDIV;
                  end
                else
                  begin
                    ArgNames[ArgCount and $f] := s;
                    Inc( ArgCount );
                  end;
              end
          end
      end;

  if (ArgCount = 0 ) and (ArcName <> '') then
    begin
      ArgNames[ArgCount and $f] := '*.*';
      Inc( ArgCount );
    end;

  FSplit( ArcName, Dir, Name, Ext );
  If Ext = '' then
    ArcName := ArcName + '.rar';
  ArgCount := ArgCount and $F;
end;

Function IsProcessFile(ComparePath : Word) : Boolean;
Var
  NumName       : Integer;
  WildCards     : Boolean;
  dir1, dir2    : PathStr;
  name1, name2  : NameStr;
  ext1, ext2    : ExtStr;

begin
  IsProcessFile := False;
  for NumName := 0 to ArgCount-1 do
    begin
      FSplit( ArgNames[NumName], Dir1, Name1, Ext1 );
      FSplit( ArcFileName, Dir2, Name2, Ext2 );
      WildCards := ( Pos('?',ArgNames[NumName]) <> 0 ) or
                   ( Pos('*',ArgNames[NumName]) <> 0 );
      If CmpName( Name1+Ext1, Name2+Ext2 ) and
         ( ( ( ComparePath = NOT_COMPARE_PATH ) and ( dir1 = '' ) ) or
           ( WildCards and strnicomp( dir1, dir2, length(dir1) ) or
             strnicomp( dir1, dir2, 1000 ) ) ) then
        IsProcessFile := True;
    end;
end;

Procedure Help;
begin
  WriteLn('Usage:     UNRAR <command> <archive> <files...>');
  WriteLn;
  WriteLn('<Commands>');
  WriteLn(' x       Extract files with full path');
  WriteLn(' e       Extract files to current directory');
  WriteLn(' t       Test archive files');
  WriteLn(' v       Verbosely list contents of archive');
  WriteLn(' l       List contents of archive');
  WriteLn;
end;

Function ExtractFile : Integer;
  Const
    FileCount       : Word = 0;
    TotalFileCount  : Word = 0;
    DirCount        : Word = 0;
    ErrCount        : Word = 0;
    ExtrFile        : Boolean = False;
    SkipSolid       : Boolean = False;
  Var
    Dir, Name, Ext : String;
    DestFileName  : String[80];
    Size          : Word;
    UnpSolid      : Boolean;

begin
  Assign( ArcFPtr, ArcName );
  FileMode := $40;
  {$I-}
  Reset( ArcFPtr, 1 );
  {$I+}
  If IOResult <> 0 then
    ErrExit(EOPEN,FATAL_ERROR);

  CheckArc;
  CreateEncTbl(TmpMemory);
  UnpVolume := False;
  UnpSolid := False;
  Writeln;
  if (MainCommand = 'T') then
    WriteLn(' Testing archive ',ArcName)
  else
    WriteLn(' Extracting from ',ArcName);

  while True do
    begin
      Size := ReadBlock(FILE_HEAD);

      if (Size<=0) and not UnpVolume then
        break;

      if ((Lhd.Flags AND LHD_SPLIT_BEFORE <> 0) and SolidType) then
        begin
          Writeln;
          Write('Solid archive: first volume required');
          ErrExit(EEMPTY,FATAL_ERROR);
        end;

      if (UnpVolume and (Size = 0)) then
        MergeArc(0);

      UnpVolume := (Lhd.Flags AND LHD_SPLIT_AFTER <> 0);
      seek( ArcFPtr, NextBlockPos-Lhd.PackSize );

      TestMode := False;
      ExtrFile := False;
      SkipSolid:= False;

      if IsProcessFile(COMPARE_PATH) and
         (Lhd.Flags AND LHD_SPLIT_BEFORE = 0)
          or ( SkipSolid <> SolidType ) then
      begin
        DestFileName := ExtrPath;
        fSplit( ArcFileName, Dir, Name, Ext );
        If MainCommand <> 'E' then
          DestFileName := DestFileName + ArcFileName
        else
          DestFileName := DestFileName + Name + Ext;
        If (Lhd.FileAttr AND DOSFA_DIREC <> 0) then
          DestFileName := DestFileName + PathDiv;

        ExtrFile := Not SkipSolid;

        if (Lhd.UnpVer<15) or (Lhd.UnpVer>UNP_VER) then
          begin
            Writeln;
            Write(' ',ArcFileName,': unknown method');
            ExtrFile := False;
            Inc( ErrCount );
            ExitCode := WARNING;
          end;

        if (Lhd.Flags AND LHD_PASSWORD <> 0) then
        begin
          Writeln;
          Write(' ',ArcFileName,': cannot process encrypted file');
          if (SolidType) then
            ErrExit(EEMPTY,FATAL_ERROR);
          ExtrFile := False;
          Inc( ErrCount );
          ExitCode := WARNING;
        end;

        if Lhd.FileAttr AND DOSFA_DIREC <> 0 then
          begin
            if (MainCommand = 'E') then
              continue;

            if (SkipSolid) then
            begin
              WriteLn;
              Write(' Skipping    ',ArcFileName,' Ok');
              continue;
            end;
            if (MainCommand = 'T') then
            begin
              WriteLn;
              Write(' Testing     ',ArcFileName,' Ok');
              continue;
            end;

            CreatePath(DestFileName);
            {$I-}
            MkDir(DestFileName);
            {$I-}
            If (IOResult = 0) then
              WriteLn(' Creating    ',ArcFileName);
            continue;
          end
        else
          begin
            if (MainCommand = 'T') and  ExtrFile then
              TestMode := True;

            if (MainCommand in ['E','X']) and ExtrFile then
              begin
                CreatePath(DestFileName);
                FileMode := 2;
                Assign( FileFPtr, DestFileName );
                {$I-}
                Rewrite( FileFPtr, 1 );
                {$I+}
                If ( IOResult <> 0 ) then
                begin
                  If (Lhd.FileAttr AND DOSFA_DIREC = 0) then
                    begin
                      Writeln;
                      Write(' Cannot create ',DestFileName);
                      ExitCode := WARNING;
                    end;
                  ExtrFile := False;
                end
              end
          end;

        if not ExtrFile and SolidType then
          begin
            SkipSolid := True;
            TestMode := True;
            ExtrFile := True;
          end;

        if ExtrFile then
          begin
            Inc( TotalFileCount );
            if SkipSolid then
              begin
                Writeln;
                Write(' Skipping    ',ArcFileName,' Ok');
              end
            else
              begin
                Inc( FileCount );
                Writeln;
                Case MainCommand of
                  'T':      Write(' Testing     ',ArcFileName);
                  'X', 'E': Write(' Extracting  ',DestFileName);
                end;
            end;

          CurExtrFile := DestFileName;
          UnpFileCRC := $FFFFFFFF;
          UnpPackedSize := Lhd.PackSize;
          DestUnpSize := Lhd.UnpSize;
          if (Lhd.Method = $30) then
            UnstoreFile
          else
            if (DoUnpack(TmpMemory,UnpRead,UnpWrite,UnpSolid) = -1) then
              ErrExit(EWRITE,WRITE_ERROR);
          if (TotalFileCount>0) and SolidType then
            UnpSolid := True;

          if (UnpFileCRC = not Lhd.FileCRC) then
            begin
              if MainCommand <> 'P' then
                Write(' Ok  ');
            end
          else
            begin
              seek( ArcFPtr, NextBlockPos );
              Writeln;
              WriteLn(' ',ArcFileName,' : CRC failed' );
              ExitCode := CRC_ERROR;
              Inc( ErrCount );
            end;

          if not TestMode then
            begin
              SetFTime(FileFPtr,Lhd.FileTime);
              close(FileFPtr);
            end;

          TestMode := False;
          CurExtrFile := '';
        end
      end;

      if not ExtrFile and not SolidType then
        seek( ArcFPtr, NextBlockPos );

    end;

  close(ArcFPtr);

  Writeln;
  if FileCount + DirCount = 0 then
    begin
      Write(' No files');
      ExitCode := WARNING;
    end
  else
    if (ErrCount = 0) then
      Write('  All OK')
    else
      Write('  Total errors: ',ErrCount);

  ExtractFile := 0;
end;

Procedure ListArchive;
Var
  TotalPackSize : Word;
  TotalUnpSize : Word;
  FileCount : Word;
  i : Word;
  Dir, Name, Ext : String;

begin
  TotalPackSize := 0;
  TotalUnpSize := 0;
  FileCount := 0;
  Assign( ArcFPtr, ArcName );
  {$I-}
  Reset( ArcFPtr, 1 );
  {$I+}
  If IOResult <> 0 then
    ErrExit(EOPEN,FATAL_ERROR);

  CheckArc;
  WriteLn;

  if SolidType then
    Write('Solid ');
  if (Mhd.Flags AND MHD_MULT_VOL <> 0) then
    Write(' Volume ')
  else
    Write(' Archive ');
  WriteLn( ArcName );

  if (MainCommand = 'V') then
    Write(' Pathname/Comment')
  else
    Write(' Name       ');
  WriteLn('      Size   Packed  Ratio   Date   Time  Attr   CRC-32  Meth Ver');

  for I :=0 to 76 do
    Write('-');

  while (ReadBlock(FILE_HEAD) > 0) do
    begin
      if (IsProcessFile(NOT_COMPARE_PATH)) then
        begin
          Writeln;
          If Lhd.Flags AND LHD_PASSWORD = 0 then
            Write( ' ' )
          else
            Write( '*' );

          if (MainCommand = 'V') then
          begin
            Writeln(ArcFileName);
          end
          else
            begin
              fSplit( ArcFileName, Dir, Name, Ext );
              Write( LeftJustify(name+Ext,12) );
            end;

          Write(Lhd.UnpSize:9,Lhd.PackSize:9,' ');
          if (Lhd.Flags AND (LHD_SPLIT_AFTER OR LHD_SPLIT_BEFORE) <> 0) then
            Write(' Split')
          else
            Write(ToPercent(Lhd.PackSize,Lhd.UnpSize):4,'% ');

          Write( ' ', ZStr( (LHd.FileTime shr 16) and $1f,2), '-',
                 ZStr( (LHd.FileTime shr 21) and $f, 2) ,'-',
                 ZStr( (LHd.FileTime shr 25+1980) mod 100, 2), ' ');
          Write( ZStr( (LHd.FileTime shr 11) and $1f, 2 ), ':',
                 ZStr( (LHd.FileTime shr 5) and $3f, 2 ),' ');

          if (Lhd.HostOS = MS_DOS) then
            begin
              If (Lhd.FileAttr AND DOSFA_DIREC <> 0) then
                write('D')
              else
                write('.');
              If (Lhd.FileAttr AND DOSFA_RDONLY <> 0) then
                write('R')
              else
                write('.');
              If (Lhd.FileAttr AND DOSFA_HIDDEN <> 0) then
                write('H')
              else
                write('.');
              If (Lhd.FileAttr AND DOSFA_SYSTEM <> 0) then
                write('S')
              else
                write('.');
              If (Lhd.FileAttr AND DOSFA_ARCH <> 0) then
                write('A')
              else
                write('.');
            end
          else
            Write('     ');

          Write( ' ',HexL( Lhd.FileCRC ) );
          Write( '  m', Lhd.Method-$30,'  ',Lhd.UnpVer div 10,'.',Lhd.UnpVer mod 10 );
          if (Lhd.Flags AND LHD_SPLIT_BEFORE = 0) then
          begin
            Inc( TotalUnpSize, Lhd.UnpSize );
            Inc( FileCount );
          end;
          Inc( TotalPackSize, Lhd.PackSize );
        end;
      Seek( ArcFPtr, NextBlockPos );
    end;

  WriteLn;
  for I := 0 to 76 do
    Write('-');

  Writeln;
  WriteLn(FileCount:5,' Files',TotalUnpSize:11,TotalPackSize:9,ToPercent(TotalPackSize,TotalUnpSize):5,'%');
  tclose(ArcFPtr);
end;


Procedure ExecuteCommand;
begin
  Case MainCommand of
    'E', 'X', 'T': ExtractFile;
    'V', 'L'     : ListArchive;
    #0           :
      begin
        Help;
        Halt(0);
      end;
  else
    begin
      Help;
      Halt(USER_ERROR);
    end
  end;
end;


begin
  {$IFDEF LINUX}
  FileSystem := fsDos;
  {$ENDIF}

  WriteLn('UNRAR 1.01 freeware portable version      (C) 1994-95 Eugene Roshal');
  WriteLn('Virtual Pascal v1 version               (C) 1995-2000 vpascal.com');

  GetMem( TmpMemory, Unp_Memory );
  If TmpMemory = nil then
    ErrExit(EMEMORY,MEMORY_ERROR);

  MakeTbl;
  SplitCommandLine;
  ExecuteCommand;
  ShutDown(SD_MEMORY);
  Halt(ExitCode);
end.

