Xentax forum attachments archive/xentax.7z/12746/UnHSQ.7z/unhsq.dpr

Text File | 2017-04-05 | 10.1 KB | 449 lines

program unhsq;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows,
  Classes;

var
  M, O: TMemoryStream;
  Header: Array[0..5] of Byte;
  Bits: Word;
  BitsCnt: Byte;
  DecCnt, DecOff: SmallInt;
  DecPos: Integer;

function GetBit(): Byte;
begin
  if BitsCnt = 0 then
  begin
    M.ReadBuffer(Bits, 2);
    BitsCnt := 16;
  end;
  Result := Bits and 1;
  Bits := Bits shr 1;
  Dec(BitsCnt);
end;

function SetMask: Word;
var
  I: Integer;
  U, L: Word;
begin
  U := Word(not 0);
  L := U;
  for I := 1 to Header[5] do
  begin
    U := U shr 1;
    L := L shl 1;
  end;
  Result := (not U) or (not L);
end;

function IsHSQ: Boolean;
var
  Chk: Byte;
  I: Integer;
begin
  // Header[0] - word DecompSize
  // Header[1]
  // Header[2] - byte Null = 0
  // Header[3] - word CompSize
  // Header[4]
  // Header[5] - byte Checksum
  Result := False;
  if Header[2] > 0 then
  begin
    //Writeln('Wrong check byte.');
    Exit;
  end;
  if PWord(@Header[3])^ <> M.Size then
  begin
    //Writeln('Wrong compressed size.');
    Exit;
  end;
  Chk := 0;
  for I := 0 to 6 - 1 do
    Chk := (Chk + Header[I]) and $FF;
  if Chk <> $AB then
  begin
    //Writeln('Wrong checksum.');
    Exit;
  end;
  Result := True;
end;

function IsSQX: Boolean;
begin
  // Header[0] - word OutbufInit
  // Header[1]
  // Header[2] - byte SQX flag #1
  // Header[3] - byte SQX flag #2
  // Header[4] - byte SQX flag #3
  // Header[5] - byte CntOffPart
  Result := False;
  if Header[2] > 2 then
  begin
    //Writeln('Wrong SQX flag #1.');
    Exit;
  end;
  if Header[3] > 2 then
  begin
    //Writeln('Wrong SQX flag #2.');
    Exit;
  end;
  if Header[3] > 2 then
  begin
    //Writeln('Wrong SQX flag #3.');
    Exit;
  end;
  if (Header[5] = 0)
  or (Header[5] > 15) then
  begin
    //Writeln('Wrong bit count.');
    Exit;
  end;
  Result := True;
end;

procedure DecHSQ;
var
  B: Byte;
  I: Integer;
begin
  BitsCnt := 0;
  DecCnt := 0;
  while O.Size < PWord(@Header[0])^ do
  begin
    if GetBit() > 0 then
    begin
      M.ReadBuffer(B, 1);
      O.WriteBuffer(B, 1);
    end
    else
    begin
      if GetBit() > 0 then
      begin
        M.ReadBuffer(DecCnt, 2);
        DecOff := (Word(DecCnt) shr 3) - 8192;
        DecCnt := Word(DecCnt) and 7;
        if DecCnt = 0 then
          M.ReadBuffer(DecCnt, 1);
        if DecCnt = 0 then
          Break;
      end
      else
      begin
        DecCnt := GetBit() * 2 + GetBit();
        M.ReadBuffer(B, 1);
        DecOff := B - 256;
      end;
      DecCnt := DecCnt + 2;
      DecPos := O.Position;
      for I := 0 to DecCnt - 1 do
      begin
        O.Position := DecPos + DecOff + I;
        if O.Position >= 0 then
        begin
          O.ReadBuffer(B, 1);
          O.Position := O.Size;
          O.WriteBuffer(B, 1);
        end;
      end;
    end;
  end;
end;

procedure DecSQX;
var
  Mask: Word;
  Chk, ChkS, B: Byte;

  procedure CopyOutStr(DecOff, DecCnt: SmallInt);
  var
    DecPos, OutPos, I: Integer;
    B: Byte;
  begin
    DecCnt := DecCnt + 2;
    DecPos := O.Position;
    OutPos := DecPos;
    for I := 0 to DecCnt - 1 do
    begin
      O.Position := DecPos + DecOff + I;
      if O.Position >= 0 then
      begin
        O.ReadBuffer(B, 1);
        O.Position := OutPos;
        O.WriteBuffer(B, 1);
        OutPos := O.Position;
      end;
    end;
  end;
