Index: OverbyteIcsHttpSrv.pas
===================================================================
--- OverbyteIcsHttpSrv.pas (revision 887)
+++ OverbyteIcsHttpSrv.pas (working copy)
@@ -807,6 +807,9 @@
const Status : String;
const ContType : String;
const Header : String); virtual;
+ procedure AnswerStreamPart(var Flags : THttpGetFlag;
+ const ContType : String;
+ LastModified : TDateTime = 0); virtual; {
Added by TR 2012-01-30 }
procedure AnswerString(var Flags : THttpGetFlag;
const Status : String;
const ContType : String;
@@ -2862,6 +2865,129 @@
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
+{ANDREAS Byte-range-separator (use the same as IIS) }
+const
+ ByteRangeSeparator = '[lka9uw3et5vxybtp87ghq23dpu7djv84nhls9p]';
+
+
+{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
+{ANDREAS Helperfunction to create the HTTP-Header }
+function CreateHttpHeader(
+ Version : String;
+ ProtoNumber : Integer;
+ AnswerContentType : String;
+ RangeList : THttpRangeList;
+ DocSize : THttpRangeInt;
+ CompleteDocSize : THttpRangeInt): String;
+begin
+ if ProtoNumber = 200 then
+ Result := Version + ' 200 OK' + #13#10 +
+ 'Content-Type: ' + AnswerContentType + #13#10 +
+ 'Content-Length: ' + _IntToStr(DocSize) + #13#10 +
+ 'Accept-Ranges: bytes' + #13#10
+ {else if ProtoNumber = 416 then
+ Result := Version + ' 416 Request range not satisfiable' + #13#10}
+ else if ProtoNumber = 206 then begin
+ if RangeList.Count = 1 then begin
+ Result := Version + ' 206 Partial Content' + #13#10 +
+ 'Content-Type: ' + AnswerContentType + #13#10 +
+ 'Content-Length: ' + _IntToStr(DocSize) + #13#10 +
+ 'Content-Range: bytes ' +
+
RangeList.Items[0].GetContentRangeString(CompleteDocSize) +
+ #13#10;
+ end
+ else begin
+ Result := Version + ' 206 Partial Content' + #13#10 +
+ 'Content-Type: multipart/byteranges; boundary=' +
+ ByteRangeSeparator + #13#10 +
+ 'Content-Length: ' + _IntToStr(DocSize) + #13#10;
+ end;
+ end
+ else
+ raise Exception.Create('Unexpected ProtoNumber in CreateHttpHeader');
+end;
+
+
+{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
+procedure THttpConnection.AnswerStreamPart(
+ var Flags : THttpGetFlag;
+ const ContType : String; { if emtpy, default to text/html }
+ LastModified : TDateTime = 0);
+var
+ NewDocStream : TStream;
+ ProtoNumber : Integer;
+ CompleteDocSize : THttpRangeInt;
+ SyntaxError : Boolean;
+ ContEncoderHdr : String;
+ ContStatusHdr : String;
+begin
+ Flags := hgWillSendMySelf;
+ ProtoNumber := 200;
+ ContEncoderHdr := '';
+ if ContType <> '' then
+ FAnswerContentType := ContType
+ else
+ FAnswerContentType := 'text/html';
+ FLastModified := LastModified;
+
+ CompleteDocSize := FDocStream.Size;
+ {ANDREAS Create the virtual 'byte-range-doc-stream', if we are ask for
ranges}
+ if RequestRangeValues.Valid then begin
+ { NewDocStream will now be the owner of FDocStream -> don't free
FDocStream }
+ NewDocStream := RequestRangeValues.CreateRangeStream(FDocStream,
+ FAnswerContentType, CompleteDocSize, SyntaxError);
+ if Assigned(NewDocStream) then begin
+ FDocStream := NewDocStream;
+ FDocStream.Position := 0;
+ ProtoNumber := 206;
+ end
+ else begin
+ if SyntaxError then
+ { Ignore the content range header and send entire document in case
}
+ { of syntactically invalid byte-range-set
}
+ FDocStream.Position := 0
+ else begin
+ { Answer 416 Request range not satisfiable }
+ FDocStream.Free;
+ FDocStream := nil;
+ if not FKeepAlive then
+ PrepareGraceFullShutDown;
+ Answer416;
+ Exit;
+ end;
+ end;
+ end;
+
+ FDataSent := 0; { will be incremented after each send part of data }
+ FDocSize := FDocStream.Size;
+ OnDataSent := ConnectionDataSent;
+
+ { V7.21 are we allowed to compress content }
+ if CheckContentEncoding(FAnswerContentType) then begin
+ ContEncoderHdr := DoContentEncoding; { V7.21 do it, returning new
header }
+ FDocSize := FDocStream.Size; { stream is now smaller, we
hope }
+ end;
+
+ { Create Header }
+ {ANDREAS Create Header for the several protocols}
+ ContStatusHdr := CreateHttpHeader(FVersion, ProtoNumber,
FAnswerContentType,
+ RequestRangeValues, FDocSize, CompleteDocSize);
+ PutStringInSendBuffer(ContStatusHdr);
+ FAnswerStatus := ProtoNumber; { V7.19 }
+
+ if FLastModified <> 0 then
+ PutStringInSendBuffer ('Last-Modified: ' + RFC1123_Date(FLastModified)
+ ' GMT' + #13#10);
+ if ContEncoderHdr <> '' then
+ PutStringInSendBuffer (ContEncoderHdr); { V7.21 }
+ if FServer.PersistentHeader <> '' then
+ PutStringInSendBuffer (FServer.PersistentHeader); { V7.29 }
+ PutStringInSendBuffer(GetKeepAliveHdrLines);
+ PutStringInSendBuffer(#13#10);
+ SendStream;
+end;
+
+
+{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpConnection.HtmlPageProducerToString(
const HtmlFile : String;
UserData : TObject;
@@ -3809,50 +3935,6 @@
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
-{ANDREAS Byte-range-separator (use the same as IIS) }
-const
- ByteRangeSeparator = '[lka9uw3et5vxybtp87ghq23dpu7djv84nhls9p]';
-
-
-{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
-{ANDREAS Helperfunction to create the HTTP-Header }
-function CreateHttpHeader(
- Version : String;
- ProtoNumber : Integer;
- AnswerContentType : String;
- RangeList : THttpRangeList;
- DocSize : THttpRangeInt;
- CompleteDocSize : THttpRangeInt): String;
-begin
- if ProtoNumber = 200 then
- Result := Version + ' 200 OK' + #13#10 +
- 'Content-Type: ' + AnswerContentType + #13#10 +
- 'Content-Length: ' + _IntToStr(DocSize) + #13#10 +
- 'Accept-Ranges: bytes' + #13#10
- {else if ProtoNumber = 416 then
- Result := Version + ' 416 Request range not satisfiable' + #13#10}
- else if ProtoNumber = 206 then begin
- if RangeList.Count = 1 then begin
- Result := Version + ' 206 Partial Content' + #13#10 +
- 'Content-Type: ' + AnswerContentType + #13#10 +
- 'Content-Length: ' + _IntToStr(DocSize) + #13#10 +
- 'Content-Range: bytes ' +
-
RangeList.Items[0].GetContentRangeString(CompleteDocSize) +
- #13#10;
- end
- else begin
- Result := Version + ' 206 Partial Content' + #13#10 +
- 'Content-Type: multipart/byteranges; boundary=' +
- ByteRangeSeparator + #13#10 +
- 'Content-Length: ' + _IntToStr(DocSize) + #13#10;
- end;
- end
- else
- raise Exception.Create('Unexpected ProtoNumber in CreateHttpHeader');
-end;
-
-
-{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ SendDocument will send FDocument file to remote client, build header and }
{ sending data (if required) }
procedure THttpConnection.SendDocument(SendType : THttpSendType);
--
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
