pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

httpsend.pas - int64 support and improvements (by Pepak)

Browse Source 
InputStream and OutputStream properties for direct HTTP upload/download to any TStream

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@227 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
2021-06-16 16:09:32 +00:00
parent 8f9d5b6aad
commit 56710f0ab4
1 changed files with 60 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

90
httpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Ararat Synapse | 003.012.010 | | Project : Ararat Synapse | 003.013.000 |
|==============================================================================| |==============================================================================|
| Content: HTTP client | | Content: HTTP client |
|==============================================================================| |==============================================================================|
@ -34,6 +34,7 @@
|==============================================================================| |==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 1999-2021. | | Portions created by Lukas Gebauer are Copyright (c) 1999-2021. |
| Portions created by Pepak are Copyright (c) 2020-2021. |
| All Rights Reserved. | | All Rights Reserved. |
|==============================================================================| |==============================================================================|
| Contributor(s): | | Contributor(s): |
@ -101,18 +102,21 @@ type
FResultString: string; FResultString: string;
FUserAgent: string; FUserAgent: string;
FCookies: TStringList; FCookies: TStringList;
FDownloadSize: integer; FDownloadSize: int64;
FUploadSize: integer; FUploadSize: int64;
FRangeStart: integer; FRangeStart: int64;
FRangeEnd: integer; FRangeEnd: int64;
FAddPortNumberToHost: Boolean; FAddPortNumberToHost: Boolean;
FInputStream, FOutputStream: TStream;
function ReadUnknown: Boolean; virtual; function ReadUnknown: Boolean; virtual;
function ReadIdentity(Size: Integer): Boolean; virtual; function ReadIdentity(Size: int64): Boolean; virtual;
function ReadChunked: Boolean; virtual; function ReadChunked: Boolean; virtual;
procedure ParseCookies; procedure ParseCookies;
function PrepareHeaders: AnsiString; function PrepareHeaders: AnsiString;
function InternalDoConnect(needssl: Boolean): Boolean; function InternalDoConnect(needssl: Boolean): Boolean;
function InternalConnect(needssl: Boolean): Boolean; function InternalConnect(needssl: Boolean): Boolean;
function InputDocument: TStream;
function OutputDocument: TStream;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -158,13 +162,13 @@ type
{:If you need to download only part of a requested document, specify here {:If you need to download only part of a requested document, specify here
the position of subpart begin. If 0, the full document is requested.} the position of subpart begin. If 0, the full document is requested.}
property RangeStart: integer read FRangeStart Write FRangeStart; property RangeStart: int64 read FRangeStart Write FRangeStart;
{:If you need to download only part of a requested document, specify here {:If you need to download only part of a requested document, specify here
the position of subpart end. If 0, the document from rangeStart to end of the position of subpart end. If 0, the document from rangeStart to end of
document is requested. document is requested.
(Useful for resuming broken downloads, for example.)} (Useful for resuming broken downloads, for example.)}
property RangeEnd: integer read FRangeEnd Write FRangeEnd; property RangeEnd: int64 read FRangeEnd Write FRangeEnd;
{:Mime type of sending data. Default is: 'text/html'.} {:Mime type of sending data. Default is: 'text/html'.}
property MimeType: string read FMimeType Write FMimeType; property MimeType: string read FMimeType Write FMimeType;
@ -209,12 +213,12 @@ type
{:if this value is not 0, then data download is pending. In this case you {:if this value is not 0, then data download is pending. In this case you
have here the total size of downloaded data. Useful for drawing download have here the total size of downloaded data. Useful for drawing download
progressbar from OnStatus event.} progressbar from OnStatus event.}
property DownloadSize: integer read FDownloadSize; property DownloadSize: int64 read FDownloadSize;
{:if this value is not 0, then data upload is pending. In this case you have {:if this value is not 0, then data upload is pending. In this case you have
here the total size of uploaded data. Useful for drawing upload progressbar here the total size of uploaded data. Useful for drawing upload progressbar
from OnStatus event.} from OnStatus event.}
property UploadSize: integer read FUploadSize; property UploadSize: int64 read FUploadSize;
{:Socket object used for TCP/IP operation. {:Socket object used for TCP/IP operation.
Good for setting OnStatus hook, etc.} Good for setting OnStatus hook, etc.}
@ -223,6 +227,12 @@ type
{:Allows to switch off port number in 'Host:' HTTP header. By default @TRUE. {:Allows to switch off port number in 'Host:' HTTP header. By default @TRUE.
Some buggy servers do not like port informations in this header.} Some buggy servers do not like port informations in this header.}
property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost; property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
public
{:for direct sending from any TStream. Defalut nil = use Document property instead.}
property InputStream: TStream read FInputStream write FInputStream;
{:for direct dovnloading into any TStream. Defalut nil = use Document property instead.}
property OutputStream: TStream read FOutputStream write FOutputStream;
end; end;
{:A very useful function, and example of use can be found in the THTTPSend {:A very useful function, and example of use can be found in the THTTPSend
@ -296,6 +306,8 @@ begin
FUploadSize := 0; FUploadSize := 0;
FAddPortNumberToHost := true; FAddPortNumberToHost := true;
FKeepAliveTimeout := 300; FKeepAliveTimeout := 300;
FInputStream := nil;
FOutputStream := nil;
Clear; Clear;
end; end;
@ -308,11 +320,29 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function THTTPSend.InputDocument: TStream;
begin
if InputStream <> nil then
Result := InputStream
else
Result := Document;
end;
function THTTPSend.OutputDocument: TStream;
begin
if OutputStream <> nil then
Result := OutputStream
else
Result := Document;
end;
procedure THTTPSend.Clear; procedure THTTPSend.Clear;
begin begin
FRangeStart := 0; FRangeStart := 0;
FRangeEnd := 0; FRangeEnd := 0;
FDocument.Clear; FDocument.Clear;
InputDocument.Size := 0;
OutputDocument.Size := 0;
FHeaders.Clear; FHeaders.Clear;
FMimeType := 'text/html'; FMimeType := 'text/html';
end; end;
@ -383,7 +413,7 @@ var
status100: Boolean; status100: Boolean;
status100error: string; status100error: string;
ToClose: Boolean; ToClose: Boolean;
Size: Integer; Size: int64;
Prot, User, Pass, Host, Port, Path, Para, URI: string; Prot, User, Pass, Host, Port, Path, Para, URI: string;
s, su: AnsiString; s, su: AnsiString;
HttpTunnel: Boolean; HttpTunnel: Boolean;
@ -400,7 +430,7 @@ begin
FDownloadSize := 0; FDownloadSize := 0;
FUploadSize := 0; FUploadSize := 0;
URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para); URI := ParseURL(trim(URL), Prot, User, Pass, Host, Port, Path, Para);
User := DecodeURL(user); User := DecodeURL(user);
Pass := DecodeURL(pass); Pass := DecodeURL(pass);
if User = '' then if User = '' then
@ -425,14 +455,14 @@ begin
FSock.HTTPTunnelPass := ''; FSock.HTTPTunnelPass := '';
end; end;
UsingProxy := (FProxyHost <> '') and not(HttpTunnel); UsingProxy := (FProxyHost <> '') and not(HttpTunnel);
Sending := FDocument.Size > 0; Sending := InputDocument.Size > 0;
{Headers for Sending data} {Headers for Sending data}
status100 := FStatus100 and Sending and (FProtocol = '1.1'); status100 := FStatus100 and Sending and (FProtocol = '1.1');
if status100 then if status100 then
FHeaders.Insert(0, 'Expect: 100-continue'); FHeaders.Insert(0, 'Expect: 100-continue');
if Sending then if Sending then
begin begin
FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size)); FHeaders.Insert(0, 'Content-Length: ' + IntToStr(InputDocument.Size));
if FMimeType <> '' then if FMimeType <> '' then
FHeaders.Insert(0, 'Content-Type: ' + FMimeType); FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
end; end;
@ -514,7 +544,7 @@ begin
end; end;
{ reading Status } { reading Status }
FDocument.Position := 0; InputDocument.Position := 0;
Status100Error := ''; Status100Error := '';
if status100 then if status100 then
begin begin
@ -538,23 +568,23 @@ begin
begin begin
{ we can upload content } { we can upload content }
Status100Error := ''; Status100Error := '';
FUploadSize := FDocument.Size; FUploadSize := InputDocument.Size;
FSock.SendBuffer(FDocument.Memory, FDocument.Size); FSock.SendStreamRaw(InputDocument);
end; end;
end end
else else
{ upload content } { upload content }
if sending then if sending then
begin begin
if FDocument.Size >= c64k then if InputDocument.Size >= c64k then
begin begin
FSock.SendString(PrepareHeaders); FSock.SendString(PrepareHeaders);
FUploadSize := FDocument.Size; FUploadSize := InputDocument.Size;
FSock.SendBuffer(FDocument.Memory, FDocument.Size); FSock.SendStreamRaw(InputDocument);
end end
else else
begin begin
s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size); s := PrepareHeaders + ReadStrFromStream(InputDocument, InputDocument.Size);
FUploadSize := Length(s); FUploadSize := Length(s);
FSock.SendString(s); FSock.SendString(s);
end; end;
@ -590,7 +620,7 @@ begin
begin begin
{ old HTTP 0.9 and some buggy servers not send result } { old HTTP 0.9 and some buggy servers not send result }
s := s + CRLF; s := s + CRLF;
WriteStrToStream(FDocument, s); WriteStrToStream(OutputDocument, s);
FResultCode := 0; FResultCode := 0;
end; end;
until (FSock.LastError <> 0) or (FResultCode <> 100); until (FSock.LastError <> 0) or (FResultCode <> 100);
@ -618,7 +648,7 @@ begin
su := UpperCase(s); su := UpperCase(s);
if Pos('CONTENT-LENGTH:', su) = 1 then if Pos('CONTENT-LENGTH:', su) = 1 then
begin begin
Size := StrToIntDef(Trim(SeparateRight(s, ':')), -1); Size := StrToInt64Def(Trim(SeparateRight(s, ':')), -1);
if (Size <> -1) and (FTransferEncoding = TE_UNKNOWN) then if (Size <> -1) and (FTransferEncoding = TE_UNKNOWN) then
FTransferEncoding := TE_IDENTITY; FTransferEncoding := TE_IDENTITY;
end; end;
@ -671,7 +701,7 @@ begin
Result := ReadChunked; Result := ReadChunked;
end; end;
FDocument.Position := 0; OutputDocument.Position := 0;
if ToClose then if ToClose then
begin begin
FSock.CloseSocket; FSock.CloseSocket;
@ -689,7 +719,7 @@ begin
repeat repeat
s := FSock.RecvPacket(FTimeout); s := FSock.RecvPacket(FTimeout);
if FSock.LastError = 0 then if FSock.LastError = 0 then
WriteStrToStream(FDocument, s); WriteStrToStream(OutputDocument, s);
until FSock.LastError <> 0; until FSock.LastError <> 0;
if FSock.LastError = WSAECONNRESET then if FSock.LastError = WSAECONNRESET then
begin begin
@ -698,13 +728,13 @@ begin
end; end;
end; end;
function THTTPSend.ReadIdentity(Size: Integer): Boolean; function THTTPSend.ReadIdentity(Size: int64): Boolean;
begin begin
if Size > 0 then if Size > 0 then
begin begin
FDownloadSize := Size; FDownloadSize := Size;
FSock.RecvStreamSize(FDocument, FTimeout, Size); FSock.RecvStreamSize(OutputDocument, FTimeout, Size);
FDocument.Position := FDocument.Size; OutputDocument.Position := OutputDocument.Size;
Result := FSock.LastError = 0; Result := FSock.LastError = 0;
end end
else else
@ -714,7 +744,7 @@ end;
function THTTPSend.ReadChunked: Boolean; function THTTPSend.ReadChunked: Boolean;
var var
s: ansistring; s: ansistring;
Size: Integer; Size: int64;
begin begin
repeat repeat
repeat repeat
@ -724,7 +754,7 @@ begin
Break; Break;
s := Trim(SeparateLeft(s, ' ')); s := Trim(SeparateLeft(s, ' '));
s := Trim(SeparateLeft(s, ';')); s := Trim(SeparateLeft(s, ';'));
Size := StrToIntDef('$' + s, 0); Size := StrToInt64Def('$' + s, 0);
if Size = 0 then if Size = 0 then
Break; Break;
if not ReadIdentity(Size) then if not ReadIdentity(Size) then