begin
  // SQX flags: 0, 1, 2
  O.SetSize(65528);
  FillChar(O.Memory^, O.Size, 0);
  O.WriteBuffer(PWord(@Header[0])^, 2);
  O.Seek(0, soFromBeginning);
  Mask := SetMask;
  Bits := 1;
  while True do
  begin
    Chk := Bits and 1;
    Bits := Bits shr 1;
    if Bits = 0 then
    begin
      ChkS := Chk;
      M.ReadBuffer(Bits, 2);
      Chk := Bits and 1;
      Bits := Bits shr 1;
      if ChkS <> 0 then
        Bits := Bits or $8000;
    end;
    if (Chk = 0) then
      case Header[2] of
        0:
        begin
          M.ReadBuffer(B, 1);
          O.WriteBuffer(B, 1);
          Continue;
        end;
        1:
        begin
          DecCnt := 0;
          Chk := Bits and 1;
          Bits := Bits shr 1;
          if Bits = 0 then
          begin
            M.ReadBuffer(Bits, 2);
            ChkS := Chk;
            Chk := Bits and 1;
            Bits := Bits shr 1;
            if ChkS <> 0 then
              Bits := Bits or $8000;
            DecCnt := Chk;
            Chk := Bits and 1;
            Bits := Bits shr 1;
          end
          else
          begin
            DecCnt := Chk;
            Chk := Bits and 1;
            Bits := Bits shr 1;
            if Bits = 0 then
            begin
              M.ReadBuffer(Bits, 2);
              ChkS := Chk;
              Chk := Bits and 1;
              Bits := Bits shr 1;
              if ChkS <> 0 then
                Bits := Bits or $8000;
            end;
          end;
          DecCnt := (DecCnt shl 1) + Chk;
          M.ReadBuffer(B, 1);
          DecOff := B - 256;
          CopyOutStr(DecOff, DecCnt);
          Continue;
        end;
        2:
        begin
          M.ReadBuffer(DecCnt, 2);
          DecOff := (DecCnt shr Header[5]) or (Mask and $FF00);
          DecCnt := DecCnt and Lo(Mask);
          if DecCnt = 0 then
          begin
            M.ReadBuffer(B, 1);
            DecCnt := B;
            if DecCnt = 0 then
              Break;
          end;
          CopyOutStr(DecOff, DecCnt);
          Continue;
        end;
      end
    else
    begin
      Chk := Bits and 1;
      Bits := Bits shr 1;
      if Bits = 0 then
      begin
        M.ReadBuffer(Bits, 2);
        ChkS := Chk;
        Chk := Bits and 1;
        Bits := Bits shr 1;
        if ChkS <> 0 then
          Bits := Bits or $8000;
      end;
      if (Chk = 0) then
        case Header[3] of
          0:
          begin
            M.ReadBuffer(B, 1);
            O.WriteBuffer(B, 1);
            Continue;
          end;
          1:
          begin
            DecCnt := 0;
            Chk := Bits and 1;
            Bits := Bits shr 1;
            if Bits = 0 then
            begin
              M.ReadBuffer(Bits, 2);
              ChkS := Chk;
              Chk := Bits and 1;
              Bits := Bits shr 1;
              if ChkS <> 0 then
                Bits := Bits or $8000;
              DecCnt := Chk;
              Chk := Bits and 1;
              Bits := Bits shr 1;
            end
            else
            begin
              DecCnt := Chk;
              Chk := Bits and 1;
              Bits := Bits shr 1;
              if Bits = 0 then
              begin
                M.ReadBuffer(Bits, 2);
                ChkS := Chk;
                Chk := Bits and 1;
                Bits := Bits shr 1;
                if ChkS <> 0 then
                  Bits := Bits or $8000;
              end;
            end;
            DecCnt := (DecCnt shl 1) + Chk;
            M.ReadBuffer(B, 1);
            DecOff := B - 256;
            CopyOutStr(DecOff, DecCnt);
            Continue;
          end;
          2:
          begin
            M.ReadBuffer(DecCnt, 2);
            DecOff := (DecCnt shr Header[5]) or (Mask and $FF00);
            DecCnt := DecCnt and Lo(Mask);
            if DecCnt = 0 then
            begin
              M.ReadBuffer(B, 1);
              DecCnt := B;
              if DecCnt = 0 then
                Break;
            end;
            CopyOutStr(DecOff, DecCnt);
            Continue;
          end;
        end
      else
        case Header[4] of
          0:
          begin
            M.ReadBuffer(B, 1);
            O.WriteBuffer(B, 1);
            Continue;
          end;
          1:
          begin
            DecCnt := 0;
            Chk := Bits and 1;
            Bits := Bits shr 1;
            if Bits = 0 then
            begin
              M.ReadBuffer(Bits, 2);
              ChkS := Chk;
              Chk := Bits and 1;
              Bits := Bits shr 1;
              if ChkS <> 0 then
                Bits := Bits or $8000;
              DecCnt := Chk;
              Chk := Bits and 1;
              Bits := Bits shr 1;
            end
            else
            begin
              DecCnt := Chk;
              Chk := Bits and 1;
              Bits := Bits shr 1;
              if Bits = 0 then
              begin
                M.ReadBuffer(Bits, 2);
                ChkS := Chk;
                Chk := Bits and 1;
                Bits := Bits shr 1;
                if ChkS <> 0 then
                  Bits := Bits or $8000;
              end;
            end;
            DecCnt := (DecCnt shl 1) + Chk;
            M.ReadBuffer(B, 1);
            DecOff := B - 256;
            CopyOutStr(DecOff, DecCnt);
            Continue;
          end;
          2:
          begin
            M.ReadBuffer(DecCnt, 2);
            DecOff := (DecCnt shr Header[5]) or (Mask and $FF00);
            DecCnt := DecCnt and Lo(Mask);
            if DecCnt = 0 then
            begin
              M.ReadBuffer(B, 1);
              DecCnt := B;
              if DecCnt = 0 then
                Break;
            end;
            CopyOutStr(DecOff, DecCnt);
            Continue;
          end;
        end;
    end;
  end;
  O.SetSize(O.Position);
end;

begin
  try
    { TODO -oUser -cConsole Main : Insert code here }

  M := TMemoryStream.Create;
  M.LoadFromFile(ParamStr(1));
  if M.Size < 6 then
  begin
    Writeln('File too small.');
    M.Free;
    Exit;
  end;
  M.ReadBuffer(Header, 6);
  O := TMemoryStream.Create;
  if IsHSQ then
  begin
    Writeln('File HSQ compressed.');
    DecHSQ;
    Writeln('Decompression done.');
  end else
  if IsSQX then
  begin
    Writeln('File SQX compressed.');
    DecSQX;
    Writeln('Decompression done.');
  end else
  begin
    Writeln('File is uncompressed.');
    Exit;
  end;

  M.Free;
  O.SaveToFile(ChangeFileExt(ParamStr(1), '.raw'));
  O.Free;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.