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

    Program LZHTest;
    Uses
      LZH;

    Const
      MaxBuf = 4096;                       { Must be bigger than the biggest chunk being asked For. }

    Type
      BufType = Array[1..MaxBuf] of Byte;
      BufPtr = ^BufType;

    Var
      InBuf, OutBuf : BufPtr;
      inFile, OutFile : File;
      s : String;
      Bytes_Written : LongInt;
      Size : LongInt;
      Temp : Word;

      {$F+}
      Procedure GetBlock(Var Target; NoBytes : Word; Var Actual_Bytes : Word);
      Const
        Posn : Word = 1;
        Buf : Word = 0;
      Var
        Temp : Word;
      begin
        if (Posn > Buf) or (Posn + NoBytes > succ(Buf)) then
          begin
            if Posn > Buf then
              begin
                blockread(inFile, InBuf^, MaxBuf, Buf);
                Write('+');
              end
            else
              begin
                move(InBuf^[Posn], InBuf^[1], Buf - Posn);
                blockread(inFile, InBuf^[Buf - Posn], MaxBuf - (Buf - Posn), Temp);
                Buf := Buf - Posn + Temp;
                Write('+');
              end;
            if Buf = 0 then
              begin
                Actual_Bytes := 0;
                Writeln;
                Exit;
              end;
            Posn := 1;
          end;
        move(InBuf^[Posn], Target, NoBytes);
        inc(Posn, NoBytes);
        if Posn > succ(Buf) then
          Actual_Bytes := NoBytes - (Posn - succ(Buf))
        else Actual_Bytes := NoBytes;
      end;

      Procedure PutBlock(Var Source; NoBytes : Word; Var Actual_Bytes : Word);
      Const
        Posn : Word = 1;
      Var
        Temp : Word;
      begin
        if NoBytes = 0 then                { Flush condition }
          begin
            blockWrite(OutFile, OutBuf^, pred(Posn), Temp);
            Exit;
          end;
        if (Posn > MaxBuf) or (Posn + NoBytes > succ(MaxBuf)) then
          begin
            blockWrite(OutFile, OutBuf^, pred(Posn), Temp);
            Posn := 1;
          end;
        move(Source, OutBuf^[Posn], NoBytes);
        inc(Posn, NoBytes);
        Actual_Bytes := NoBytes;
      end;

      {$F-}

    begin
      if (paramcount <> 3) then
        begin
          Writeln('Usage:lzhuf e(Compression)|d(unCompression) inFile outFile');
          halt(1);
        end;
      s := paramstr(1);
      if not(s[1] in ['D', 'E', 'd', 'e']) then
        halt(1);
      assign(inFile, paramstr(2));
      reset(inFile, 1);
      assign(OutFile, paramstr(3));
      reWrite(OutFile, 1);
      new(InBuf);
      new(OutBuf);
      if (upCase(s[1]) = 'E') then
        begin
          Size := Filesize(inFile);
          blockWrite(OutFile, Size, sizeof(LongInt));
          LZHPack(Bytes_Written, GetBlock, PutBlock);
          PutBlock(Size, 0, Temp);
        end
      else
        begin
          blockread(inFile, Size, sizeof(LongInt));
          LZHUnPack(Size, GetBlock, PutBlock);
          PutBlock(Size, 0, Temp);
        end;
      dispose(OutBuf);
      dispose(InBuf);
      close(inFile);
      close(OutFile);
    end.

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