ICS has OverbyteIcsZlibHigh with versions of many of the Zlib functions,
although only ZlibCompressStreamEx, not ZcompressStream2, but they are
probably similar.
Do you have the time to update the V7 server component (from the nightly
SVN zip) to use the existing ICS Zlib units? They are used in the FTP
client and server, and the HTTP client.
I'm not working with v7, but here I leave a diff file. Not sufficiently
tested , so let me know if you find something not working properly.
Functionality is controlled by the SUPPORT_CONTENT_ENCODING and USE_ZLIB
defines.
If SUPPORT_CONTENT_ENCODING defined, a new OnStreamContentEncode event
is present, to enable user to apply custom encodings, or, in my case, to
use a different zlib library.
All the action is done in the THttpConnection.AnswerStream procedure. If
OnStreamContentEncode not assigned, or if encoding not handled by the
event, and USE_ZLIB defined, an internal deflate or gzip encode is applied.
I think the internal code can be further enhanced to take into account
the content type, and/or stream size.
I also don't know if replacing the FDocStream by the TMemoryStream
encoded one, can break some existing code that relies on initially
assigned FDocStream object.
------------------------------------------------------------------------
--- C:/Temp/ICSSVN/branches/icsv7/Delphi/Vc32/-OverbyteIcsHttpSrv.pas
dom Jun 14 00:01:54 2009
+++ C:/Temp/ICSSVN/branches/icsv7/Delphi/Vc32/OverbyteIcsHttpSrv.pas
dom Jun 14 00:22:36 2009
@@ -297,8 +297,13 @@
{$IFDEF UseInt64ForHttpRange} // just for backwards compatibility
{$DEFINE STREAM64}
{$ENDIF}
-{ DEFINE USE_ZLIB} { Experimental code, doesn't work yet }
+{$DEFINE SUPPORT_CONTENT_ENCODING}
+
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+{$DEFINE USE_ZLIB}
+{$ENDIF}
+
{$IFNDEF NO_AUTHENTICATION_SUPPORT}
{$DEFINE USE_NTLM_AUTH}
{$ELSE}
@@ -329,9 +334,11 @@
{$IFDEF USE_SSL}
OverbyteIcsSSLEAY, OverbyteIcsLIBEAY,
{$ENDIF}
+{$IFDEF SUPPORT_CONTENT_ENCODING}
{$IFDEF USE_ZLIB}
- dZLib, zDeflate, ZLibh,
+ OverByteIcsZlibHigh, OverByteIcsZLibObj,
{$ENDIF}
+{$ENDIF}
{$IFNDEF NO_DEBUG_LOG}
OverbyteIcsLogger,
{$ENDIF}
@@ -397,6 +404,14 @@
THttpAfterAnswerEvent= procedure (Sender : TObject;
Client : TObject) of
object; { V7.19 }
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+ TStreamContentEncodeEvent= procedure (Sender : TObject;
+ Client : TObject;
+ var Stream:TStream;
+ ContentType:String;
+ out ContentEncoding:string;
+ var Handled:Boolean) of object;
+{$ENDIF}
THttpConnectionState = (hcRequest, hcHeader, hcPostedData);
THttpOption = (hoAllowDirList, hoAllowOutsideRoot);
THttpOptions = set of THttpOption;
@@ -578,13 +593,6 @@
FRequestHostPort : String; {DAVID}
FRequestConnection : String;
FAcceptPostedData : Boolean;
-{$IFDEF USE_ZLIB}
- FReplyDeflate : Boolean;
- FCompressStream : TCompressionStream;
- FDecompressStream : TDecompressionStream;
- FZDocStream : TMemoryStream;
- FZBuffer : array [0..8191] of Char;
-{$ENDIF}
FServer : THttpServer;
FAuthRealm : String;
FOptions : THttpOptions;
@@ -609,6 +617,9 @@
FOnGetRowData : THttpGetRowDataEvent;
FOnBeforeAnswer : TNotifyEvent; { V7.19 }
FOnAfterAnswer : TNotifyEvent; { V7.19 }
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+ FOnStreamContentEncode:TStreamContentEncodeEvent;
+{$ENDIF}
procedure SetSndBlkSize(const Value: Integer);
procedure ConnectionDataAvailable(Sender: TObject; Error :
Word); virtual;
procedure ConnectionDataSent(Sender : TObject; Error : WORD);
virtual;
@@ -822,6 +833,12 @@
{ Triggered after the answer is sent from ConnectionDataSent
V7.19 }
property OnAfterAnswer : TNotifyEvent read FOnAfterAnswer
write FOnAfterAnswer;
+
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+ property OnStreamContentEncode: TStreamContentEncodeEvent
+ read
FOnStreamContentEncode
+ write
FOnStreamContentEncode;
+{$ENDIF}
{$IFNDEF NO_AUTHENTICATION_SUPPORT}
{ AuthType contains the actual authentication method selected
by client }
property AuthType : TAuthenticationType
@@ -884,6 +901,9 @@
FHeartBeatBusy : Boolean;
FOnBeforeAnswer : THttpBeforeAnswerEvent; { V7.19 }
FOnAfterAnswer : THttpAfterAnswerEvent; { V7.19 }
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+ FOnStreamContentEncode:TStreamContentEncodeEvent;
+{$ENDIF}
{$IFNDEF NO_AUTHENTICATION_SUPPORT}
FAuthTypes : TAuthenticationTypes;
FAuthRealm : String;
@@ -1066,6 +1086,11 @@
property OnAfterAnswer : THttpAfterAnswerEvent
read FOnAfterAnswer
write FOnAfterAnswer;
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+ property OnStreamContentEncode: TStreamContentEncodeEvent
+ read
FOnStreamContentEncode
+ write
FOnStreamContentEncode;
+{$ENDIF}
{$IFNDEF NO_AUTHENTICATION_SUPPORT}
property OnAuthGetPassword : TAuthGetPasswordEvent
read FOnAuthGetPassword
@@ -1746,6 +1771,9 @@
THttpConnection(Client).MaxRequestsKeepAlive :=
Self.MaxRequestsKeepAlive;
THttpConnection(Client).OnBeforeAnswer := TriggerBeforeAnswer;
{ V7.19 }
THttpConnection(Client).OnAfterAnswer := TriggerAfterAnswer;
{ V7.19 }
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+ THttpConnection(Client).OnStreamContentEncode :=
fOnStreamContentEncode;
+{$ENDIF}
TriggerClientConnect(Client, Error);
end;
@@ -2496,38 +2524,20 @@
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * *}
-{$IFDEF USE_ZLIB}
-function zlibAllocMem(AppData: Pointer; Items, Size: Cardinal): Pointer;
-begin
- GetMem(Result, Items*Size);
-end;
-
-
-{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * *}
-procedure zlibFreeMem(AppData, Block: Pointer);
-begin
- FreeMem(Block);
-end;
-
-function CCheck(code: Integer): Integer;
-begin
- Result := code;
- if code < 0 then
- raise ECompressionError.Create('error'); {!!}
-end;
-{$ENDIF}
-
-
-{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * *}
procedure THttpConnection.AnswerStream(
var Flags : THttpGetFlag;
const Status : String; { if empty, default to '200 OK' }
const ContType : String; { if emtpy, default to text/html }
const Header : String); { Do not use Content-Length }
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+var
+ ContentEncoding:String;
+ CompressionHandled:Boolean;
{$IFDEF USE_ZLIB}
-var
- Count : Integer;
+ ZDocStream: TMemoryStream;
+ ZStreamType: TZStreamType;
{$ENDIF}
+{$ENDIF}
begin
Flags := hgWillSendMySelf;
if Status = '' then begin
@@ -2557,39 +2567,32 @@
if not Assigned(FDocStream) then
PutStringInSendBuffer('Content-Length: 0' + #13#10)
else begin
+{$IFDEF SUPPORT_CONTENT_ENCODING}
+ CompressionHandled:=false;
+ if assigned(FOnStreamContentEncode) then
+ FOnStreamContentEncode(self , self , FDocStream , ContType ,
ContentEncoding , CompressionHandled);
+ if CompressionHandled then
+ PutStringInSendBuffer('Content-Encoding: ' + ContentEncoding +
#13#10)
+ else begin
{$IFDEF USE_ZLIB}
- FReplyDeflate := (Pos('deflate', FRequestAcceptEncoding) > 0);
- if FReplyDeflate then begin
- PutStringInSendBuffer('Content-Encoding: deflate' + #13#10);
- FreeAndNil(FZDocStream);
- FreeAndNil(FCompressStream);
- FZDocStream := TMemoryStream.Create;
- FCompressStream := TCompressionStream.Create(clDefault,
FZDocStream);
- FDocStream.Seek(0, 0);
- while TRUE do begin
- Count := FDocStream.Read(FZBuffer, SizeOf(FZBuffer));
- if Count <= 0 then
- break;
- FCompressStream.Write(FZBuffer, Count);
- end;
- FCompressStream.Free;
- FCompressStream := nil;
- FZDocStream.Seek(0, 0);
- FDocStream.Free;
- FDocStream := FZDocStream;
- FZDocStream := nil;
-{
- FDecompressStream := TDecompressionStream.Create(FDocStream);
- while TRUE do begin
- Count := FDecompressStream.Read(FZBuffer, SizeOf(FZBuffer));
- if Count <= 0 then
- break;
- end;
- FDecompressStream.Free;
- FDecompressStream := nil;
-}
- end;
+ if Pos('deflate', FRequestAcceptEncoding) > 0 then begin
+ PutStringInSendBuffer('Content-Encoding: deflate' + #13#10);
+ ZStreamType :=zsRaw
+ end else
+ if Pos('gzip', FRequestAcceptEncoding) > 0 then begin
+ PutStringInSendBuffer('Content-Encoding: gzip' + #13#10);
+ ZStreamType := zSGZip
+ end else
+ ZStreamType := zsZLib;
+ if ZStreamType <> zsZLib then begin
+ ZDocStream := TMemoryStream.Create;
+ ZlibCompressStreamEx(FDocStream, ZDocStream, clDefault,
ZStreamType, true);
+ FDocStream.free;
+ FDocStream := ZDocStream;
+ end;
{$ENDIF}
+end;
+{$ENDIF}
PutStringInSendBuffer('Content-Length: ' +
_IntToStr(DocStream.Size) + #13#10);
end;
--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be
