idcompressionintercept.pas

Indy控件的使用源代码

procedure inflate_codes_free; external;
procedure _inflate_mask; external;
procedure inflate_flush; external;
procedure inflate_fast; external;

procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
begin
  FillChar(P^, count, B);
end;

procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
  Move(source^, dest^, count);
end;
{$ENDIF}

// deflate compresses data
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
  recsize: Integer): Integer;
{$IFDEF MSWINDOWS}
  external;
{$ENDIF}
{$IFDEF LINUX}
  cdecl; external zlib name 'deflateInit_';    {Do not Localize}
{$ENDIF}
function deflate(var strm: TZStreamRec; flush: Integer): Integer;
{$IFDEF MSWINDOWS}
  external;
{$ENDIF}
{$IFDEF LINUX}
  cdecl; external zlib name 'deflate';       {Do not Localize}
{$ENDIF}
function deflateEnd(var strm: TZStreamRec): Integer;
{$IFDEF MSWINDOWS}
  external;
{$ENDIF}
{$IFDEF LINUX}
  cdecl; external zlib name 'deflateEnd';   {Do not Localize}
{$ENDIF}

// inflate decompresses data
function inflateInit_(var strm: TZStreamRec; version: PChar;
  recsize: Integer): Integer;
{$IFDEF MSWINDOWS}
  external;
{$ENDIF}
{$IFDEF LINUX}
  cdecl; external zlib name 'inflateInit_';    {Do not Localize}
{$ENDIF}
function inflate(var strm: TZStreamRec; flush: Integer): Integer;
{$IFDEF MSWINDOWS}
  external;
{$ENDIF}
{$IFDEF LINUX}
  cdecl; external zlib name 'inflate';        {Do not Localize}
{$ENDIF}
function inflateEnd(var strm: TZStreamRec): Integer;
{$IFDEF MSWINDOWS}
  external;
{$ENDIF}
{$IFDEF LINUX}
  cdecl; external zlib name 'inflateEnd';     {Do not Localize}
{$ENDIF}
function inflateReset(var strm: TZStreamRec): Integer;
{$IFDEF MSWINDOWS}
  external;
{$ENDIF}
{$IFDEF LINUX}
  cdecl; external zlib name 'inflateReset';    {Do not Localize}
{$ENDIF}


function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer;
{$IFDEF MSWINDOWS}
  register;
{$ENDIF}
{$IFDEF LINUX}
  cdecl;
{$ENDIF}
begin
  Result := AllocMem(Items * Size);
end;

procedure zlibFreeMem(AppData, Block: Pointer);
{$IFDEF MSWINDOWS}
  register;
{$ENDIF}
{$IFDEF LINUX}
  cdecl;
{$ENDIF}
begin
  FreeMem(Block);
end;

{$ENDIF}

{ TIdCompressionIntercept }

procedure TIdCompressionIntercept.DeinitCompressors;
begin
  if Assigned(FCompressRec.zalloc) then
  begin
    deflateEnd(FCompressRec);
    FillChar(FCompressRec, SizeOf(FCompressRec), 0);
  end;
  if Assigned(FDecompressRec.zalloc) then
  begin
    inflateEnd(FDecompressRec);
    FillChar(FDecompressRec, SizeOf(FDecompressRec), 0);
  end;
end;

destructor TIdCompressionIntercept.Destroy;
begin
  DeinitCompressors;
  FreeMem(FRecvBuf);
  FreeMem(FSendBuf);
  inherited;
end;

procedure TIdCompressionIntercept.Disconnect;
begin
  inherited;
  DeinitCompressors;
end;

procedure TIdCompressionIntercept.InitCompressors;
begin
  if not Assigned(FCompressRec.zalloc) then
  begin
    FCompressRec.zalloc := zlibAllocMem;
    FCompressRec.zfree := zlibFreeMem;
    if deflateInit_(FCompressRec, FCompressionLevel, zlib_Version, SizeOf(FCompressRec)) <> Z_OK then
    begin
      raise EIdCompressorInitFailure.Create(RSZLCompressorInitializeFailure);
    end;
  end;
  if not Assigned(FDecompressRec.zalloc) then
  begin
    FDecompressRec.zalloc := zlibAllocMem;
    FDecompressRec.zfree := zlibFreeMem;
    if inflateInit_(FDecompressRec, zlib_Version, SizeOf(FDecompressRec)) <> Z_OK then
    begin
      raise EIdDecompressorInitFailure.Create(RSZLDecompressorInitializeFailure);
    end;
  end;
