mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-06 11:32:40 +02:00
2124 lines
55 KiB
ObjectPascal
2124 lines
55 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2011 by the Free Pascal development team
|
|
|
|
HTTP client component.
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
unit opkman_httpclient;
|
|
|
|
{ ---------------------------------------------------------------------
|
|
Todo:
|
|
* Proxy support ?
|
|
---------------------------------------------------------------------}
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
{$INCLUDE opkman_fpcdef.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, ssockets, httpdefs, uriparser, base64;
|
|
|
|
Const
|
|
// Socket Read buffer size
|
|
ReadBufLen = 4096;
|
|
// Default for MaxRedirects Request redirection is aborted after this number of redirects.
|
|
DefMaxRedirects = 16;
|
|
|
|
Type
|
|
TRedirectEvent = Procedure (Sender : TObject; Const ASrc : String; Var ADest: String) of object;
|
|
TPasswordEvent = Procedure (Sender : TObject; Var RepeatRequest : Boolean) of object;
|
|
// During read of headers, ContentLength equals 0.
|
|
// During read of content, of Server did not specify contentlength, -1 is passed.
|
|
// CurrentPos is reset to 0 when the actual content is read, i.e. it is the position in the data, discarding header size.
|
|
TDataEvent = Procedure (Sender : TObject; Const ContentLength, CurrentPos : Int64) of object;
|
|
// Use this to set up a socket handler. UseSSL is true if protocol was https
|
|
TGetSocketHandlerEvent = Procedure (Sender : TObject; Const UseSSL : Boolean; Out AHandler : TSocketHandler) of object;
|
|
|
|
TFPCustomHTTPClient = Class;
|
|
|
|
{ TProxyData }
|
|
|
|
TProxyData = Class (TPersistent)
|
|
private
|
|
FHost: string;
|
|
FPassword: String;
|
|
FPort: Word;
|
|
FUserName: String;
|
|
FHTTPClient : TFPCustomHTTPClient;
|
|
Protected
|
|
Function GetProxyHeaders : String; virtual;
|
|
Property HTTPClient : TFPCustomHTTPClient Read FHTTPClient;
|
|
Public
|
|
Procedure Assign(Source: TPersistent); override;
|
|
Property Host: string Read FHost Write FHost;
|
|
Property Port: Word Read FPort Write FPort;
|
|
Property UserName : String Read FUserName Write FUserName;
|
|
Property Password : String Read FPassword Write FPassword;
|
|
end;
|
|
|
|
{ TFPCustomHTTPClient }
|
|
TFPCustomHTTPClient = Class(TComponent)
|
|
private
|
|
FDataRead : Int64;
|
|
FContentLength : Int64;
|
|
FAllowRedirect: Boolean;
|
|
FKeepConnection: Boolean;
|
|
FMaxRedirects: Byte;
|
|
FOnDataReceived: TDataEvent;
|
|
FOnHeaders: TNotifyEvent;
|
|
FOnPassword: TPasswordEvent;
|
|
FOnRedirect: TRedirectEvent;
|
|
FPassword: String;
|
|
FIOTimeout: Integer;
|
|
FSentCookies,
|
|
FCookies: TStrings;
|
|
FHTTPVersion: String;
|
|
FRequestBody: TStream;
|
|
FRequestHeaders: TStrings;
|
|
FResponseHeaders: TStrings;
|
|
FResponseStatusCode: Integer;
|
|
FResponseStatusText: String;
|
|
FServerHTTPVersion: String;
|
|
FSocket : TInetSocket;
|
|
FBuffer : Ansistring;
|
|
FTerminated: Boolean;
|
|
FUserName: String;
|
|
FOnGetSocketHandler : TGetSocketHandlerEvent;
|
|
FProxy : TProxyData;
|
|
function CheckContentLength: Int64;
|
|
function CheckTransferEncoding: string;
|
|
function GetCookies: TStrings;
|
|
function GetProxy: TProxyData;
|
|
Procedure ResetResponse;
|
|
Procedure SetCookies(const AValue: TStrings);
|
|
procedure SetHTTPVersion(const AValue: String);
|
|
procedure SetKeepConnection(AValue: Boolean);
|
|
procedure SetProxy(AValue: TProxyData);
|
|
Procedure SetRequestHeaders(const AValue: TStrings);
|
|
procedure SetIOTimeout(AValue: Integer);
|
|
Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
|
|
Procedure CheckConnectionCloseHeader;
|
|
protected
|
|
|
|
Function NoContentAllowed(ACode : Integer) : Boolean;
|
|
// Peform a request, close connection.
|
|
Procedure DoNormalRequest(const AURI: TURI; const AMethod: string;
|
|
AStream: TStream; const AAllowedResponseCodes: array of Integer;
|
|
AHeadersOnly, AIsHttps: Boolean); virtual;
|
|
// Peform a request, try to keep connection.
|
|
Procedure DoKeepConnectionRequest(const AURI: TURI; const AMethod: string;
|
|
AStream: TStream; const AAllowedResponseCodes: array of Integer;
|
|
AHeadersOnly, AIsHttps: Boolean); virtual;
|
|
// Return True if FSocket is assigned
|
|
Function IsConnected: Boolean; virtual;
|
|
// True if we need to use a proxy: ProxyData Assigned and Hostname Set
|
|
Function ProxyActive : Boolean;
|
|
// Override this if you want to create a custom instance of proxy.
|
|
Function CreateProxyData : TProxyData;
|
|
// Called whenever data is read.
|
|
Procedure DoDataRead; virtual;
|
|
// Parse response status line. Saves status text and protocol, returns numerical code. Exception if invalid line.
|
|
Function ParseStatusLine(AStatusLine : String) : Integer;
|
|
// Construct server URL for use in request line.
|
|
function GetServerURL(URI: TURI): String;
|
|
// Read 1 line of response. Fills FBuffer
|
|
function ReadString(out S: String): Boolean;
|
|
// Check if response code is in AllowedResponseCodes. if not, an exception is raised.
|
|
// If AllowRedirect is true, and the result is a Redirect status code, the result is also true
|
|
// If the OnPassword event is set, then a 401 will also result in True.
|
|
function CheckResponseCode(ACode: Integer; const AllowedResponseCodes: array of Integer): Boolean; virtual;
|
|
// Read response from server, and write any document to Stream.
|
|
Function ReadResponse(Stream: TStream; const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False): Boolean; virtual;
|
|
// Read server response line and headers. Returns status code.
|
|
Function ReadResponseHeaders : integer; virtual;
|
|
// Allow header in request ? (currently checks only if non-empty and contains : token)
|
|
function AllowHeader(var AHeader: String): Boolean; virtual;
|
|
// Return True if the "connection: close" header is present
|
|
Function HasConnectionClose: Boolean; virtual;
|
|
// Connect to the server. Must initialize FSocket.
|
|
Procedure ConnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
|
|
// Re-connect to the server. Must reinitialize FSocket.
|
|
Procedure ReconnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
|
|
// Disconnect from server. Must free FSocket.
|
|
Procedure DisconnectFromServer; virtual;
|
|
// Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
|
|
// If non-empty, AllowedResponseCodes contains an array of response codes considered valid responses.
|
|
// If HandleRedirect is True, then Redirect status is accepted as a correct status, but request is not repeated.
|
|
// No authorization callback.
|
|
Procedure DoMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
|
|
// Send request to server: construct request line and send headers and request body.
|
|
Procedure SendRequest(const AMethod: String; URI: TURI); virtual;
|
|
// Create socket handler for protocol AProtocol. Calls OnGetSocketHandler.
|
|
Function GetSocketHandler(Const UseSSL : Boolean) : TSocketHandler; virtual;
|
|
Public
|
|
Constructor Create(AOwner: TComponent); override;
|
|
Destructor Destroy; override;
|
|
// Add header Aheader with value AValue to HTTPHeaders, replacing exiting values
|
|
Class Procedure AddHeader(HTTPHeaders : TStrings; Const AHeader,AValue : String);
|
|
// Index of header AHeader in httpheaders.
|
|
Class Function IndexOfHeader(HTTPHeaders : TStrings; Const AHeader : String) : Integer;
|
|
// Return value of header AHeader from httpheaders. Returns empty if it doesn't exist yet.
|
|
Class Function GetHeader(HTTPHeaders : TStrings; Const AHeader : String) : String;
|
|
{ Terminate the current request.
|
|
It will stop the client from trying to send and/or receive data after the current chunk is sent/received. }
|
|
Procedure Terminate;
|
|
// Request Header management
|
|
// Return index of header, -1 if not present.
|
|
Function IndexOfHeader(Const AHeader : String) : Integer;
|
|
// Add header, replacing an existing one if it exists.
|
|
Procedure AddHeader(Const AHeader,AValue : String);
|
|
// Return header value, empty if not present.
|
|
Function GetHeader(Const AHeader : String) : String;
|
|
// General-purpose call. Handles redirect and authorization retry (OnPassword).
|
|
Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
|
|
// Execute GET on server, store result in Stream, File, StringList or string
|
|
Procedure Get(Const AURL : String; Stream : TStream);
|
|
Procedure Get(Const AURL : String; const LocalFileName : String);
|
|
Procedure Get(Const AURL : String; Response : TStrings);
|
|
Function Get(Const AURL : String) : String;
|
|
// Check if responsecode is a redirect code that this class handles (301,302,303,307,308)
|
|
Class Function IsRedirect(ACode : Integer) : Boolean; virtual;
|
|
// If the code is a redirect, then this method must return TRUE if the next request should happen with a GET (307/308)
|
|
Class Function RedirectForcesGET(ACode : Integer) : Boolean; virtual;
|
|
// Simple class methods
|
|
Class Procedure SimpleGet(Const AURL : String; Stream : TStream);
|
|
Class Procedure SimpleGet(Const AURL : String; const LocalFileName : String);
|
|
Class Procedure SimpleGet(Const AURL : String; Response : TStrings);
|
|
Class Function SimpleGet(Const AURL : String) : String;
|
|
// Simple post
|
|
// Post URL, and Requestbody. Return response in Stream, File, TstringList or String;
|
|
Procedure Post(const URL: string; const Response: TStream);
|
|
Procedure Post(const URL: string; Response : TStrings);
|
|
Procedure Post(const URL: string; const LocalFileName: String);
|
|
function Post(const URL: string) : String;
|
|
// Simple class methods.
|
|
Class Procedure SimplePost(const URL: string; const Response: TStream);
|
|
Class Procedure SimplePost(const URL: string; Response : TStrings);
|
|
Class Procedure SimplePost(const URL: string; const LocalFileName: String);
|
|
Class function SimplePost(const URL: string) : String;
|
|
// Simple Put
|
|
// Put URL, and Requestbody. Return response in Stream, File, TstringList or String;
|
|
Procedure Put(const URL: string; const Response: TStream);
|
|
Procedure Put(const URL: string; Response : TStrings);
|
|
Procedure Put(const URL: string; const LocalFileName: String);
|
|
function Put(const URL: string) : String;
|
|
// Simple class methods.
|
|
Class Procedure SimplePut(const URL: string; const Response: TStream);
|
|
Class Procedure SimplePut(const URL: string; Response : TStrings);
|
|
Class Procedure SimplePut(const URL: string; const LocalFileName: String);
|
|
Class function SimplePut(const URL: string) : String;
|
|
// Simple Delete
|
|
// Delete URL, and Requestbody. Return response in Stream, File, TstringList or String;
|
|
Procedure Delete(const URL: string; const Response: TStream);
|
|
Procedure Delete(const URL: string; Response : TStrings);
|
|
Procedure Delete(const URL: string; const LocalFileName: String);
|
|
function Delete(const URL: string) : String;
|
|
// Simple class methods.
|
|
Class Procedure SimpleDelete(const URL: string; const Response: TStream);
|
|
Class Procedure SimpleDelete(const URL: string; Response : TStrings);
|
|
Class Procedure SimpleDelete(const URL: string; const LocalFileName: String);
|
|
Class function SimpleDelete(const URL: string) : String;
|
|
// Simple Options
|
|
// Options from URL, and Requestbody. Return response in Stream, File, TstringList or String;
|
|
Procedure Options(const URL: string; const Response: TStream);
|
|
Procedure Options(const URL: string; Response : TStrings);
|
|
Procedure Options(const URL: string; const LocalFileName: String);
|
|
function Options(const URL: string) : String;
|
|
// Simple class methods.
|
|
Class Procedure SimpleOptions(const URL: string; const Response: TStream);
|
|
Class Procedure SimpleOptions(const URL: string; Response : TStrings);
|
|
Class Procedure SimpleOptions(const URL: string; const LocalFileName: String);
|
|
Class function SimpleOptions(const URL: string) : String;
|
|
// Get HEAD
|
|
Class Procedure Head(AURL : String; Headers: TStrings);
|
|
// Post Form data (www-urlencoded).
|
|
// Formdata in string (urlencoded) or TStrings (plain text) format.
|
|
// Form data will be inserted in the requestbody.
|
|
// Return response in Stream, File, TStringList or String;
|
|
Procedure FormPost(const URL, FormData: string; const Response: TStream);
|
|
Procedure FormPost(const URL : string; FormData: TStrings; const Response: TStream);
|
|
Procedure FormPost(const URL, FormData: string; const Response: TStrings);
|
|
Procedure FormPost(const URL : string; FormData: TStrings; const Response: TStrings);
|
|
function FormPost(const URL, FormData: string): String;
|
|
function FormPost(const URL: string; FormData : TStrings): String;
|
|
// Simple form
|
|
Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStream);
|
|
Class Procedure SimpleFormPost(const URL : string; FormData: TStrings; const Response: TStream);
|
|
Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStrings);
|
|
Class Procedure SimpleFormPost(const URL : string; FormData: TStrings; const Response: TStrings);
|
|
Class function SimpleFormPost(const URL, FormData: string): String;
|
|
Class function SimpleFormPost(const URL: string; FormData : TStrings): String;
|
|
// Post a file
|
|
Procedure FileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
|
|
// Post form with a file
|
|
Procedure FileFormPost(const AURL: string; FormData: TStrings; AFieldName, AFileName: string; const Response: TStream);
|
|
// Post a stream
|
|
Procedure StreamFormPost(const AURL, AFieldName, AFileName: string; const AStream: TStream; const Response: TStream);
|
|
// Post form with a stream
|
|
Procedure StreamFormPost(const AURL: string; FormData: TStrings; const AFieldName, AFileName: string; const AStream: TStream; const Response: TStream);
|
|
// Simple form of Posting a file
|
|
Class Procedure SimpleFileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
|
|
// Has Terminate been called ?
|
|
Property Terminated : Boolean Read FTerminated;
|
|
Protected
|
|
// Timeouts
|
|
Property IOTimeout : Integer read FIOTimeout write SetIOTimeout;
|
|
// Before request properties.
|
|
// Additional headers for request. Host; and Authentication are automatically added.
|
|
Property RequestHeaders : TStrings Read FRequestHeaders Write SetRequestHeaders;
|
|
// Cookies. Set before request to send cookies to server.
|
|
// After request the property is filled with the cookies sent by the server.
|
|
Property Cookies : TStrings Read GetCookies Write SetCookies;
|
|
// Optional body to send (mainly in POST request)
|
|
Property RequestBody : TStream read FRequestBody Write FRequestBody;
|
|
// used HTTP version when constructing the request.
|
|
// Setting this to any other value than 1.1 will set KeepConnection to False.
|
|
Property HTTPversion : String Read FHTTPVersion Write SetHTTPVersion;
|
|
// After request properties.
|
|
// After request, this contains the headers sent by server.
|
|
Property ResponseHeaders : TStrings Read FResponseHeaders;
|
|
// After request, HTTP version of server reply.
|
|
Property ServerHTTPVersion : String Read FServerHTTPVersion;
|
|
// After request, HTTP response status of the server.
|
|
Property ResponseStatusCode : Integer Read FResponseStatusCode;
|
|
// After request, HTTP response status text of the server.
|
|
Property ResponseStatusText : String Read FResponseStatusText;
|
|
// Allow redirect in HTTPMethod ?
|
|
Property AllowRedirect : Boolean Read FAllowRedirect Write FAllowRedirect;
|
|
// Maximum number of redirects. When this number is reached, an exception is raised.
|
|
Property MaxRedirects : Byte Read FMaxRedirects Write FMaxRedirects default DefMaxRedirects;
|
|
// Called On redirect. Dest URL can be edited.
|
|
// If The DEST url is empty on return, the method is aborted (with redirect status).
|
|
Property OnRedirect : TRedirectEvent Read FOnRedirect Write FOnRedirect;
|
|
// Proxy support
|
|
Property Proxy : TProxyData Read GetProxy Write SetProxy;
|
|
// Authentication.
|
|
// When set, they override the credentials found in the URI.
|
|
// They also override any Authenticate: header in Requestheaders.
|
|
Property UserName : String Read FUserName Write FUserName;
|
|
Property Password : String Read FPassword Write FPassword;
|
|
// Is client connected?
|
|
Property Connected: Boolean read IsConnected;
|
|
// Keep-Alive support. Setting to true will set HTTPVersion to 1.1
|
|
Property KeepConnection: Boolean Read FKeepConnection Write SetKeepConnection;
|
|
// If a request returns a 401, then the OnPassword event is fired.
|
|
// It can modify the username/password and set RepeatRequest to true;
|
|
Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
|
|
// Called whenever data is read from the connection.
|
|
Property OnDataReceived : TDataEvent Read FOnDataReceived Write FOnDataReceived;
|
|
// Called when headers have been processed.
|
|
Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
|
|
// Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
|
|
Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
|
|
|
|
end;
|
|
|
|
|
|
TFPHTTPClient = Class(TFPCustomHTTPClient)
|
|
Published
|
|
Property KeepConnection;
|
|
Property Connected;
|
|
Property IOTimeout;
|
|
Property RequestHeaders;
|
|
Property RequestBody;
|
|
Property ResponseHeaders;
|
|
Property HTTPversion;
|
|
Property ServerHTTPVersion;
|
|
Property ResponseStatusCode;
|
|
Property ResponseStatusText;
|
|
Property Cookies;
|
|
Property AllowRedirect;
|
|
Property MaxRedirects;
|
|
Property OnRedirect;
|
|
Property UserName;
|
|
Property Password;
|
|
Property OnPassword;
|
|
Property OnDataReceived;
|
|
Property OnHeaders;
|
|
Property OnGetSocketHandler;
|
|
Property Proxy;
|
|
end;
|
|
|
|
EHTTPClient = Class(EHTTP);
|
|
|
|
Function EncodeURLElement(S : String) : String;
|
|
Function DecodeURLElement(Const S : String) : String;
|
|
|
|
implementation
|
|
{$if not defined(hasamiga)}
|
|
uses sslsockets;
|
|
{$endif}
|
|
|
|
resourcestring
|
|
SErrInvalidProtocol = 'Invalid protocol: "%s"';
|
|
SErrReadingSocket = 'Error reading data from socket';
|
|
SErrInvalidProtocolVersion = 'Invalid protocol version in response: "%s"';
|
|
SErrInvalidStatusCode = 'Invalid response status code: %s';
|
|
SErrUnexpectedResponse = 'Unexpected response status code: %d';
|
|
SErrChunkTooBig = 'Chunk too big';
|
|
SErrChunkLineEndMissing = 'Chunk line end missing';
|
|
SErrMaxRedirectsReached = 'Maximum allowed redirects reached: %d';
|
|
//SErrRedirectAborted = 'Redirect aborted.';
|
|
|
|
Const
|
|
CRLF = #13#10;
|
|
|
|
function EncodeURLElement(S: String): String;
|
|
|
|
Const
|
|
NotAllowed = [ ';', '/', '?', ':', '@', '=', '&', '#', '+', '_', '<', '>',
|
|
'"', '%', '{', '}', '|', '\', '^', '~', '[', ']', '`' ];
|
|
|
|
var
|
|
i, o, l : Integer;
|
|
h: string[2];
|
|
P : PChar;
|
|
c: AnsiChar;
|
|
begin
|
|
l:=Length(S);
|
|
If (l=0) then Exit;
|
|
SetLength(Result,l*3);
|
|
P:=Pchar(Result);
|
|
for I:=1 to L do
|
|
begin
|
|
C:=S[i];
|
|
O:=Ord(c);
|
|
if (O<=$20) or (O>=$7F) or (c in NotAllowed) then
|
|
begin
|
|
P^ := '%';
|
|
Inc(P);
|
|
h := IntToHex(Ord(c), 2);
|
|
p^ := h[1];
|
|
Inc(P);
|
|
p^ := h[2];
|
|
Inc(P);
|
|
end
|
|
else
|
|
begin
|
|
P^ := c;
|
|
Inc(p);
|
|
end;
|
|
end;
|
|
SetLength(Result,P-PChar(Result));
|
|
end;
|
|
|
|
function DecodeURLElement(Const S: AnsiString): AnsiString;
|
|
|
|
var
|
|
i,l,o : Integer;
|
|
c: AnsiChar;
|
|
p : pchar;
|
|
h : string;
|
|
|
|
begin
|
|
l := Length(S);
|
|
if l=0 then exit;
|
|
SetLength(Result, l);
|
|
P:=PChar(Result);
|
|
i:=1;
|
|
While (I<=L) do
|
|
begin
|
|
c := S[i];
|
|
if (c<>'%') then
|
|
begin
|
|
P^:=c;
|
|
Inc(P);
|
|
end
|
|
else if (I<L-1) then
|
|
begin
|
|
H:='$'+Copy(S,I+1,2);
|
|
o:=StrToIntDef(H,-1);
|
|
If (O>=0) and (O<=255) then
|
|
begin
|
|
P^:=char(O);
|
|
Inc(P);
|
|
Inc(I,2);
|
|
end;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
SetLength(Result, P-Pchar(Result));
|
|
end;
|
|
|
|
{ TProxyData }
|
|
|
|
function TProxyData.GetProxyHeaders: String;
|
|
begin
|
|
Result:='';
|
|
if (UserName<>'') then
|
|
Result:='Proxy-Authorization: Basic ' + EncodeStringBase64(UserName+':'+Password);
|
|
end;
|
|
|
|
procedure TProxyData.Assign(Source: TPersistent);
|
|
|
|
Var
|
|
D : TProxyData;
|
|
|
|
begin
|
|
if Source is TProxyData then
|
|
begin
|
|
D:=Source as TProxyData;
|
|
Host:=D.Host;
|
|
Port:=D.Port;
|
|
UserName:=D.UserName;
|
|
Password:=D.Password;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
{ TFPCustomHTTPClient }
|
|
|
|
procedure TFPCustomHTTPClient.SetRequestHeaders(const AValue: TStrings);
|
|
begin
|
|
if FRequestHeaders=AValue then exit;
|
|
FRequestHeaders.Assign(AValue);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.SetIOTimeout(AValue: Integer);
|
|
begin
|
|
if AValue=FIOTimeout then exit;
|
|
FIOTimeout:=AValue;
|
|
{$IFDEF FPC302}
|
|
if Assigned(FSocket) then
|
|
FSocket.IOTimeout:=AValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.IsConnected: Boolean;
|
|
begin
|
|
Result := Assigned(FSocket);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
|
|
begin
|
|
Result:=((ACode div 100)=1) or ((ACode=204) or (ACode=304))
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.ProxyActive: Boolean;
|
|
begin
|
|
Result:=Assigned(FProxy) and (FProxy.Host<>'') and (FProxy.Port>0);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.CreateProxyData: TProxyData;
|
|
begin
|
|
Result:=TProxyData.Create;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.DoDataRead;
|
|
begin
|
|
If Assigned(FOnDataReceived) Then
|
|
FOnDataReceived(Self,FContentLength,FDataRead);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.IndexOfHeader(const AHeader: String): Integer;
|
|
begin
|
|
Result:=IndexOfHeader(RequestHeaders,AHeader);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.AddHeader(const AHeader, AValue: String);
|
|
|
|
begin
|
|
AddHeader(RequestHeaders,AHeader,AValue);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.GetHeader(const AHeader: String): String;
|
|
|
|
|
|
begin
|
|
Result:=GetHeader(RequestHeaders,AHeader);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.GetServerURL(URI: TURI): String;
|
|
|
|
Var
|
|
D : String;
|
|
|
|
begin
|
|
D:=URI.Path;
|
|
If Length(D) = 0 then
|
|
D := '/'
|
|
else If (D[1]<>'/') then
|
|
D:='/'+D;
|
|
If (D[Length(D)]<>'/') then
|
|
D:=D+'/';
|
|
Result:=D+URI.Document;
|
|
if (URI.Params<>'') then
|
|
Result:=Result+'?'+URI.Params;
|
|
if ProxyActive then
|
|
begin
|
|
if URI.Port>0 then
|
|
Result:=':'+IntToStr(URI.Port)+Result;
|
|
Result:=URI.Protocol+'://'+URI.Host+Result;
|
|
end;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.GetSocketHandler(const UseSSL: Boolean): TSocketHandler;
|
|
|
|
begin
|
|
Result:=Nil;
|
|
if Assigned(FonGetSocketHandler) then
|
|
FOnGetSocketHandler(Self,UseSSL,Result);
|
|
if (Result=Nil) then
|
|
{$if not defined(HASAMIGA)}
|
|
If UseSSL then
|
|
Result:=TSSLSocketHandler.Create
|
|
else
|
|
{$endif}
|
|
Result:=TSocketHandler.Create;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.ConnectToServer(const AHost: String;
|
|
APort: Integer; UseSSL : Boolean = False);
|
|
|
|
Var
|
|
G : TSocketHandler;
|
|
|
|
|
|
begin
|
|
If IsConnected Then
|
|
DisconnectFromServer; // avoid memory leaks
|
|
if (Aport=0) then
|
|
if UseSSL then
|
|
Aport:=443
|
|
else
|
|
Aport:=80;
|
|
G:=GetSocketHandler(UseSSL);
|
|
FSocket:=TInetSocket.Create(AHost,APort,G);
|
|
try
|
|
{$IFDEF FPC302}
|
|
if FIOTimeout<>0 then
|
|
FSocket.IOTimeout:=FIOTimeout;
|
|
{$ENDIF}
|
|
FSocket.Connect;
|
|
except
|
|
FreeAndNil(FSocket);
|
|
Raise;
|
|
end;
|
|
end;
|
|
|
|
Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
|
|
APort: Integer; UseSSL: Boolean);
|
|
begin
|
|
DisconnectFromServer;
|
|
ConnectToServer(AHost, APort, UseSSL);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.DisconnectFromServer;
|
|
|
|
begin
|
|
FreeAndNil(FSocket);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.AllowHeader(var AHeader: String): Boolean;
|
|
|
|
begin
|
|
Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
|
|
end;
|
|
|
|
Function TFPCustomHTTPClient.HasConnectionClose: Boolean;
|
|
begin
|
|
Result := CompareText(GetHeader('Connection'), 'close') = 0;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
|
|
|
|
Var
|
|
PH,UN,PW,S,L : String;
|
|
I : Integer;
|
|
|
|
begin
|
|
S:=Uppercase(AMethod)+' '+GetServerURL(URI)+' '+'HTTP/'+FHTTPVersion+CRLF;
|
|
UN:=URI.Username;
|
|
PW:=URI.Password;
|
|
if (UserName<>'') then
|
|
begin
|
|
UN:=UserName;
|
|
PW:=Password;
|
|
end;
|
|
If (UN<>'') then
|
|
begin
|
|
S:=S+'Authorization: Basic ' + EncodeStringBase64(UN+':'+PW)+CRLF;
|
|
I:=IndexOfHeader('Authorization');
|
|
If I<>-1 then
|
|
RequestHeaders.Delete(i);
|
|
end;
|
|
if Assigned(FProxy) and (FProxy.Host<>'') then
|
|
begin
|
|
PH:=FProxy.GetProxyHeaders;
|
|
if (PH<>'') then
|
|
S:=S+PH+CRLF;
|
|
end;
|
|
S:=S+'Host: '+URI.Host;
|
|
If (URI.Port<>0) then
|
|
S:=S+':'+IntToStr(URI.Port);
|
|
S:=S+CRLF;
|
|
If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
|
|
AddHeader('Content-Length',IntToStr(RequestBody.Size));
|
|
CheckConnectionCloseHeader;
|
|
For I:=0 to FRequestHeaders.Count-1 do
|
|
begin
|
|
l:=FRequestHeaders[i];
|
|
If AllowHeader(L) then
|
|
S:=S+L+CRLF;
|
|
end;
|
|
if Assigned(FCookies) then
|
|
begin
|
|
L:='Cookie:';
|
|
For I:=0 to FCookies.Count-1 do
|
|
begin
|
|
If (I>0) then
|
|
L:=L+'; ';
|
|
L:=L+FCookies[i];
|
|
end;
|
|
if AllowHeader(L) then
|
|
S:=S+L+CRLF;
|
|
end;
|
|
FreeAndNil(FSentCookies);
|
|
FSentCookies:=FCookies;
|
|
FCookies:=Nil;
|
|
S:=S+CRLF;
|
|
if not Terminated then
|
|
FSocket.WriteBuffer(S[1],Length(S));
|
|
If Assigned(FRequestBody) and not Terminated then
|
|
FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
|
|
|
|
Function FillBuffer: Boolean;
|
|
|
|
Var
|
|
R : Integer;
|
|
|
|
begin
|
|
if Terminated then
|
|
Exit(False);
|
|
SetLength(FBuffer,ReadBufLen);
|
|
r:=FSocket.Read(FBuffer[1],ReadBufLen);
|
|
If (r=0) or Terminated Then
|
|
Exit(False);
|
|
If (r<0) then
|
|
Raise EHTTPClient.Create(SErrReadingSocket);
|
|
if (r<ReadBuflen) then
|
|
SetLength(FBuffer,r);
|
|
FDataRead:=FDataRead+R;
|
|
DoDataRead;
|
|
Result:=r>0;
|
|
end;
|
|
|
|
Var
|
|
CheckLF: Boolean;
|
|
P,L : integer;
|
|
|
|
begin
|
|
S:='';
|
|
Result:=False;
|
|
CheckLF:=False;
|
|
Repeat
|
|
if Length(FBuffer)=0 then
|
|
if not FillBuffer then
|
|
Break;
|
|
if Length(FBuffer)=0 then
|
|
Result:=True
|
|
else if CheckLF then
|
|
begin
|
|
If (FBuffer[1]<>#10) then
|
|
S:=S+#13
|
|
else
|
|
begin
|
|
System.Delete(FBuffer,1,1);
|
|
Result:=True;
|
|
end;
|
|
end;
|
|
if not Result then
|
|
begin
|
|
P:=Pos(#13#10,FBuffer);
|
|
If P=0 then
|
|
begin
|
|
L:=Length(FBuffer);
|
|
CheckLF:=FBuffer[L]=#13;
|
|
if CheckLF then
|
|
S:=S+Copy(FBuffer,1,L-1)
|
|
else
|
|
S:=S+FBuffer;
|
|
FBuffer:='';
|
|
end
|
|
else
|
|
begin
|
|
S:=S+Copy(FBuffer,1,P-1);
|
|
System.Delete(FBuffer,1,P+1);
|
|
Result:=True;
|
|
end;
|
|
end;
|
|
until Result or Terminated;
|
|
end;
|
|
|
|
Function GetNextWord(Var S : String) : string;
|
|
|
|
Const
|
|
WhiteSpace = [' ',#9];
|
|
|
|
Var
|
|
P : Integer;
|
|
|
|
begin
|
|
While (Length(S)>0) and (S[1] in WhiteSpace) do
|
|
Delete(S,1,1);
|
|
P:=Pos(' ',S);
|
|
If (P=0) then
|
|
P:=Pos(#9,S);
|
|
If (P=0) then
|
|
P:=Length(S)+1;
|
|
Result:=Copy(S,1,P-1);
|
|
Delete(S,1,P);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.ParseStatusLine(AStatusLine: String): Integer;
|
|
|
|
Var
|
|
S : String;
|
|
|
|
begin
|
|
S:=Uppercase(GetNextWord(AStatusLine));
|
|
If (Copy(S,1,5)<>'HTTP/') then
|
|
Raise EHTTPClient.CreateFmt(SErrInvalidProtocolVersion,[S]);
|
|
System.Delete(S,1,5);
|
|
FServerHTTPVersion:=S;
|
|
S:=GetNextWord(AStatusLine);
|
|
Result:=StrToIntDef(S,-1);
|
|
if Result=-1 then
|
|
Raise EHTTPClient.CreateFmt(SErrInvalidStatusCode,[S]);
|
|
FResponseStatusText:=AStatusLine;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.ReadResponseHeaders: integer;
|
|
|
|
Procedure DoCookies(S : String);
|
|
|
|
Var
|
|
P : Integer;
|
|
C : String;
|
|
|
|
begin
|
|
If Assigned(FCookies) then
|
|
FCookies.Clear;
|
|
P:=Pos(':',S);
|
|
System.Delete(S,1,P);
|
|
Repeat
|
|
P:=Pos(';',S);
|
|
If (P=0) then
|
|
P:=Length(S)+1;
|
|
C:=Trim(Copy(S,1,P-1));
|
|
Cookies.Add(C);
|
|
System.Delete(S,1,P);
|
|
Until (S='') or Terminated;
|
|
end;
|
|
|
|
Const
|
|
SetCookie = 'set-cookie';
|
|
|
|
Var
|
|
StatusLine,S : String;
|
|
|
|
begin
|
|
if not ReadString(StatusLine) then
|
|
Exit(0);
|
|
Result:=ParseStatusLine(StatusLine);
|
|
Repeat
|
|
if ReadString(S) and (S<>'') then
|
|
begin
|
|
ResponseHeaders.Add(S);
|
|
If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
|
|
DoCookies(S);
|
|
end
|
|
Until (S='') or Terminated;
|
|
If Assigned(FOnHeaders) and not Terminated then
|
|
FOnHeaders(Self);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.CheckResponseCode(ACode: Integer;
|
|
const AllowedResponseCodes: array of Integer): Boolean;
|
|
|
|
Var
|
|
I : Integer;
|
|
|
|
begin
|
|
Result:=(High(AllowedResponseCodes)=-1);
|
|
if not Result then
|
|
begin
|
|
I:=Low(AllowedResponseCodes);
|
|
While (Not Result) and (I<=High(AllowedResponseCodes)) do
|
|
begin
|
|
Result:=(AllowedResponseCodes[i]=ACode);
|
|
Inc(I);
|
|
end
|
|
end;
|
|
If (Not Result) then
|
|
begin
|
|
if AllowRedirect then
|
|
Result:=IsRedirect(ACode);
|
|
If (ACode=401) then
|
|
Result:=Assigned(FOnPassword);
|
|
end;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.CheckContentLength: Int64;
|
|
|
|
Const CL ='content-length:';
|
|
|
|
Var
|
|
S : String;
|
|
I : integer;
|
|
|
|
begin
|
|
Result:=-1;
|
|
I:=0;
|
|
While (Result=-1) and (I<FResponseHeaders.Count) do
|
|
begin
|
|
S:=Trim(LowerCase(FResponseHeaders[i]));
|
|
If (Copy(S,1,Length(Cl))=Cl) then
|
|
begin
|
|
System.Delete(S,1,Length(CL));
|
|
Result:=StrToInt64Def(Trim(S),-1);
|
|
end;
|
|
Inc(I);
|
|
end;
|
|
FContentLength:=Result;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.CheckTransferEncoding: string;
|
|
|
|
Const CL ='transfer-encoding:';
|
|
|
|
Var
|
|
S : String;
|
|
I : integer;
|
|
|
|
begin
|
|
Result:='';
|
|
I:=0;
|
|
While (I<FResponseHeaders.Count) do
|
|
begin
|
|
S:=Trim(LowerCase(FResponseHeaders[i]));
|
|
If (Copy(S,1,Length(Cl))=Cl) then
|
|
begin
|
|
System.Delete(S,1,Length(CL));
|
|
Result:=Trim(S);
|
|
exit;
|
|
end;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.GetCookies: TStrings;
|
|
begin
|
|
If (FCookies=Nil) then
|
|
FCookies:=TStringList.Create;
|
|
Result:=FCookies;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.GetProxy: TProxyData;
|
|
begin
|
|
If not Assigned(FProxy) then
|
|
begin
|
|
FProxy:=CreateProxyData;
|
|
FProxy.FHTTPClient:=Self;
|
|
end;
|
|
Result:=FProxy;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.SetCookies(const AValue: TStrings);
|
|
begin
|
|
if GetCookies=AValue then exit;
|
|
GetCookies.Assign(AValue);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.SetHTTPVersion(const AValue: String);
|
|
begin
|
|
if FHTTPVersion = AValue then Exit;
|
|
FHTTPVersion := AValue;
|
|
if (AValue<>'1.1') then
|
|
KeepConnection:=False;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.SetKeepConnection(AValue: Boolean);
|
|
begin
|
|
if FKeepConnection=AValue then Exit;
|
|
FKeepConnection:=AValue;
|
|
if AValue then
|
|
HTTPVersion:='1.1'
|
|
else if IsConnected then
|
|
DisconnectFromServer;
|
|
CheckConnectionCloseHeader;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.SetProxy(AValue: TProxyData);
|
|
begin
|
|
if (AValue=FProxy) then exit;
|
|
Proxy.Assign(AValue);
|
|
end;
|
|
|
|
Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
|
|
const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean): Boolean;
|
|
|
|
Function Transfer(LB : Integer) : Integer;
|
|
|
|
begin
|
|
Result:=FSocket.Read(FBuffer[1],LB);
|
|
If Result<0 then
|
|
Raise EHTTPClient.Create(SErrReadingSocket);
|
|
if (Result>0) then
|
|
begin
|
|
FDataRead:=FDataRead+Result;
|
|
DoDataRead;
|
|
Stream.Write(FBuffer[1],Result);
|
|
end;
|
|
end;
|
|
|
|
Procedure ReadChunkedResponse;
|
|
{ HTTP 1.1 chunked response:
|
|
There is no content-length. The response consists of several chunks of
|
|
data, each
|
|
- beginning with a line
|
|
- starting with a hex number DataSize,
|
|
- an optional parameter,
|
|
- ending with #13#10,
|
|
- followed by the data,
|
|
- ending with #13#10 (not in DataSize),
|
|
It ends when the DataSize is 0.
|
|
After the last chunk there can be a some optional entity header fields.
|
|
This trailer is not yet implemented. }
|
|
var
|
|
BufPos: Integer;
|
|
|
|
function FetchData(out Cnt: integer): boolean;
|
|
|
|
begin
|
|
Result:=False;
|
|
If Terminated then
|
|
exit;
|
|
SetLength(FBuffer,ReadBuflen);
|
|
Cnt:=FSocket.Read(FBuffer[1],length(FBuffer));
|
|
If Cnt<0 then
|
|
Raise EHTTPClient.Create(SErrReadingSocket);
|
|
SetLength(FBuffer,Cnt);
|
|
BufPos:=1;
|
|
Result:=Cnt>0;
|
|
FDataRead:=FDataRead+Cnt;
|
|
DoDataRead;
|
|
end;
|
|
|
|
Function ReadData(Data: PByte; Cnt: integer): integer;
|
|
|
|
var
|
|
l: Integer;
|
|
begin
|
|
Result:=0;
|
|
while Cnt>0 do
|
|
begin
|
|
l:=length(FBuffer)-BufPos+1;
|
|
if l=0 then
|
|
if not FetchData(l) then
|
|
exit; // end of stream
|
|
if l>Cnt then
|
|
l:=Cnt;
|
|
System.Move(FBuffer[BufPos],Data^,l);
|
|
inc(BufPos,l);
|
|
inc(Data,l);
|
|
inc(Result,l);
|
|
dec(Cnt,l);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
c: char;
|
|
ChunkSize: Integer;
|
|
l: Integer;
|
|
begin
|
|
BufPos:=1;
|
|
repeat
|
|
// read ChunkSize
|
|
ChunkSize:=0;
|
|
repeat
|
|
if ReadData(@c,1)<1 then exit;
|
|
case c of
|
|
'0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
|
|
'a'..'f': ChunkSize:=ChunkSize*16+ord(c)-ord('a')+10;
|
|
'A'..'F': ChunkSize:=ChunkSize*16+ord(c)-ord('A')+10;
|
|
else
|
|
break;
|
|
end;
|
|
if ChunkSize>1000000 then
|
|
Raise EHTTPClient.Create(SErrChunkTooBig);
|
|
until Terminated;
|
|
// read till line end
|
|
while (c<>#10) and not Terminated do
|
|
if ReadData(@c,1)<1 then exit;
|
|
if ChunkSize=0 then exit;
|
|
// read data
|
|
repeat
|
|
if Terminated then
|
|
exit;
|
|
l:=length(FBuffer)-BufPos+1;
|
|
if l=0 then
|
|
if not FetchData(l) then
|
|
exit; // end of stream
|
|
if l>ChunkSize then
|
|
l:=ChunkSize;
|
|
if l>0 then
|
|
begin
|
|
// copy chunk data to output
|
|
Stream.Write(FBuffer[BufPos],l);
|
|
inc(BufPos,l);
|
|
dec(ChunkSize,l);
|
|
end;
|
|
until ChunkSize=0;
|
|
// read #13#10
|
|
if ReadData(@c,1)<1 then
|
|
exit;
|
|
if Not Terminated then
|
|
begin
|
|
if c<>#13 then
|
|
Raise EHTTPClient.Create(SErrChunkLineEndMissing);
|
|
if ReadData(@c,1)<1 then exit;
|
|
if c<>#10 then
|
|
Raise EHTTPClient.Create(SErrChunkLineEndMissing);
|
|
// next chunk
|
|
end;
|
|
until Terminated;
|
|
end;
|
|
|
|
Var
|
|
L : Int64;
|
|
LB,R : Integer;
|
|
|
|
begin
|
|
FDataRead:=0;
|
|
FContentLength:=0;
|
|
SetLength(FBuffer,0);
|
|
FResponseStatusCode:=ReadResponseHeaders;
|
|
Result := FResponseStatusCode > 0;
|
|
if not Result then
|
|
Exit;
|
|
if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
|
|
Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
|
|
if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
|
|
exit;
|
|
if CompareText(CheckTransferEncoding,'chunked')=0 then
|
|
ReadChunkedResponse
|
|
else
|
|
begin
|
|
// Write remains of buffer to output.
|
|
LB:=Length(FBuffer);
|
|
FDataRead:=LB;
|
|
If (LB>0) then
|
|
Stream.WriteBuffer(FBuffer[1],LB);
|
|
// Now read the rest, if any.
|
|
SetLength(FBuffer,ReadBuflen);
|
|
L:=CheckContentLength;
|
|
If (L>LB) then
|
|
begin
|
|
// We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
|
|
L:=L-LB;
|
|
Repeat
|
|
LB:=ReadBufLen;
|
|
If (LB>L) then
|
|
LB:=L;
|
|
R:=Transfer(LB);
|
|
L:=L-R;
|
|
until (L=0) or (R=0) or Terminated;
|
|
end
|
|
else if (L<0) and (Not NoContentAllowed(ResponseStatusCode)) then
|
|
begin
|
|
// No content-length, so we read till no more data available.
|
|
Repeat
|
|
R:=Transfer(ReadBufLen);
|
|
until (R=0) or Terminated;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Procedure TFPCustomHTTPClient.ExtractHostPort(AURI: TURI; Out AHost: String;
|
|
Out APort: Word);
|
|
Begin
|
|
if ProxyActive then
|
|
begin
|
|
AHost:=Proxy.Host;
|
|
APort:=Proxy.Port;
|
|
end
|
|
else
|
|
begin
|
|
AHost:=AURI.Host;
|
|
APort:=AURI.Port;
|
|
end;
|
|
End;
|
|
|
|
procedure TFPCustomHTTPClient.CheckConnectionCloseHeader;
|
|
|
|
Var
|
|
I : integer;
|
|
N,V : String;
|
|
|
|
begin
|
|
V:=GetHeader('Connection');
|
|
If FKeepConnection Then
|
|
begin
|
|
I:=IndexOfHeader(FRequestHeaders,'Connection');
|
|
If i>-1 Then
|
|
begin
|
|
// It can be keep-alive, check value
|
|
FRequestHeaders.GetNameValue(I,N,V);
|
|
If CompareText(V,'close')=0 then
|
|
FRequestHeaders.Delete(i);
|
|
end
|
|
end
|
|
Else
|
|
AddHeader('Connection', 'close');
|
|
end;
|
|
|
|
Procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI;
|
|
const AMethod: string; AStream: TStream;
|
|
const AAllowedResponseCodes: array of Integer;
|
|
AHeadersOnly, AIsHttps: Boolean);
|
|
|
|
Var
|
|
CHost: string;
|
|
CPort: Word;
|
|
|
|
begin
|
|
ExtractHostPort(AURI, CHost, CPort);
|
|
ConnectToServer(CHost,CPort,AIsHttps);
|
|
Try
|
|
SendRequest(AMethod,AURI);
|
|
if not Terminated then
|
|
ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
|
|
Finally
|
|
DisconnectFromServer;
|
|
End;
|
|
end;
|
|
|
|
Procedure TFPCustomHTTPClient.DoKeepConnectionRequest(const AURI: TURI;
|
|
const AMethod: string; AStream: TStream;
|
|
const AAllowedResponseCodes: array of Integer;
|
|
AHeadersOnly, AIsHttps: Boolean);
|
|
|
|
Var
|
|
T: Boolean;
|
|
CHost: string;
|
|
CPort: Word;
|
|
|
|
begin
|
|
ExtractHostPort(AURI, CHost, CPort);
|
|
T := False;
|
|
Repeat
|
|
If Not IsConnected Then
|
|
ConnectToServer(CHost,CPort,AIsHttps);
|
|
Try
|
|
if not Terminated then
|
|
SendRequest(AMethod,AURI);
|
|
if not Terminated then
|
|
begin
|
|
T := ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
|
|
If Not T Then
|
|
ReconnectToServer(CHost,CPort,AIsHttps);
|
|
end;
|
|
Finally
|
|
// On terminate, we close the request
|
|
If HasConnectionClose or Terminated Then
|
|
DisconnectFromServer;
|
|
End;
|
|
Until T or Terminated;
|
|
end;
|
|
|
|
Procedure TFPCustomHTTPClient.DoMethod(Const AMethod, AURL: String;
|
|
Stream: TStream; Const AllowedResponseCodes: Array of Integer);
|
|
|
|
Var
|
|
URI: TURI;
|
|
P: String;
|
|
IsHttps, HeadersOnly: Boolean;
|
|
|
|
begin
|
|
ResetResponse;
|
|
URI:=ParseURI(AURL,False);
|
|
p:=LowerCase(URI.Protocol);
|
|
If Not ((P='http') or (P='https')) then
|
|
Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
|
|
IsHttps:=P='https';
|
|
HeadersOnly:=CompareText(AMethod,'HEAD')=0;
|
|
if FKeepConnection then
|
|
DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
|
|
else
|
|
DoNormalRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps);
|
|
end;
|
|
|
|
constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
// Infinite timeout on most platforms
|
|
FIOTimeout:=0;
|
|
FRequestHeaders:=TStringList.Create;
|
|
FRequestHeaders.NameValueSeparator:=':';
|
|
FResponseHeaders:=TStringList.Create;
|
|
FResponseHeaders.NameValueSeparator:=':';
|
|
HTTPVersion:='1.1';
|
|
FMaxRedirects:=DefMaxRedirects;
|
|
end;
|
|
|
|
destructor TFPCustomHTTPClient.Destroy;
|
|
begin
|
|
if IsConnected then
|
|
DisconnectFromServer;
|
|
FreeAndNil(FProxy);
|
|
FreeAndNil(FCookies);
|
|
FreeAndNil(FSentCookies);
|
|
FreeAndNil(FRequestHeaders);
|
|
FreeAndNil(FResponseHeaders);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.AddHeader(HTTPHeaders: TStrings;
|
|
const AHeader, AValue: String);
|
|
Var
|
|
J: Integer;
|
|
begin
|
|
j:=IndexOfHeader(HTTPHeaders,Aheader);
|
|
if (J<>-1) then
|
|
HTTPHeaders.Delete(j);
|
|
HTTPHeaders.Add(AHeader+': '+Avalue);
|
|
end;
|
|
|
|
|
|
class function TFPCustomHTTPClient.IndexOfHeader(HTTPHeaders: TStrings;
|
|
const AHeader: String): Integer;
|
|
|
|
Var
|
|
L : Integer;
|
|
H : String;
|
|
begin
|
|
H:=LowerCase(Aheader);
|
|
l:=Length(AHeader);
|
|
Result:=HTTPHeaders.Count-1;
|
|
While (Result>=0) and ((LowerCase(Copy(HTTPHeaders[Result],1,l)))<>h) do
|
|
Dec(Result);
|
|
end;
|
|
|
|
class function TFPCustomHTTPClient.GetHeader(HTTPHeaders: TStrings;
|
|
const AHeader: String): String;
|
|
Var
|
|
I : Integer;
|
|
begin
|
|
I:=IndexOfHeader(HTTPHeaders,AHeader);
|
|
if (I=-1) then
|
|
Result:=''
|
|
else
|
|
begin
|
|
Result:=HTTPHeaders[i];
|
|
I:=Pos(':',Result);
|
|
if (I=0) then
|
|
I:=Length(Result);
|
|
System.Delete(Result,1,I);
|
|
Result:=TrimLeft(Result);
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Terminate;
|
|
begin
|
|
FTerminated:=True;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.ResetResponse;
|
|
|
|
begin
|
|
FResponseStatusCode:=0;
|
|
FResponseStatusText:='';
|
|
FResponseHeaders.Clear;
|
|
FServerHTTPVersion:='';
|
|
FBuffer:='';
|
|
end;
|
|
|
|
|
|
procedure TFPCustomHTTPClient.HTTPMethod(const AMethod, AURL: String;
|
|
Stream: TStream; const AllowedResponseCodes: array of Integer);
|
|
|
|
Var
|
|
M,L,NL : String;
|
|
RC : Integer;
|
|
RR : Boolean; // Repeat request ?
|
|
|
|
begin
|
|
// Reset Terminated
|
|
FTerminated:=False;
|
|
L:=AURL;
|
|
RC:=0;
|
|
RR:=False;
|
|
M:=AMethod;
|
|
Repeat
|
|
if Not AllowRedirect then
|
|
DoMethod(M,L,Stream,AllowedResponseCodes)
|
|
else
|
|
begin
|
|
DoMethod(M,L,Stream,AllowedResponseCodes);
|
|
if IsRedirect(FResponseStatusCode) and not Terminated then
|
|
begin
|
|
Inc(RC);
|
|
if (RC>MaxRedirects) then
|
|
Raise EHTTPClient.CreateFmt(SErrMaxRedirectsReached,[RC]);
|
|
NL:=GetHeader(FResponseHeaders,'Location');
|
|
if Not Assigned(FOnRedirect) then
|
|
L:=NL
|
|
else
|
|
FOnRedirect(Self,L,NL);
|
|
if (RedirectForcesGET(FResponseStatusCode)) then
|
|
M:='GET';
|
|
L:=NL;
|
|
// Request has saved cookies in sentcookies.
|
|
FreeAndNil(FCookies);
|
|
FCookies:=FSentCookies;
|
|
FSentCookies:=Nil;
|
|
end;
|
|
end;
|
|
if (FResponseStatusCode=401) then
|
|
begin
|
|
RR:=False;
|
|
if Assigned(FOnPassword) then
|
|
FOnPassword(Self,RR);
|
|
end
|
|
else
|
|
RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'');
|
|
until Terminated or not RR ;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Get(const AURL: String; Stream: TStream);
|
|
begin
|
|
HTTPMethod('GET',AURL,Stream,[200]);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Get(const AURL: String;
|
|
const LocalFileName: String);
|
|
|
|
Var
|
|
F : TFileStream;
|
|
|
|
begin
|
|
F:=TFileStream.Create(LocalFileName,fmCreate);
|
|
try
|
|
Get(AURL,F);
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Get(const AURL: String; Response: TStrings);
|
|
begin
|
|
Response.Text:=Get(AURL);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.Get(const AURL: String): String;
|
|
|
|
Var
|
|
SS : TStringStream;
|
|
|
|
begin
|
|
SS:=TStringStream.Create('');
|
|
try
|
|
Get(AURL,SS);
|
|
Result:=SS.Datastring;
|
|
finally
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TFPCustomHTTPClient.IsRedirect(ACode: Integer): Boolean;
|
|
begin
|
|
Case ACode of
|
|
301,
|
|
302,
|
|
303,
|
|
307,808 : Result:=True;
|
|
else
|
|
Result:=False;
|
|
end;
|
|
end;
|
|
|
|
class function TFPCustomHTTPClient.RedirectForcesGET(ACode: Integer): Boolean;
|
|
begin
|
|
Result:=(ACode=303)
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
|
Stream: TStream);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Get(AURL,Stream);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
|
const LocalFileName: String);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Get(AURL,LocalFileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
|
Response: TStrings);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Get(AURL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class function TFPCustomHTTPClient.SimpleGet(const AURL: String): String;
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
Result:=Get(AURL);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFPCustomHTTPClient.Post(const URL: string; const Response: TStream);
|
|
begin
|
|
HTTPMethod('POST',URL,Response,[]);
|
|
end;
|
|
|
|
|
|
procedure TFPCustomHTTPClient.Post(const URL: string; Response: TStrings);
|
|
begin
|
|
Response.Text:=Post(URL);
|
|
end;
|
|
|
|
|
|
procedure TFPCustomHTTPClient.Post(const URL: string;
|
|
const LocalFileName: String);
|
|
|
|
Var
|
|
F : TFileStream;
|
|
|
|
begin
|
|
F:=TFileStream.Create(LocalFileName,fmCreate);
|
|
try
|
|
Post(URL,F);
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TFPCustomHTTPClient.Post(const URL: string): String;
|
|
Var
|
|
SS : TStringStream;
|
|
begin
|
|
SS:=TStringStream.Create('');
|
|
try
|
|
Post(URL,SS);
|
|
Result:=SS.Datastring;
|
|
finally
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
|
const Response: TStream);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Post(URL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
|
Response: TStrings);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Post(URL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
|
const LocalFileName: String);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Post(URL,LocalFileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Result:=Post(URL);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Put(const URL: string; const Response: TStream);
|
|
begin
|
|
HTTPMethod('PUT',URL,Response,[]);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Put(const URL: string; Response: TStrings);
|
|
begin
|
|
Response.Text:=Put(URL);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Put(const URL: string; const LocalFileName: String
|
|
);
|
|
|
|
Var
|
|
F : TFileStream;
|
|
|
|
begin
|
|
F:=TFileStream.Create(LocalFileName,fmCreate);
|
|
try
|
|
Put(URL,F);
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.Put(const URL: string): String;
|
|
Var
|
|
SS : TStringStream;
|
|
begin
|
|
SS:=TStringStream.Create('');
|
|
try
|
|
Put(URL,SS);
|
|
Result:=SS.Datastring;
|
|
finally
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
|
const Response: TStream);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Put(URL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
|
Response: TStrings);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Put(URL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
|
const LocalFileName: String);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Put(URL,LocalFileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Result:=Put(URL);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Delete(const URL: string; const Response: TStream
|
|
);
|
|
begin
|
|
HTTPMethod('DELETE',URL,Response,[]);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Delete(const URL: string; Response: TStrings);
|
|
begin
|
|
Response.Text:=Delete(URL);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Delete(const URL: string;
|
|
const LocalFileName: String);
|
|
|
|
Var
|
|
F : TFileStream;
|
|
|
|
begin
|
|
F:=TFileStream.Create(LocalFileName,fmCreate);
|
|
try
|
|
Delete(URL,F);
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.Delete(const URL: string): String;
|
|
Var
|
|
SS : TStringStream;
|
|
begin
|
|
SS:=TStringStream.Create('');
|
|
try
|
|
Delete(URL,SS);
|
|
Result:=SS.Datastring;
|
|
finally
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
|
const Response: TStream);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Delete(URL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
|
Response: TStrings);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Delete(URL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
|
const LocalFileName: String);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Delete(URL,LocalFileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Result:=Delete(URL);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Options(const URL: string; const Response: TStream
|
|
);
|
|
begin
|
|
HTTPMethod('OPTIONS',URL,Response,[]);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Options(const URL: string; Response: TStrings);
|
|
begin
|
|
Response.Text:=Options(URL);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.Options(const URL: string;
|
|
const LocalFileName: String);
|
|
|
|
Var
|
|
F : TFileStream;
|
|
|
|
begin
|
|
F:=TFileStream.Create(LocalFileName,fmCreate);
|
|
try
|
|
Options(URL,F);
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.Options(const URL: string): String;
|
|
Var
|
|
SS : TStringStream;
|
|
begin
|
|
SS:=TStringStream.Create('');
|
|
try
|
|
Options(URL,SS);
|
|
Result:=SS.Datastring;
|
|
finally
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
|
const Response: TStream);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Options(URL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
|
Response: TStrings);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Options(URL,Response);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
|
const LocalFileName: String);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Options(URL,LocalFileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Result:=Options(URL);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
HTTPMethod('HEAD', AURL, Nil, [200]);
|
|
Headers.Assign(ResponseHeaders);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
|
|
const Response: TStream);
|
|
|
|
begin
|
|
RequestBody:=TStringStream.Create(FormData);
|
|
try
|
|
AddHeader('Content-Type','application/x-www-form-urlencoded');
|
|
Post(URL,Response);
|
|
finally
|
|
RequestBody.Free;
|
|
RequestBody:=Nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings;
|
|
const Response: TStream);
|
|
|
|
Var
|
|
I : Integer;
|
|
S,N,V : String;
|
|
|
|
begin
|
|
S:='';
|
|
For I:=0 to FormData.Count-1 do
|
|
begin
|
|
If (S<>'') then
|
|
S:=S+'&';
|
|
FormData.GetNameValue(i,n,v);
|
|
S:=S+EncodeURLElement(N)+'='+EncodeURLElement(V);
|
|
end;
|
|
FormPost(URL,S,Response);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
|
|
const Response: TStrings);
|
|
begin
|
|
Response.Text:=FormPost(URL,FormData);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings;
|
|
const Response: TStrings);
|
|
begin
|
|
Response.Text:=FormPost(URL,FormData);
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.FormPost(const URL, FormData: string): String;
|
|
Var
|
|
SS : TStringStream;
|
|
begin
|
|
SS:=TStringStream.Create('');
|
|
try
|
|
FormPost(URL,FormData,SS);
|
|
Result:=SS.Datastring;
|
|
finally
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
function TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings): String;
|
|
Var
|
|
SS : TStringStream;
|
|
begin
|
|
SS:=TStringStream.Create('');
|
|
try
|
|
FormPost(URL,FormData,SS);
|
|
Result:=SS.Datastring;
|
|
finally
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
|
|
const Response: TStream);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
FormPost(URL,FormData,Response);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
|
FormData: TStrings; const Response: TStream);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
FormPost(URL,FormData,Response);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
|
|
const Response: TStrings);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
FormPost(URL,FormData,Response);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
|
FormData: TStrings; const Response: TStrings);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
FormPost(URL,FormData,Response);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
|
|
): String;
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Result:=FormPost(URL,FormData);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
|
FormData: TStrings): String;
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
Result:=FormPost(URL,FormData);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFPCustomHTTPClient.FileFormPost(const AURL, AFieldName,
|
|
AFileName: string; const Response: TStream);
|
|
begin
|
|
FileFormPost(AURL, nil, AFieldName, AFileName, Response);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.FileFormPost(const AURL: string;
|
|
FormData: TStrings; AFieldName, AFileName: string; const Response: TStream);
|
|
var
|
|
F: TFileStream;
|
|
begin
|
|
F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
StreamFormPost(AURL, FormData, AFieldName, ExtractFileName(AFileName), F, Response);
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.StreamFormPost(const AURL, AFieldName,
|
|
AFileName: string; const AStream: TStream; const Response: TStream);
|
|
begin
|
|
StreamFormPost(AURL, nil, AFieldName, AFileName, AStream, Response);
|
|
end;
|
|
|
|
procedure TFPCustomHTTPClient.StreamFormPost(const AURL: string;
|
|
FormData: TStrings; const AFieldName, AFileName: string;
|
|
const AStream: TStream; const Response: TStream);
|
|
Var
|
|
S, Sep : string;
|
|
SS : TStringStream;
|
|
I: Integer;
|
|
N,V: String;
|
|
begin
|
|
Sep:=Format('%.8x_multipart_boundary',[Random($ffffff)]);
|
|
AddHeader('Content-Type','multipart/form-data; boundary='+Sep);
|
|
SS:=TStringStream.Create('');
|
|
try
|
|
if (FormData<>Nil) then
|
|
for I:=0 to FormData.Count -1 do
|
|
begin
|
|
// not url encoded
|
|
FormData.GetNameValue(I,N,V);
|
|
S :='--'+Sep+CRLF;
|
|
S:=S+Format('Content-Disposition: form-data; name="%s"'+CRLF+CRLF+'%s'+CRLF,[N, V]);
|
|
SS.WriteBuffer(S[1],Length(S));
|
|
end;
|
|
S:='--'+Sep+CRLF;
|
|
s:=s+Format('Content-Disposition: form-data; name="%s"; filename="%s"'+CRLF,[AFieldName,ExtractFileName(AFileName)]);
|
|
s:=s+'Content-Type: application/octet-string'+CRLF+CRLF;
|
|
SS.WriteBuffer(S[1],Length(S));
|
|
AStream.Seek(0, soFromBeginning);
|
|
SS.CopyFrom(AStream,AStream.Size);
|
|
S:=CRLF+'--'+Sep+'--'+CRLF;
|
|
SS.WriteBuffer(S[1],Length(S));
|
|
SS.Position:=0;
|
|
RequestBody:=SS;
|
|
Post(AURL,Response);
|
|
finally
|
|
RequestBody:=Nil;
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
|
|
AFileName: string; const Response: TStream);
|
|
|
|
begin
|
|
With Self.Create(nil) do
|
|
try
|
|
KeepConnection := False;
|
|
FileFormPost(AURL,AFieldName,AFileName,Response);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|