dxrdcompression.pas

Well known and usefull component for delphi 7

procedure TDXRDCompression.CompressString(const OriginalStr:string; var
   OutStr:string);
var
   compress_len:Integer;
   bytes_read:DWord;
   HashPtr:PWordArray;
   inputbuffer,
      outputbuffer:PByteArray;
   InStr:string;

begin
   InStr:=OriginalStr;
   OutStr:='';
   Getmem(HashPtr, HASH_SIZE);
   Fillchar2(hashPtr^, HASH_SIZE, #0);
   Getmem(inputbuffer, BUFF_LEN);
   Getmem(outputbuffer, BUFF_LEN);
   bytes_read:=BUFF_LEN;
   while bytes_read=BUFF_LEN do begin
      if Length(InStr)>BUFF_LEN then
         bytes_read:=BUFF_LEN
      else
         bytes_read:=Length(InStr);
      FastMove(inStr[1], inputbuffer^, bytes_read);
      Delete(inStr, 1, bytes_read);
      compress_len:=Compress(PByte(inputbuffer), bytes_read,
         PByte(outputbuffer), HashPtr);
      SetLength(OutStr, Length(OutStr)+2);
      FastMove(compress_len, OutStr[Length(OutStr)-1], 2);
      if compress_len<0 then compress_len:=0-compress_len;
      SetLength(OutStr, Length(OutStr)+compress_len);
      FastMove(outputbuffer^, OutStr[(Length(OutStr)-compress_len)+1],
         compress_len);
   end;
   compress_len:=0;
   SetLength(OutStr, Length(OutStr)+2);
   FastMove(compress_len, OutStr[Length(OutStr)-1], 2);
   Freemem(HashPtr, HASH_SIZE);
   Freemem(inputbuffer, BUFF_LEN);
   Freemem(outputbuffer, BUFF_LEN);
end;

type
   AccessProtected=class(TStream);

procedure TDXRDCompression.CompressStreams(inStream, OutStream:TStream);
var
   bytes_read,
      compress_len:Integer;
   HashPtr:PWordArray;
   inputbuffer,
      outputbuffer:PByteArray;

begin
   {$IFDEF VER90}
   if OutStream.Size>0 then begin
      // Size should have been zero coming in - Delphi2 requires this!
      Exit;
   end;
   {$ELSE}
   OutStream.Size:=0;
   {$ENDIF}
   inStream.Seek(0, 0);
   Getmem(HashPtr, HASH_SIZE);
   Fillchar2(hashPtr^, HASH_SIZE, #0);
   Getmem(inputbuffer, BUFF_LEN);
   Getmem(outputbuffer, BUFF_LEN);
   bytes_read:=BUFF_LEN;
   while bytes_read=BUFF_LEN do begin
      if inStream.Size-inStream.Position>=BUFF_LEN then
         bytes_read:=BUFF_LEN
      else
         bytes_read:=inStream.Size-inStream.Position;
      inStream.Read(inputbuffer^, bytes_read);
      compress_len:=Compress(PByte(inputbuffer), bytes_read,
         PByte(outputbuffer), HashPtr);
      OutStream.Write(compress_len, 2);
      if compress_len<0 then compress_len:=0-compress_len;
      OutStream.Write(outputbuffer^, compress_len);
   end;
   compress_len:=0;
   OutStream.Write(compress_len, 2);
   Freemem(HashPtr, HASH_SIZE);
   Freemem(inputbuffer, BUFF_LEN);
   Freemem(outputbuffer, BUFF_LEN);
end;

procedure TDXRDCompression.DecompressBorlandFileToFile(var infile,
   outfile:file);
var
   block_len:SmallInt;
   code,
      decomp_len:Integer;
   inputbuffer,
      outputbuffer:PByteArray;

begin
   Getmem(inputbuffer, BUFF_LEN);
   Getmem(outputbuffer, BUFF_LEN);
   block_len:=1;
   while block_len<>0 do begin
      Blockread(infile, block_len, 2, code);
      if Code<>2 then begin
         if Assigned(fOnBlockLengthError) then
            fOnBlockLengthError(nil);
         Freemem(inputbuffer, BUFF_LEN);
         Freemem(outputbuffer, BUFF_LEN);
         Exit;
      end;
      if block_len<>0 then begin
         if (block_len<0) then begin
            decomp_len:=0-block_len;
            Blockread(infile, outputbuffer^, decomp_len, code);
            if Code<>decomp_len then begin
               if Assigned(fOnDataUnderrun) then
                  fOnDataUnderrun(nil);
               Freemem(inputbuffer, BUFF_LEN);
               Freemem(outputbuffer, BUFF_LEN);
               Exit;
            end;
         end
         else begin
            Blockread(infile, inputbuffer^, block_len, code);
            if Code<>block_len then begin
               if Assigned(fOnDataUnderrun) then
                  fOnDataUnderrun(nil);
               Freemem(inputbuffer, BUFF_LEN);
               Freemem(outputbuffer, BUFF_LEN);
               Exit;
            end;
            decomp_len:=Decompress(PByte(inputbuffer), block_len,
               PByte(outputbuffer));
         end;
         Blockwrite(outfile, outputbuffer^, decomp_len, code);
         if Code<>decomp_len then begin
            if Assigned(fOnDataUnderrun) then
               fOnDataUnderrun(nil);
            Freemem(inputbuffer, BUFF_LEN);
            Freemem(outputbuffer, BUFF_LEN);
            Exit;
         end;
      end;
   end;
   Freemem(inputbuffer, BUFF_LEN);
   Freemem(outputbuffer, BUFF_LEN);
end;

procedure TDXRDCompression.DecompressWindowsFileToFile(var infile,
   outfile:Integer);
var
   block_len:SmallInt;
   code:Integer;
   decomp_len:Integer;
   inputbuffer,
      outputbuffer:PByteArray;

begin
   Getmem(inputbuffer, BUFF_LEN);
   Getmem(outputbuffer, BUFF_LEN);
   block_len:=1;
   while block_len<>0 do begin
      code:=FileRead(infile, block_len, 2);
      if Code<>2 then begin
         if Assigned(fOnBlockLengthError) then
            fOnBlockLengthError(nil);
         Freemem(inputbuffer, BUFF_LEN);
         Freemem(outputbuffer, BUFF_LEN);
         Exit;
      end;
      if block_len<>0 then begin
         if (block_len<0) then begin
            decomp_len:=0-block_len;
            code:=FileRead(infile, outputbuffer^, decomp_len);
            if Code<>decomp_len then begin
               if Assigned(fOnDataUnderrun) then
                  fOnDataUnderrun(nil);
               Freemem(inputbuffer, BUFF_LEN);
               Freemem(outputbuffer, BUFF_LEN);
               Exit;
            end;
         end
         else begin
            code:=FileRead(infile, inputbuffer^, block_len);
            if Code<>block_len then begin
               if Assigned(fOnDataUnderrun) then
                  fOnDataUnderrun(nil);
               Freemem(inputbuffer, BUFF_LEN);
               Freemem(outputbuffer, BUFF_LEN);
               Exit;
            end;
            decomp_len:=Decompress(PByte(inputbuffer), block_len,
               PByte(outputbuffer));
         end;
         code:=FileWrite(outfile, outputbuffer^, decomp_len);
         if Code<>decomp_len then begin
            if Assigned(fOnDataUnderrun) then
               fOnDataUnderrun(nil);
            Freemem(inputbuffer, BUFF_LEN);
            Freemem(outputbuffer, BUFF_LEN);
            Exit;
         end;
      end;
   end;
   Freemem(inputbuffer, BUFF_LEN);
   Freemem(outputbuffer, BUFF_LEN);
end;

procedure TDXRDCompression.DecompressString(const OriginalStr:string; var
   OutStr:string);
var
   block_len:SmallInt;
   code,
      decomp_len:Integer;
   outputbuffer,
      inputbuffer:PByteArray;
   InStr:string;

begin
   inStr:=OriginalStr;
   Getmem(inputbuffer, BUFF_LEN);
   Getmem(outputbuffer, BUFF_LEN);
   OutStr:='';
   block_len:=1;
   while block_len<>0 do begin
      if Length(inStr)>=2 then begin
         FastMove(inStr[1], block_len, 2);
         Code:=2;
         Delete(inStr, 1, 2);
      end
      else begin
         Code:=0;
         block_len:=0;
      end;
      if Code<>2 then begin
         if Assigned(fOnBlockLengthError) then
            fOnBlockLengthError(nil);
         Freemem(inputbuffer, BUFF_LEN);
         Freemem(outputbuffer, BUFF_LEN);
         Exit;
      end;
      if block_len<>0 then begin
         if (block_len<0) then begin
            decomp_len:=0-block_len;
            if Length(inStr)>=decomp_len then begin
               OutStr:=OutStr+Copy(InStr, 1, decomp_len);
               Code:=decomp_len;
               Delete(inStr, 1, decomp_len);
            end
            else
               Code:=decomp_len-1;
            if Code<>decomp_len then begin
               if Assigned(fOnDataUnderrun) then
                  fOnDataUnderrun(nil);
               Freemem(inputbuffer, BUFF_LEN);
               Freemem(outputbuffer, BUFF_LEN);
               Exit;
            end;
         end
         else begin
            if Length(inStr)>=block_len then begin
               FastMove(inStr[1], inputbuffer^, block_len);
               Code:=block_len;
               Delete(inStr, 1, block_len);
            end
            else
               Code:=1-block_len;
            if Code<>block_len then begin
               if Assigned(fOnDataUnderrun) then
                  fOnDataUnderrun(nil);
               Freemem(inputbuffer, BUFF_LEN);
               Freemem(outputbuffer, BUFF_LEN);
               Exit;
            end;
            decomp_len:=Decompress(PByte(inputbuffer), block_len,
               PByte(outputbuffer));
            Code:=decomp_len;
            SetLength(Outstr, Length(OutStr)+decomp_len);
            FastMove(outputbuffer^, OutStr[(Length(OutStr)-decomp_len)+1],
               decomp_len);
         end;
         if Code<>decomp_len then begin
            if Assigned(fOnDataUnderrun) then
               fOnDataUnderrun(nil);
            Freemem(inputbuffer, BUFF_LEN);
            Freemem(outputbuffer, BUFF_LEN);
            Exit;
         end;
      end;
   end;
   Freemem(inputbuffer, BUFF_LEN);
   Freemem(outputbuffer, BUFF_LEN);
end;

procedure TDXRDCompression.DecompressStreams(inStream, OutStream:TStream);
var
   block_len:SmallInt;
   code:Integer;
   decomp_len:Integer;
   inputbuffer,
      outputbuffer:PByteArray;

begin
   {$IFDEF VER90}
   if OutStream.Size>0 then begin
      // Size should have been zero coming in - Delphi2 requires this!
      Exit;
   end;
   {$ELSE}
   OutStream.Size:=0;
   {$ENDIF}
   inStream.Seek(0, 0);
   Getmem(inputbuffer, BUFF_LEN);
   Getmem(outputbuffer, BUFF_LEN);
   block_len:=1;
   while block_len<>0 do begin
      if inStream.Size-inStream.Position>=2 then begin
         inStream.Read(block_len, 2);
         Code:=2;
      end
      else
         Code:=0;
      if Code<>2 then begin
         if Assigned(fOnBlockLengthError) then
            fOnBlockLengthError(nil);
         Freemem(inputbuffer, BUFF_LEN);
         Freemem(outputbuffer, BUFF_LEN);
         Exit;
      end;
      if block_len<>0 then begin
         if (block_len<0) then begin
            decomp_len:=0-block_len;
            if inStream.Size-inStream.Position>=decomp_len then begin
               Code:=decomp_len;
               inStream.Read(outputbuffer^, decomp_len);
            end
            else
               Code:=decomp_len-1;
            if Code<>decomp_len then begin
               if Assigned(fOnDataUnderrun) then
                  fOnDataUnderrun(nil);
               Freemem(inputbuffer, BUFF_LEN);
               Freemem(outputbuffer, BUFF_LEN);
               Exit;
            end;
         end
         else begin
            decomp_len:=block_len;
            if inStream.Size-inStream.Position>=block_len then begin
               Code:=block_len;
               inStream.Read(inputbuffer^, decomp_len);
            end
            else
               Code:=block_len-1;
            if Code<>block_len then begin
               if Assigned(fOnDataUnderrun) then
                  fOnDataUnderrun(nil);
               Freemem(inputbuffer, BUFF_LEN);
               Freemem(outputbuffer, BUFF_LEN);
               Exit;
            end;
            decomp_len:=Decompress(PByte(inputbuffer), block_len,
               PByte(outputbuffer));
         end;
         OutStream.Write(outputbuffer^, decomp_len);
      end;
   end;
   Freemem(inputbuffer, BUFF_LEN);
   Freemem(outputbuffer, BUFF_LEN);
end;

end.