end;

procedure TIdCompressionIntercept.Receive(ABuffer: TStream);
var
  Buffer: array[0..2047] of Char;
  nChars, C: Integer;
  StreamEnd: Boolean;
begin
  if FCompressionLevel in [1..9] then
  begin
    InitCompressors;
    StreamEnd := False;
    repeat
      nChars := ABuffer.Read(Buffer, SizeOf(Buffer));
      if nChars = 0 then Break;
      FDecompressRec.next_in := Buffer;
      FDecompressRec.avail_in := nChars;
      FDecompressRec.total_in := 0;
      while FDecompressRec.avail_in > 0 do
      begin
        if FRecvCount = FRecvSize then
        begin
          if FRecvSize = 0 then
            FRecvSize := 2048
          else
            Inc(FRecvSize, 1024);
          ReallocMem(FRecvBuf, FRecvSize);
        end;
        FDecompressRec.next_out := PChar(FRecvBuf) + FRecvCount;
        C := FRecvSize - FRecvCount;
        FDecompressRec.avail_out := C;
        FDecompressRec.total_out := 0;
        case inflate(FDecompressRec, Z_NO_FLUSH) of
          Z_STREAM_END:
            StreamEnd := True;
          Z_STREAM_ERROR,
          Z_DATA_ERROR,
          Z_MEM_ERROR:
            raise EIdDecompressionError.Create(RSZLDecompressionError);
        end;
        Inc(FRecvCount, C - FDecompressRec.avail_out);
      end;
    until StreamEnd;
    ABuffer.Size := 0;
    ABuffer.Write(FRecvBuf^, FRecvCount);
    FRecvCount := 0;
  end;
end;

procedure TIdCompressionIntercept.Send(ABuffer: TStream);
var
  Buffer: array[0..1023] of Char;
begin
  if FCompressionLevel in [1..9] then
  begin
    InitCompressors;
    // Make sure the Send buffer is large enough to hold the input stream data
    if ABuffer.Size > FSendSize then
    begin
      if ABuffer.Size > 2048 then
        FSendSize := ABuffer.Size + (ABuffer.Size + 1023) mod 1024
      else
        FSendSize := 2048;
      ReallocMem(FSendBuf, FSendSize);
    end;
    // Get the data from the input stream and save it off
    FSendCount := ABuffer.Read(FSendBuf^, ABuffer.Size);
    FCompressRec.next_in := FSendBuf;
    FCompressRec.avail_in := FSendCount;
    // reset and clear the input stream in preparation for compression
    ABuffer.Size := 0;
    // As long as there is still data in the send buffer, keep compressing
    while FCompressRec.avail_in > 0 do
    begin
      FCompressRec.next_out := Buffer;
      FCompressRec.avail_out := SizeOf(Buffer);
      case deflate(FCompressRec, Z_SYNC_FLUSH) of
        Z_STREAM_ERROR,
        Z_DATA_ERROR,
        Z_MEM_ERROR: raise EIdCompressionError.Create(RSZLCompressionError);
      end;
      // Place the compressed data back into the input stream
      ABuffer.Write(Buffer, SizeOf(Buffer) - FCompressRec.avail_out);
    end;
  end;
end;

procedure TIdCompressionIntercept.SetCompressionLevel(Value: TCompressionLevel);
begin
  if Value <> FCompressionLevel then
  begin
    DeinitCompressors;
    if Value < 0 then Value := 0;
    if Value > 9 then Value := 9;
    FCompressionLevel := Value;
  end;
end;

{ TIdServerCompressionIntercept }

function TIdServerCompressionIntercept.Accept(AConnection: TComponent): TIdConnectionIntercept;
begin
  result := TIdCompressionIntercept.create(AConnection);
  (result as TIdCompressionIntercept).FCompressionLevel := FCompressionLevel;
end;

procedure TIdServerCompressionIntercept.Init;
begin
  // nothing
end;

end.