1 | {
|
---|
2 | This file is part of the Free Pascal run time library.
|
---|
3 | Copyright (c) 2011 by the Free Pascal development team
|
---|
4 |
|
---|
5 | HTTP client component.
|
---|
6 |
|
---|
7 | See the file COPYING.FPC, included in this distribution,
|
---|
8 | for details about the copyright.
|
---|
9 |
|
---|
10 | This program is distributed in the hope that it will be useful,
|
---|
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
---|
13 |
|
---|
14 | **********************************************************************}
|
---|
15 | unit fphttpclient2;
|
---|
16 |
|
---|
17 | { ---------------------------------------------------------------------
|
---|
18 | Todo:
|
---|
19 | * Proxy support ?
|
---|
20 | ---------------------------------------------------------------------}
|
---|
21 |
|
---|
22 | {$mode objfpc}{$H+}
|
---|
23 |
|
---|
24 | interface
|
---|
25 |
|
---|
26 | uses
|
---|
27 | Classes, SysUtils, ssockets, httpdefs, uriparser, base64;
|
---|
28 |
|
---|
29 | Const
|
---|
30 | // Socket Read buffer size
|
---|
31 | ReadBufLen = 4096;
|
---|
32 | // Default for MaxRedirects Request redirection is aborted after this number of redirects.
|
---|
33 | DefMaxRedirects = 16;
|
---|
34 |
|
---|
35 | Type
|
---|
36 | TRedirectEvent = Procedure (Sender : TObject; Const ASrc : String; Var ADest: String) of object;
|
---|
37 | TPasswordEvent = Procedure (Sender : TObject; Var RepeatRequest : Boolean) of object;
|
---|
38 | // During read of headers, ContentLength equals 0.
|
---|
39 | // During read of content, of Server did not specify contentlength, -1 is passed.
|
---|
40 | // CurrentPos is reset to 0 when the actual content is read, i.e. it is the position in the data, discarding header size.
|
---|
41 | TDataEvent = Procedure (Sender : TObject; Const ContentLength, CurrentPos : Int64) of object;
|
---|
42 | // Use this to set up a socket handler. UseSSL is true if protocol was https
|
---|
43 | TGetSocketHandlerEvent = Procedure (Sender : TObject; Const UseSSL : Boolean; Out AHandler : TSocketHandler) of object;
|
---|
44 |
|
---|
45 | { TFPCustomHTTPClient }
|
---|
46 | TFPCustomHTTPClient = Class(TComponent)
|
---|
47 | private
|
---|
48 | FDataRead : Int64;
|
---|
49 | FContentLength : Int64;
|
---|
50 | FAllowRedirect: Boolean;
|
---|
51 | FMaxRedirects: Byte;
|
---|
52 | FOnDataReceived: TDataEvent;
|
---|
53 | FOnHeaders: TNotifyEvent;
|
---|
54 | FOnPassword: TPasswordEvent;
|
---|
55 | FOnRedirect: TRedirectEvent;
|
---|
56 | FPassword: String;
|
---|
57 | FSentCookies,
|
---|
58 | FCookies: TStrings;
|
---|
59 | FHTTPVersion: String;
|
---|
60 | FRequestBody: TStream;
|
---|
61 | FRequestHeaders: TStrings;
|
---|
62 | FResponseHeaders: TStrings;
|
---|
63 | FResponseStatusCode: Integer;
|
---|
64 | FResponseStatusText: String;
|
---|
65 | FServerHTTPVersion: String;
|
---|
66 | FSocket : TInetSocket;
|
---|
67 | FBuffer : Ansistring;
|
---|
68 | FUserName: String;
|
---|
69 | FOnGetSocketHandler : TGetSocketHandlerEvent;
|
---|
70 | function CheckContentLength: Int64;
|
---|
71 | function CheckTransferEncoding: string;
|
---|
72 | function GetCookies: TStrings;
|
---|
73 | Procedure ResetResponse;
|
---|
74 | Procedure SetCookies(const AValue: TStrings);
|
---|
75 | Procedure SetRequestHeaders(const AValue: TStrings);
|
---|
76 | protected
|
---|
77 | // Called whenever data is read.
|
---|
78 | Procedure DoDataRead; virtual;
|
---|
79 | // Parse response status line. Saves status text and protocol, returns numerical code. Exception if invalid line.
|
---|
80 | Function ParseStatusLine(AStatusLine : String) : Integer;
|
---|
81 | // Construct server URL for use in request line.
|
---|
82 | function GetServerURL(URI: TURI): String;
|
---|
83 | // Read 1 line of response. Fills FBuffer
|
---|
84 | function ReadString: String;
|
---|
85 | // Check if response code is in AllowedResponseCodes. if not, an exception is raised.
|
---|
86 | // If AllowRedirect is true, and the result is a Redirect status code, the result is also true
|
---|
87 | // If the OnPassword event is set, then a 401 will also result in True.
|
---|
88 | function CheckResponseCode(ACode: Integer; const AllowedResponseCodes: array of Integer): Boolean; virtual;
|
---|
89 | // Read response from server, and write any document to Stream.
|
---|
90 | Procedure ReadResponse(Stream: TStream; const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); virtual;
|
---|
91 | // Read server response line and headers. Returns status code.
|
---|
92 | Function ReadResponseHeaders : integer; virtual;
|
---|
93 | // Allow header in request ? (currently checks only if non-empty and contains : token)
|
---|
94 | function AllowHeader(var AHeader: String): Boolean; virtual;
|
---|
95 | // Connect to the server. Must initialize FSocket.
|
---|
96 | Procedure ConnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
|
---|
97 | // Disconnect from server. Must free FSocket.
|
---|
98 | Procedure DisconnectFromServer; virtual;
|
---|
99 | // Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
|
---|
100 | // If non-empty, AllowedResponseCodes contains an array of response codes considered valid responses.
|
---|
101 | // If HandleRedirect is True, then Redirect status is accepted as a correct status, but request is not repeated.
|
---|
102 | // No authorization callback.
|
---|
103 | Procedure DoMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
|
---|
104 | // Send request to server: construct request line and send headers and request body.
|
---|
105 | Procedure SendRequest(const AMethod: String; URI: TURI); virtual;
|
---|
106 | // Create socket handler for protocol AProtocol. Calls OnGetSocketHandler.
|
---|
107 | Function GetSocketHandler(Const UseSSL : Boolean) : TSocketHandler; virtual;
|
---|
108 | Public
|
---|
109 | Constructor Create(AOwner: TComponent); override;
|
---|
110 | Destructor Destroy; override;
|
---|
111 | // Add header Aheader with value AValue to HTTPHeaders, replacing exiting values
|
---|
112 | Class Procedure AddHeader(HTTPHeaders : TStrings; Const AHeader,AValue : String);
|
---|
113 | // Index of header AHeader in httpheaders.
|
---|
114 | Class Function IndexOfHeader(HTTPHeaders : TStrings; Const AHeader : String) : Integer;
|
---|
115 | // Return value of header AHeader from httpheaders. Returns empty if it doesn't exist yet.
|
---|
116 | Class Function GetHeader(HTTPHeaders : TStrings; Const AHeader : String) : String;
|
---|
117 | // Request Header management
|
---|
118 | // Return index of header, -1 if not present.
|
---|
119 | Function IndexOfHeader(Const AHeader : String) : Integer;
|
---|
120 | // Add header, replacing an existing one if it exists.
|
---|
121 | Procedure AddHeader(Const AHeader,AValue : String);
|
---|
122 | // Return header value, empty if not present.
|
---|
123 | Function GetHeader(Const AHeader : String) : String;
|
---|
124 | // General-purpose call. Handles redirect and authorization retry (OnPassword).
|
---|
125 | Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
|
---|
126 | // Execute GET on server, store result in Stream, File, StringList or string
|
---|
127 | Procedure Get(Const AURL : String; Stream : TStream);
|
---|
128 | Procedure Get(Const AURL : String; const LocalFileName : String);
|
---|
129 | Procedure Get(Const AURL : String; Response : TStrings);
|
---|
130 | Function Get(Const AURL : String) : String;
|
---|
131 | // Check if responsecode is a redirect code that this class handles (301,302,303,307,308)
|
---|
132 | Class Function IsRedirect(ACode : Integer) : Boolean; virtual;
|
---|
133 | // If the code is a redirect, then this method must return TRUE if the next request should happen with a GET (307/308)
|
---|
134 | Class Function RedirectForcesGET(ACode : Integer) : Boolean; virtual;
|
---|
135 | // Simple class methods
|
---|
136 | Class Procedure SimpleGet(Const AURL : String; Stream : TStream);
|
---|
137 | Class Procedure SimpleGet(Const AURL : String; const LocalFileName : String);
|
---|
138 | Class Procedure SimpleGet(Const AURL : String; Response : TStrings);
|
---|
139 | Class Function SimpleGet(Const AURL : String) : String;
|
---|
140 | // Simple post
|
---|
141 | // Post URL, and Requestbody. Return response in Stream, File, TstringList or String;
|
---|
142 | Procedure Post(const URL: string; const Response: TStream);
|
---|
143 | Procedure Post(const URL: string; Response : TStrings);
|
---|
144 | Procedure Post(const URL: string; const LocalFileName: String);
|
---|
145 | function Post(const URL: string) : String;
|
---|
146 | // Simple class methods.
|
---|
147 | Class Procedure SimplePost(const URL: string; const Response: TStream);
|
---|
148 | Class Procedure SimplePost(const URL: string; Response : TStrings);
|
---|
149 | Class Procedure SimplePost(const URL: string; const LocalFileName: String);
|
---|
150 | Class function SimplePost(const URL: string) : String;
|
---|
151 | // Simple Put
|
---|
152 | // Put URL, and Requestbody. Return response in Stream, File, TstringList or String;
|
---|
153 | Procedure Put(const URL: string; const Response: TStream);
|
---|
154 | Procedure Put(const URL: string; Response : TStrings);
|
---|
155 | Procedure Put(const URL: string; const LocalFileName: String);
|
---|
156 | function Put(const URL: string) : String;
|
---|
157 | // Simple class methods.
|
---|
158 | Class Procedure SimplePut(const URL: string; const Response: TStream);
|
---|
159 | Class Procedure SimplePut(const URL: string; Response : TStrings);
|
---|
160 | Class Procedure SimplePut(const URL: string; const LocalFileName: String);
|
---|
161 | Class function SimplePut(const URL: string) : String;
|
---|
162 | // Simple Delete
|
---|
163 | // Delete URL, and Requestbody. Return response in Stream, File, TstringList or String;
|
---|
164 | Procedure Delete(const URL: string; const Response: TStream);
|
---|
165 | Procedure Delete(const URL: string; Response : TStrings);
|
---|
166 | Procedure Delete(const URL: string; const LocalFileName: String);
|
---|
167 | function Delete(const URL: string) : String;
|
---|
168 | // Simple class methods.
|
---|
169 | Class Procedure SimpleDelete(const URL: string; const Response: TStream);
|
---|
170 | Class Procedure SimpleDelete(const URL: string; Response : TStrings);
|
---|
171 | Class Procedure SimpleDelete(const URL: string; const LocalFileName: String);
|
---|
172 | Class function SimpleDelete(const URL: string) : String;
|
---|
173 | // Simple Options
|
---|
174 | // Options from URL, and Requestbody. Return response in Stream, File, TstringList or String;
|
---|
175 | Procedure Options(const URL: string; const Response: TStream);
|
---|
176 | Procedure Options(const URL: string; Response : TStrings);
|
---|
177 | Procedure Options(const URL: string; const LocalFileName: String);
|
---|
178 | function Options(const URL: string) : String;
|
---|
179 | // Simple class methods.
|
---|
180 | Class Procedure SimpleOptions(const URL: string; const Response: TStream);
|
---|
181 | Class Procedure SimpleOptions(const URL: string; Response : TStrings);
|
---|
182 | Class Procedure SimpleOptions(const URL: string; const LocalFileName: String);
|
---|
183 | Class function SimpleOptions(const URL: string) : String;
|
---|
184 | // Get HEAD
|
---|
185 | Class Procedure Head(AURL : String; Headers: TStrings);
|
---|
186 | // Post Form data (www-urlencoded).
|
---|
187 | // Formdata in string (urlencoded) or TStrings (plain text) format.
|
---|
188 | // Form data will be inserted in the requestbody.
|
---|
189 | // Return response in Stream, File, TStringList or String;
|
---|
190 | Procedure FormPost(const URL, FormData: string; const Response: TStream);
|
---|
191 | Procedure FormPost(const URL : string; FormData: TStrings; const Response: TStream);
|
---|
192 | Procedure FormPost(const URL, FormData: string; const Response: TStrings);
|
---|
193 | Procedure FormPost(const URL : string; FormData: TStrings; const Response: TStrings);
|
---|
194 | function FormPost(const URL, FormData: string): String;
|
---|
195 | function FormPost(const URL: string; FormData : TStrings): String;
|
---|
196 | // Simple form
|
---|
197 | Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStream);
|
---|
198 | Class Procedure SimpleFormPost(const URL : string; FormData: TStrings; const Response: TStream);
|
---|
199 | Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStrings);
|
---|
200 | Class Procedure SimpleFormPost(const URL : string; FormData: TStrings; const Response: TStrings);
|
---|
201 | Class function SimpleFormPost(const URL, FormData: string): String;
|
---|
202 | Class function SimpleFormPost(const URL: string; FormData : TStrings): String;
|
---|
203 | // Post a file
|
---|
204 | Procedure FileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
|
---|
205 | // Post form with a file
|
---|
206 | Procedure FileFormPost(const AURL: string; FormData: TStrings; AFieldName, AFileName: string; const Response: TStream);
|
---|
207 | // Post a stream
|
---|
208 | Procedure StreamFormPost(const AURL, AFieldName, AFileName: string; const AStream: TStream; const Response: TStream);
|
---|
209 | // Post form with a stream
|
---|
210 | Procedure StreamFormPost(const AURL: string; FormData: TStrings; const AFieldName, AFileName: string; const AStream: TStream; const Response: TStream);
|
---|
211 | // Simple form of Posting a file
|
---|
212 | Class Procedure SimpleFileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
|
---|
213 | Protected
|
---|
214 | // Before request properties.
|
---|
215 | // Additional headers for request. Host; and Authentication are automatically added.
|
---|
216 | Property RequestHeaders : TStrings Read FRequestHeaders Write SetRequestHeaders;
|
---|
217 | // Cookies. Set before request to send cookies to server.
|
---|
218 | // After request the property is filled with the cookies sent by the server.
|
---|
219 | Property Cookies : TStrings Read GetCookies Write SetCookies;
|
---|
220 | // Optional body to send (mainly in POST request)
|
---|
221 | Property RequestBody : TStream read FRequestBody Write FRequestBody;
|
---|
222 | // used HTTP version when constructing the request.
|
---|
223 | Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
|
---|
224 | // After request properties.
|
---|
225 | // After request, this contains the headers sent by server.
|
---|
226 | Property ResponseHeaders : TStrings Read FResponseHeaders;
|
---|
227 | // After request, HTTP version of server reply.
|
---|
228 | Property ServerHTTPVersion : String Read FServerHTTPVersion;
|
---|
229 | // After request, HTTP response status of the server.
|
---|
230 | Property ResponseStatusCode : Integer Read FResponseStatusCode;
|
---|
231 | // After request, HTTP response status text of the server.
|
---|
232 | Property ResponseStatusText : String Read FResponseStatusText;
|
---|
233 | // Allow redirect in HTTPMethod ?
|
---|
234 | Property AllowRedirect : Boolean Read FAllowRedirect Write FAllowRedirect;
|
---|
235 | // Maximum number of redirects. When this number is reached, an exception is raised.
|
---|
236 | Property MaxRedirects : Byte Read FMaxRedirects Write FMaxRedirects default DefMaxRedirects;
|
---|
237 | // Called On redirect. Dest URL can be edited.
|
---|
238 | // If The DEST url is empty on return, the method is aborted (with redirect status).
|
---|
239 | Property OnRedirect : TRedirectEvent Read FOnRedirect Write FOnRedirect;
|
---|
240 | // Authentication.
|
---|
241 | // When set, they override the credentials found in the URI.
|
---|
242 | // They also override any Authenticate: header in Requestheaders.
|
---|
243 | Property UserName : String Read FUserName Write FUserName;
|
---|
244 | Property Password : String Read FPassword Write FPassword;
|
---|
245 | // If a request returns a 401, then the OnPassword event is fired.
|
---|
246 | // It can modify the username/password and set RepeatRequest to true;
|
---|
247 | Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
|
---|
248 | // Called whenever data is read from the connection.
|
---|
249 | Property OnDataReceived : TDataEvent Read FOnDataReceived Write FOnDataReceived;
|
---|
250 | // Called when headers have been processed.
|
---|
251 | Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
|
---|
252 | // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
|
---|
253 | Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
|
---|
254 | end;
|
---|
255 |
|
---|
256 |
|
---|
257 | TFPHTTPClient = Class(TFPCustomHTTPClient)
|
---|
258 | Public
|
---|
259 | Property RequestHeaders;
|
---|
260 | Property RequestBody;
|
---|
261 | Property ResponseHeaders;
|
---|
262 | Property HTTPversion;
|
---|
263 | Property ServerHTTPVersion;
|
---|
264 | Property ResponseStatusCode;
|
---|
265 | Property ResponseStatusText;
|
---|
266 | Property Cookies;
|
---|
267 | Property AllowRedirect;
|
---|
268 | Property MaxRedirects;
|
---|
269 | Property OnRedirect;
|
---|
270 | Property UserName;
|
---|
271 | Property Password;
|
---|
272 | Property OnPassword;
|
---|
273 | Property OnDataReceived;
|
---|
274 | Property OnHeaders;
|
---|
275 | Property OnGetSocketHandler;
|
---|
276 | end;
|
---|
277 |
|
---|
278 | EHTTPClient = Class(EHTTP);
|
---|
279 |
|
---|
280 | Function EncodeURLElement(S : String) : String;
|
---|
281 | Function DecodeURLElement(Const S : String) : String;
|
---|
282 |
|
---|
283 | implementation
|
---|
284 | {$if not defined(hasamiga)}
|
---|
285 | uses sslsockets;
|
---|
286 | {$endif}
|
---|
287 |
|
---|
288 | resourcestring
|
---|
289 | SErrInvalidProtocol = 'Invalid protocol : "%s"';
|
---|
290 | SErrReadingSocket = 'Error reading data from socket';
|
---|
291 | SErrInvalidProtocolVersion = 'Invalid protocol version in response: "%s"';
|
---|
292 | SErrInvalidStatusCode = 'Invalid response status code: %s';
|
---|
293 | SErrUnexpectedResponse = 'Unexpected response status code: %d';
|
---|
294 | SErrChunkTooBig = 'Chunk too big';
|
---|
295 | SErrChunkLineEndMissing = 'Chunk line end missing';
|
---|
296 | SErrMaxRedirectsReached = 'Maximum allowed redirects reached : %d';
|
---|
297 | //SErrRedirectAborted = 'Redirect aborted.';
|
---|
298 |
|
---|
299 | Const
|
---|
300 | CRLF = #13#10;
|
---|
301 |
|
---|
302 | function EncodeURLElement(S: String): String;
|
---|
303 |
|
---|
304 | Const
|
---|
305 | NotAllowed = [ ';', '/', '?', ':', '@', '=', '&', '#', '+', '_', '<', '>',
|
---|
306 | '"', '%', '{', '}', '|', '\', '^', '~', '[', ']', '`' ];
|
---|
307 |
|
---|
308 | var
|
---|
309 | i, o, l : Integer;
|
---|
310 | h: string[2];
|
---|
311 | P : PChar;
|
---|
312 | c: AnsiChar;
|
---|
313 | begin
|
---|
314 | l:=Length(S);
|
---|
315 | If (l=0) then Exit;
|
---|
316 | SetLength(Result,l*3);
|
---|
317 | P:=Pchar(Result);
|
---|
318 | for I:=1 to L do
|
---|
319 | begin
|
---|
320 | C:=S[i];
|
---|
321 | O:=Ord(c);
|
---|
322 | if (O<=$20) or (O>=$7F) or (c in NotAllowed) then
|
---|
323 | begin
|
---|
324 | P^ := '%';
|
---|
325 | Inc(P);
|
---|
326 | h := IntToHex(Ord(c), 2);
|
---|
327 | p^ := h[1];
|
---|
328 | Inc(P);
|
---|
329 | p^ := h[2];
|
---|
330 | Inc(P);
|
---|
331 | end
|
---|
332 | else
|
---|
333 | begin
|
---|
334 | P^ := c;
|
---|
335 | Inc(p);
|
---|
336 | end;
|
---|
337 | end;
|
---|
338 | SetLength(Result,P-PChar(Result));
|
---|
339 | end;
|
---|
340 |
|
---|
341 | function DecodeURLElement(Const S: AnsiString): AnsiString;
|
---|
342 |
|
---|
343 | var
|
---|
344 | i,l,o : Integer;
|
---|
345 | c: AnsiChar;
|
---|
346 | p : pchar;
|
---|
347 | h : string;
|
---|
348 |
|
---|
349 | begin
|
---|
350 | l := Length(S);
|
---|
351 | if l=0 then exit;
|
---|
352 | SetLength(Result, l);
|
---|
353 | P:=PChar(Result);
|
---|
354 | i:=1;
|
---|
355 | While (I<=L) do
|
---|
356 | begin
|
---|
357 | c := S[i];
|
---|
358 | if (c<>'%') then
|
---|
359 | begin
|
---|
360 | P^:=c;
|
---|
361 | Inc(P);
|
---|
362 | end
|
---|
363 | else if (I<L-1) then
|
---|
364 | begin
|
---|
365 | H:='$'+Copy(S,I+1,2);
|
---|
366 | o:=StrToIntDef(H,-1);
|
---|
367 | If (O>=0) and (O<=255) then
|
---|
368 | begin
|
---|
369 | P^:=char(O);
|
---|
370 | Inc(P);
|
---|
371 | Inc(I,2);
|
---|
372 | end;
|
---|
373 | end;
|
---|
374 | Inc(i);
|
---|
375 | end;
|
---|
376 | SetLength(Result, P-Pchar(Result));
|
---|
377 | end;
|
---|
378 |
|
---|
379 | { TFPCustomHTTPClient }
|
---|
380 |
|
---|
381 | procedure TFPCustomHTTPClient.SetRequestHeaders(const AValue: TStrings);
|
---|
382 | begin
|
---|
383 | if FRequestHeaders=AValue then exit;
|
---|
384 | FRequestHeaders.Assign(AValue);
|
---|
385 | end;
|
---|
386 |
|
---|
387 | procedure TFPCustomHTTPClient.DoDataRead;
|
---|
388 | begin
|
---|
389 | If Assigned(FOnDataReceived) Then
|
---|
390 | FOnDataReceived(Self,FContentLength,FDataRead);
|
---|
391 | end;
|
---|
392 |
|
---|
393 | function TFPCustomHTTPClient.IndexOfHeader(const AHeader: String): Integer;
|
---|
394 | begin
|
---|
395 | Result:=IndexOfHeader(RequestHeaders,AHeader);
|
---|
396 | end;
|
---|
397 |
|
---|
398 | procedure TFPCustomHTTPClient.AddHeader(const AHeader, AValue: String);
|
---|
399 |
|
---|
400 | begin
|
---|
401 | AddHeader(RequestHeaders,AHeader,AValue);
|
---|
402 | end;
|
---|
403 |
|
---|
404 | function TFPCustomHTTPClient.GetHeader(const AHeader: String): String;
|
---|
405 |
|
---|
406 |
|
---|
407 | begin
|
---|
408 | Result:=GetHeader(RequestHeaders,AHeader);
|
---|
409 | end;
|
---|
410 |
|
---|
411 | function TFPCustomHTTPClient.GetServerURL(URI: TURI): String;
|
---|
412 |
|
---|
413 | Var
|
---|
414 | D : String;
|
---|
415 |
|
---|
416 | begin
|
---|
417 | D:=URI.Path;
|
---|
418 | If Length(D) = 0 then
|
---|
419 | D := '/'
|
---|
420 | else If (D[1]<>'/') then
|
---|
421 | D:='/'+D;
|
---|
422 | If (D[Length(D)]<>'/') then
|
---|
423 | D:=D+'/';
|
---|
424 | Result:=D+URI.Document;
|
---|
425 | if (URI.Params<>'') then
|
---|
426 | Result:=Result+'?'+URI.Params;
|
---|
427 | end;
|
---|
428 |
|
---|
429 | function TFPCustomHTTPClient.GetSocketHandler(const UseSSL: Boolean): TSocketHandler;
|
---|
430 |
|
---|
431 | begin
|
---|
432 | Result:=Nil;
|
---|
433 | if Assigned(FonGetSocketHandler) then
|
---|
434 | FOnGetSocketHandler(Self,UseSSL,Result);
|
---|
435 | if (Result=Nil) then
|
---|
436 | {$if not defined(HASAMIGA)}
|
---|
437 | If UseSSL then
|
---|
438 | Result:=TSSLSocketHandler.Create
|
---|
439 | else
|
---|
440 | {$endif}
|
---|
441 | Result:=TSocketHandler.Create;
|
---|
442 | end;
|
---|
443 |
|
---|
444 | procedure TFPCustomHTTPClient.ConnectToServer(const AHost: String;
|
---|
445 | APort: Integer; UseSSL : Boolean = False);
|
---|
446 |
|
---|
447 | Var
|
---|
448 | G : TSocketHandler;
|
---|
449 |
|
---|
450 |
|
---|
451 | begin
|
---|
452 | if (Aport=0) then
|
---|
453 | if UseSSL then
|
---|
454 | Aport:=443
|
---|
455 | else
|
---|
456 | Aport:=80;
|
---|
457 | G:=GetSocketHandler(UseSSL);
|
---|
458 | FSocket:=TInetSocket.Create(AHost,APort,G);
|
---|
459 | try
|
---|
460 | FSocket.Connect;
|
---|
461 | except
|
---|
462 | FreeAndNil(FSocket);
|
---|
463 | Raise;
|
---|
464 | end;
|
---|
465 | end;
|
---|
466 |
|
---|
467 | procedure TFPCustomHTTPClient.DisconnectFromServer;
|
---|
468 |
|
---|
469 | begin
|
---|
470 | FreeAndNil(FSocket);
|
---|
471 | end;
|
---|
472 |
|
---|
473 | function TFPCustomHTTPClient.AllowHeader(var AHeader: String): Boolean;
|
---|
474 |
|
---|
475 | begin
|
---|
476 | Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
|
---|
477 | end;
|
---|
478 |
|
---|
479 | procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
|
---|
480 |
|
---|
481 | Var
|
---|
482 | UN,PW,S,L : String;
|
---|
483 | I : Integer;
|
---|
484 |
|
---|
485 | begin
|
---|
486 | S:=Uppercase(AMethod)+' '+GetServerURL(URI)+' '+'HTTP/'+FHTTPVersion+CRLF;
|
---|
487 | UN:=URI.Username;
|
---|
488 | PW:=URI.Password;
|
---|
489 | if (UserName<>'') then
|
---|
490 | begin
|
---|
491 | UN:=UserName;
|
---|
492 | PW:=Password;
|
---|
493 | end;
|
---|
494 | If (UN<>'') then
|
---|
495 | begin
|
---|
496 | S:=S+'Authorization: Basic ' + EncodeStringBase64(UN+':'+PW)+CRLF;
|
---|
497 | I:=IndexOfHeader('Authorization');
|
---|
498 | If I<>-1 then
|
---|
499 | RequestHeaders.Delete(i);
|
---|
500 | end;
|
---|
501 | S:=S+'Host: '+URI.Host;
|
---|
502 | If (URI.Port<>0) then
|
---|
503 | S:=S+':'+IntToStr(URI.Port);
|
---|
504 | S:=S+CRLF;
|
---|
505 | If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
|
---|
506 | AddHeader('Content-Length',IntToStr(RequestBody.Size));
|
---|
507 | For I:=0 to FRequestHeaders.Count-1 do
|
---|
508 | begin
|
---|
509 | l:=FRequestHeaders[i];
|
---|
510 | If AllowHeader(L) then
|
---|
511 | S:=S+L+CRLF;
|
---|
512 | end;
|
---|
513 | if Assigned(FCookies) then
|
---|
514 | begin
|
---|
515 | L:='Cookie:';
|
---|
516 | For I:=0 to FCookies.Count-1 do
|
---|
517 | begin
|
---|
518 | If (I>0) then
|
---|
519 | L:=L+'; ';
|
---|
520 | L:=L+FCookies[i];
|
---|
521 | end;
|
---|
522 | if AllowHeader(L) then
|
---|
523 | S:=S+L+CRLF;
|
---|
524 | end;
|
---|
525 | FreeAndNil(FSentCookies);
|
---|
526 | FSentCookies:=FCookies;
|
---|
527 | FCookies:=Nil;
|
---|
528 | S:=S+CRLF;
|
---|
529 | FSocket.WriteBuffer(S[1],Length(S));
|
---|
530 | If Assigned(FRequestBody) then
|
---|
531 | FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
|
---|
532 | end;
|
---|
533 |
|
---|
534 | function TFPCustomHTTPClient.ReadString : String;
|
---|
535 |
|
---|
536 | Procedure FillBuffer;
|
---|
537 |
|
---|
538 | Var
|
---|
539 | R : Integer;
|
---|
540 |
|
---|
541 | begin
|
---|
542 | SetLength(FBuffer,ReadBufLen);
|
---|
543 | r:=FSocket.Read(FBuffer[1],ReadBufLen);
|
---|
544 | If r<0 then
|
---|
545 | Raise EHTTPClient.Create(SErrReadingSocket);
|
---|
546 | if (r<ReadBuflen) then
|
---|
547 | SetLength(FBuffer,r);
|
---|
548 | FDataRead:=FDataRead+R;
|
---|
549 | DoDataRead;
|
---|
550 | end;
|
---|
551 |
|
---|
552 | Var
|
---|
553 | CheckLF,Done : Boolean;
|
---|
554 | P,L : integer;
|
---|
555 |
|
---|
556 | begin
|
---|
557 | Result:='';
|
---|
558 | Done:=False;
|
---|
559 | CheckLF:=False;
|
---|
560 | Repeat
|
---|
561 | if Length(FBuffer)=0 then
|
---|
562 | FillBuffer;
|
---|
563 | if Length(FBuffer)=0 then
|
---|
564 | Done:=True
|
---|
565 | else if CheckLF then
|
---|
566 | begin
|
---|
567 | If (FBuffer[1]<>#10) then
|
---|
568 | Result:=Result+#13
|
---|
569 | else
|
---|
570 | begin
|
---|
571 | System.Delete(FBuffer,1,1);
|
---|
572 | Done:=True;
|
---|
573 | end;
|
---|
574 | end;
|
---|
575 | if not Done then
|
---|
576 | begin
|
---|
577 | P:=Pos(#13#10,FBuffer);
|
---|
578 | If P=0 then
|
---|
579 | begin
|
---|
580 | L:=Length(FBuffer);
|
---|
581 | CheckLF:=FBuffer[L]=#13;
|
---|
582 | if CheckLF then
|
---|
583 | Result:=Result+Copy(FBuffer,1,L-1)
|
---|
584 | else
|
---|
585 | Result:=Result+FBuffer;
|
---|
586 | FBuffer:='';
|
---|
587 | end
|
---|
588 | else
|
---|
589 | begin
|
---|
590 | Result:=Result+Copy(FBuffer,1,P-1);
|
---|
591 | System.Delete(FBuffer,1,P+1);
|
---|
592 | Done:=True;
|
---|
593 | end;
|
---|
594 | end;
|
---|
595 | until Done;
|
---|
596 | end;
|
---|
597 | Function GetNextWord(Var S : String) : string;
|
---|
598 |
|
---|
599 | Const
|
---|
600 | WhiteSpace = [' ',#9];
|
---|
601 |
|
---|
602 | Var
|
---|
603 | P : Integer;
|
---|
604 |
|
---|
605 | begin
|
---|
606 | While (Length(S)>0) and (S[1] in WhiteSpace) do
|
---|
607 | Delete(S,1,1);
|
---|
608 | P:=Pos(' ',S);
|
---|
609 | If (P=0) then
|
---|
610 | P:=Pos(#9,S);
|
---|
611 | If (P=0) then
|
---|
612 | P:=Length(S)+1;
|
---|
613 | Result:=Copy(S,1,P-1);
|
---|
614 | Delete(S,1,P);
|
---|
615 | end;
|
---|
616 |
|
---|
617 | function TFPCustomHTTPClient.ParseStatusLine(AStatusLine: String): Integer;
|
---|
618 |
|
---|
619 | Var
|
---|
620 | S : String;
|
---|
621 |
|
---|
622 | begin
|
---|
623 | S:=Uppercase(GetNextWord(AStatusLine));
|
---|
624 | If (Copy(S,1,5)<>'HTTP/') then
|
---|
625 | Raise EHTTPClient.CreateFmt(SErrInvalidProtocolVersion,[S]);
|
---|
626 | System.Delete(S,1,5);
|
---|
627 | FServerHTTPVersion:=S;
|
---|
628 | S:=GetNextWord(AStatusLine);
|
---|
629 | Result:=StrToIntDef(S,-1);
|
---|
630 | if Result=-1 then
|
---|
631 | Raise EHTTPClient.CreateFmt(SErrInvalidStatusCode,[S]);
|
---|
632 | FResponseStatusText:=AStatusLine;
|
---|
633 | end;
|
---|
634 |
|
---|
635 | function TFPCustomHTTPClient.ReadResponseHeaders: integer;
|
---|
636 |
|
---|
637 | Procedure DoCookies(S : String);
|
---|
638 |
|
---|
639 | Var
|
---|
640 | P : Integer;
|
---|
641 | C : String;
|
---|
642 |
|
---|
643 | begin
|
---|
644 | If Assigned(FCookies) then
|
---|
645 | FCookies.Clear;
|
---|
646 | P:=Pos(':',S);
|
---|
647 | System.Delete(S,1,P);
|
---|
648 | Repeat
|
---|
649 | P:=Pos(';',S);
|
---|
650 | If (P=0) then
|
---|
651 | P:=Length(S)+1;
|
---|
652 | C:=Trim(Copy(S,1,P-1));
|
---|
653 | Cookies.Add(C);
|
---|
654 | System.Delete(S,1,P);
|
---|
655 | Until (S='');
|
---|
656 | end;
|
---|
657 |
|
---|
658 | Const
|
---|
659 | SetCookie = 'set-cookie';
|
---|
660 |
|
---|
661 | Var
|
---|
662 | StatusLine,S : String;
|
---|
663 |
|
---|
664 | begin
|
---|
665 | StatusLine:=ReadString;
|
---|
666 | Result:=ParseStatusLine(StatusLine);
|
---|
667 | Repeat
|
---|
668 | S:=ReadString;
|
---|
669 | if (S<>'') then
|
---|
670 | begin
|
---|
671 | ResponseHeaders.Add(S);
|
---|
672 | If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
|
---|
673 | DoCookies(S);
|
---|
674 | end
|
---|
675 | Until (S='');
|
---|
676 | If Assigned(FOnHeaders) then
|
---|
677 | FOnHeaders(Self);
|
---|
678 | end;
|
---|
679 |
|
---|
680 | function TFPCustomHTTPClient.CheckResponseCode(ACode: Integer;
|
---|
681 | const AllowedResponseCodes: array of Integer): Boolean;
|
---|
682 |
|
---|
683 | Var
|
---|
684 | I : Integer;
|
---|
685 |
|
---|
686 | begin
|
---|
687 | Result:=(High(AllowedResponseCodes)=-1);
|
---|
688 | if not Result then
|
---|
689 | begin
|
---|
690 | I:=Low(AllowedResponseCodes);
|
---|
691 | While (Not Result) and (I<=High(AllowedResponseCodes)) do
|
---|
692 | begin
|
---|
693 | Result:=(AllowedResponseCodes[i]=ACode);
|
---|
694 | Inc(I);
|
---|
695 | end
|
---|
696 | end;
|
---|
697 | If (Not Result) then
|
---|
698 | begin
|
---|
699 | if AllowRedirect then
|
---|
700 | Result:=IsRedirect(ACode);
|
---|
701 | If (ACode=401) then
|
---|
702 | Result:=Assigned(FOnPassword);
|
---|
703 | end;
|
---|
704 | end;
|
---|
705 |
|
---|
706 | function TFPCustomHTTPClient.CheckContentLength: Int64;
|
---|
707 |
|
---|
708 | Const CL ='content-length:';
|
---|
709 |
|
---|
710 | Var
|
---|
711 | S : String;
|
---|
712 | I : integer;
|
---|
713 |
|
---|
714 | begin
|
---|
715 | Result:=-1;
|
---|
716 | I:=0;
|
---|
717 | While (Result=-1) and (I<FResponseHeaders.Count) do
|
---|
718 | begin
|
---|
719 | S:=Trim(LowerCase(FResponseHeaders[i]));
|
---|
720 | If (Copy(S,1,Length(Cl))=Cl) then
|
---|
721 | begin
|
---|
722 | System.Delete(S,1,Length(CL));
|
---|
723 | Result:=StrToInt64Def(Trim(S),-1);
|
---|
724 | end;
|
---|
725 | Inc(I);
|
---|
726 | end;
|
---|
727 | FContentLength:=Result;
|
---|
728 | end;
|
---|
729 |
|
---|
730 | function TFPCustomHTTPClient.CheckTransferEncoding: string;
|
---|
731 |
|
---|
732 | Const CL ='transfer-encoding:';
|
---|
733 |
|
---|
734 | Var
|
---|
735 | S : String;
|
---|
736 | I : integer;
|
---|
737 |
|
---|
738 | begin
|
---|
739 | Result:='';
|
---|
740 | I:=0;
|
---|
741 | While (I<FResponseHeaders.Count) do
|
---|
742 | begin
|
---|
743 | S:=Trim(LowerCase(FResponseHeaders[i]));
|
---|
744 | If (Copy(S,1,Length(Cl))=Cl) then
|
---|
745 | begin
|
---|
746 | System.Delete(S,1,Length(CL));
|
---|
747 | Result:=Trim(S);
|
---|
748 | exit;
|
---|
749 | end;
|
---|
750 | Inc(I);
|
---|
751 | end;
|
---|
752 | end;
|
---|
753 |
|
---|
754 | function TFPCustomHTTPClient.GetCookies: TStrings;
|
---|
755 | begin
|
---|
756 | If (FCookies=Nil) then
|
---|
757 | FCookies:=TStringList.Create;
|
---|
758 | Result:=FCookies;
|
---|
759 | end;
|
---|
760 |
|
---|
761 | procedure TFPCustomHTTPClient.SetCookies(const AValue: TStrings);
|
---|
762 | begin
|
---|
763 | if GetCookies=AValue then exit;
|
---|
764 | GetCookies.Assign(AValue);
|
---|
765 | end;
|
---|
766 |
|
---|
767 | procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
|
---|
768 | const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean);
|
---|
769 |
|
---|
770 | Function Transfer(LB : Integer) : Integer;
|
---|
771 |
|
---|
772 | begin
|
---|
773 | Result:=FSocket.Read(FBuffer[1],LB);
|
---|
774 | If Result<0 then
|
---|
775 | Raise EHTTPClient.Create(SErrReadingSocket);
|
---|
776 | if (Result>0) then
|
---|
777 | begin
|
---|
778 | FDataRead:=FDataRead+Result;
|
---|
779 | DoDataRead;
|
---|
780 | Stream.Write(FBuffer[1],Result);
|
---|
781 | end;
|
---|
782 | end;
|
---|
783 |
|
---|
784 | Procedure ReadChunkedResponse;
|
---|
785 | { HTTP 1.1 chunked response:
|
---|
786 | There is no content-length. The response consists of several chunks of
|
---|
787 | data, each
|
---|
788 | - beginning with a line
|
---|
789 | - starting with a hex number DataSize,
|
---|
790 | - an optional parameter,
|
---|
791 | - ending with #13#10,
|
---|
792 | - followed by the data,
|
---|
793 | - ending with #13#10 (not in DataSize),
|
---|
794 | It ends when the DataSize is 0.
|
---|
795 | After the last chunk there can be a some optional entity header fields.
|
---|
796 | This trailer is not yet implemented. }
|
---|
797 | var
|
---|
798 | BufPos: Integer;
|
---|
799 |
|
---|
800 | function FetchData(out Cnt: integer): boolean;
|
---|
801 |
|
---|
802 | begin
|
---|
803 | SetLength(FBuffer,ReadBuflen);
|
---|
804 | Cnt:=FSocket.Read(FBuffer[1],length(FBuffer));
|
---|
805 | If Cnt<0 then
|
---|
806 | Raise EHTTPClient.Create(SErrReadingSocket);
|
---|
807 | SetLength(FBuffer,Cnt);
|
---|
808 | BufPos:=1;
|
---|
809 | Result:=Cnt>0;
|
---|
810 | FDataRead:=FDataRead+Cnt;
|
---|
811 | DoDataRead;
|
---|
812 | end;
|
---|
813 |
|
---|
814 | Function ReadData(Data: PByte; Cnt: integer): integer;
|
---|
815 |
|
---|
816 | var
|
---|
817 | l: Integer;
|
---|
818 | begin
|
---|
819 | Result:=0;
|
---|
820 | while Cnt>0 do
|
---|
821 | begin
|
---|
822 | l:=length(FBuffer)-BufPos+1;
|
---|
823 | if l=0 then
|
---|
824 | if not FetchData(l) then
|
---|
825 | exit; // end of stream
|
---|
826 | if l>Cnt then
|
---|
827 | l:=Cnt;
|
---|
828 | System.Move(FBuffer[BufPos],Data^,l);
|
---|
829 | inc(BufPos,l);
|
---|
830 | inc(Data,l);
|
---|
831 | inc(Result,l);
|
---|
832 | dec(Cnt,l);
|
---|
833 | end;
|
---|
834 | end;
|
---|
835 |
|
---|
836 | var
|
---|
837 | c: char;
|
---|
838 | ChunkSize: Integer;
|
---|
839 | l: Integer;
|
---|
840 | begin
|
---|
841 | BufPos:=1;
|
---|
842 | repeat
|
---|
843 | // read ChunkSize
|
---|
844 | ChunkSize:=0;
|
---|
845 | repeat
|
---|
846 | if ReadData(@c,1)<1 then exit;
|
---|
847 | case c of
|
---|
848 | '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
|
---|
849 | 'a'..'f': ChunkSize:=ChunkSize*16+ord(c)-ord('a')+10;
|
---|
850 | 'A'..'F': ChunkSize:=ChunkSize*16+ord(c)-ord('A')+10;
|
---|
851 | else break;
|
---|
852 | end;
|
---|
853 | if ChunkSize>10000000 then
|
---|
854 | Raise EHTTPClient.Create(SErrChunkTooBig);
|
---|
855 | until false;
|
---|
856 | // read till line end
|
---|
857 | while (c<>#10) do
|
---|
858 | if ReadData(@c,1)<1 then exit;
|
---|
859 | if ChunkSize=0 then exit;
|
---|
860 | // read data
|
---|
861 | repeat
|
---|
862 | l:=length(FBuffer)-BufPos+1;
|
---|
863 | if l=0 then
|
---|
864 | if not FetchData(l) then
|
---|
865 | exit; // end of stream
|
---|
866 | if l>ChunkSize then
|
---|
867 | l:=ChunkSize;
|
---|
868 | if l>0 then
|
---|
869 | begin
|
---|
870 | // copy chunk data to output
|
---|
871 | Stream.Write(FBuffer[BufPos],l);
|
---|
872 | inc(BufPos,l);
|
---|
873 | dec(ChunkSize,l);
|
---|
874 | end;
|
---|
875 | until ChunkSize=0;
|
---|
876 | // read #13#10
|
---|
877 | if ReadData(@c,1)<1 then exit;
|
---|
878 | if c<>#13 then
|
---|
879 | Raise EHTTPClient.Create(SErrChunkLineEndMissing);
|
---|
880 | if ReadData(@c,1)<1 then exit;
|
---|
881 | if c<>#10 then
|
---|
882 | Raise EHTTPClient.Create(SErrChunkLineEndMissing);
|
---|
883 | // next chunk
|
---|
884 | until false;
|
---|
885 | end;
|
---|
886 |
|
---|
887 | Var
|
---|
888 | L : Int64;
|
---|
889 | LB,R : Integer;
|
---|
890 |
|
---|
891 | begin
|
---|
892 | FDataRead:=0;
|
---|
893 | FContentLength:=0;
|
---|
894 | SetLength(FBuffer,0);
|
---|
895 | FResponseStatusCode:=ReadResponseHeaders;
|
---|
896 | if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
|
---|
897 | Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
|
---|
898 | if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
|
---|
899 | exit;
|
---|
900 | if CompareText(CheckTransferEncoding,'chunked')=0 then
|
---|
901 | ReadChunkedResponse
|
---|
902 | else
|
---|
903 | begin
|
---|
904 | // Write remains of buffer to output.
|
---|
905 | LB:=Length(FBuffer);
|
---|
906 | FDataRead:=LB;
|
---|
907 | If (LB>0) then
|
---|
908 | Stream.WriteBuffer(FBuffer[1],LB);
|
---|
909 | // Now read the rest, if any.
|
---|
910 | SetLength(FBuffer,ReadBuflen);
|
---|
911 | L:=CheckContentLength;
|
---|
912 | If (L>LB) then
|
---|
913 | begin
|
---|
914 | // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
|
---|
915 | L:=L-LB;
|
---|
916 | Repeat
|
---|
917 | LB:=ReadBufLen;
|
---|
918 | If (LB>L) then
|
---|
919 | LB:=L;
|
---|
920 | R:=Transfer(LB);
|
---|
921 | L:=L-R;
|
---|
922 | until (L=0) or (R=0);
|
---|
923 | end
|
---|
924 | else if L<0 then
|
---|
925 | begin
|
---|
926 | // No content-length, so we read till no more data available.
|
---|
927 | Repeat
|
---|
928 | R:=Transfer(ReadBufLen);
|
---|
929 | until (R=0);
|
---|
930 | end;
|
---|
931 | end;
|
---|
932 | end;
|
---|
933 |
|
---|
934 | procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
|
---|
935 | Stream: TStream; const AllowedResponseCodes: array of Integer);
|
---|
936 |
|
---|
937 | Var
|
---|
938 | URI : TURI;
|
---|
939 | P : String;
|
---|
940 |
|
---|
941 | begin
|
---|
942 | ResetResponse;
|
---|
943 | URI:=ParseURI(AURL,False);
|
---|
944 | p:=LowerCase(URI.Protocol);
|
---|
945 | If Not ((P='http') or (P='https')) then
|
---|
946 | Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
|
---|
947 | ConnectToServer(URI.Host,URI.Port,P='https');
|
---|
948 | try
|
---|
949 | SendRequest(AMethod,URI);
|
---|
950 | ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
|
---|
951 | finally
|
---|
952 | DisconnectFromServer;
|
---|
953 | end;
|
---|
954 | end;
|
---|
955 |
|
---|
956 | constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
|
---|
957 | begin
|
---|
958 | inherited Create(AOwner);
|
---|
959 | FRequestHeaders:=TStringList.Create;
|
---|
960 | FResponseHeaders:=TStringList.Create;
|
---|
961 | FHTTPVersion:='1.1';
|
---|
962 | FMaxRedirects:=DefMaxRedirects;
|
---|
963 | end;
|
---|
964 |
|
---|
965 | destructor TFPCustomHTTPClient.Destroy;
|
---|
966 | begin
|
---|
967 | FreeAndNil(FCookies);
|
---|
968 | FreeAndNil(FSentCookies);
|
---|
969 | FreeAndNil(FRequestHeaders);
|
---|
970 | FreeAndNil(FResponseHeaders);
|
---|
971 | inherited Destroy;
|
---|
972 | end;
|
---|
973 |
|
---|
974 | class procedure TFPCustomHTTPClient.AddHeader(HTTPHeaders: TStrings;
|
---|
975 | const AHeader, AValue: String);
|
---|
976 | Var
|
---|
977 | J: Integer;
|
---|
978 | begin
|
---|
979 | j:=IndexOfHeader(HTTPHeaders,Aheader);
|
---|
980 | if (J<>-1) then
|
---|
981 | HTTPHeaders.Delete(j);
|
---|
982 | HTTPHeaders.Add(AHeader+': '+Avalue);
|
---|
983 | end;
|
---|
984 |
|
---|
985 |
|
---|
986 | class function TFPCustomHTTPClient.IndexOfHeader(HTTPHeaders: TStrings;
|
---|
987 | const AHeader: String): Integer;
|
---|
988 |
|
---|
989 | Var
|
---|
990 | L : Integer;
|
---|
991 | H : String;
|
---|
992 | begin
|
---|
993 | H:=LowerCase(Aheader);
|
---|
994 | l:=Length(AHeader);
|
---|
995 | Result:=HTTPHeaders.Count-1;
|
---|
996 | While (Result>=0) and ((LowerCase(Copy(HTTPHeaders[Result],1,l)))<>h) do
|
---|
997 | Dec(Result);
|
---|
998 | end;
|
---|
999 |
|
---|
1000 | class function TFPCustomHTTPClient.GetHeader(HTTPHeaders: TStrings;
|
---|
1001 | const AHeader: String): String;
|
---|
1002 | Var
|
---|
1003 | I : Integer;
|
---|
1004 | begin
|
---|
1005 | I:=IndexOfHeader(HTTPHeaders,AHeader);
|
---|
1006 | if (I=-1) then
|
---|
1007 | Result:=''
|
---|
1008 | else
|
---|
1009 | begin
|
---|
1010 | Result:=HTTPHeaders[i];
|
---|
1011 | I:=Pos(':',Result);
|
---|
1012 | if (I=0) then
|
---|
1013 | I:=Length(Result);
|
---|
1014 | System.Delete(Result,1,I);
|
---|
1015 | Result:=TrimLeft(Result);
|
---|
1016 | end;
|
---|
1017 | end;
|
---|
1018 |
|
---|
1019 | procedure TFPCustomHTTPClient.ResetResponse;
|
---|
1020 |
|
---|
1021 | begin
|
---|
1022 | FResponseStatusCode:=0;
|
---|
1023 | FResponseStatusText:='';
|
---|
1024 | FResponseHeaders.Clear;
|
---|
1025 | FServerHTTPVersion:='';
|
---|
1026 | FBuffer:='';
|
---|
1027 | end;
|
---|
1028 |
|
---|
1029 |
|
---|
1030 | procedure TFPCustomHTTPClient.HTTPMethod(const AMethod, AURL: String;
|
---|
1031 | Stream: TStream; const AllowedResponseCodes: array of Integer);
|
---|
1032 |
|
---|
1033 | Var
|
---|
1034 | M,L,NL : String;
|
---|
1035 | RC : Integer;
|
---|
1036 | RR : Boolean; // Repeat request ?
|
---|
1037 |
|
---|
1038 | begin
|
---|
1039 | L:=AURL;
|
---|
1040 | RC:=0;
|
---|
1041 | RR:=False;
|
---|
1042 | M:=AMethod;
|
---|
1043 | Repeat
|
---|
1044 | if Not AllowRedirect then
|
---|
1045 | DoMethod(M,L,Stream,AllowedResponseCodes)
|
---|
1046 | else
|
---|
1047 | begin
|
---|
1048 | DoMethod(M,L,Stream,AllowedResponseCodes);
|
---|
1049 | if IsRedirect(FResponseStatusCode) then
|
---|
1050 | begin
|
---|
1051 | Inc(RC);
|
---|
1052 | if (RC>MaxRedirects) then
|
---|
1053 | Raise EHTTPClient.CreateFmt(SErrMaxRedirectsReached,[RC]);
|
---|
1054 | NL:=GetHeader(FResponseHeaders,'Location');
|
---|
1055 | if Not Assigned(FOnRedirect) then
|
---|
1056 | L:=NL
|
---|
1057 | else
|
---|
1058 | FOnRedirect(Self,L,NL);
|
---|
1059 | if (RedirectForcesGET(FResponseStatusCode)) then
|
---|
1060 | M:='GET';
|
---|
1061 | L:=NL;
|
---|
1062 | // Request has saved cookies in sentcookies.
|
---|
1063 | FreeAndNil(FCookies);
|
---|
1064 | FCookies:=FSentCookies;
|
---|
1065 | FSentCookies:=Nil;
|
---|
1066 | end;
|
---|
1067 | end;
|
---|
1068 | if (FResponseStatusCode=401) then
|
---|
1069 | begin
|
---|
1070 | RR:=False;
|
---|
1071 | if Assigned(FOnPassword) then
|
---|
1072 | FOnPassword(Self,RR);
|
---|
1073 | end
|
---|
1074 | else
|
---|
1075 | RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'')
|
---|
1076 | until not RR;
|
---|
1077 | end;
|
---|
1078 |
|
---|
1079 | procedure TFPCustomHTTPClient.Get(const AURL: String; Stream: TStream);
|
---|
1080 | begin
|
---|
1081 | HTTPMethod('GET',AURL,Stream,[200]);
|
---|
1082 | end;
|
---|
1083 |
|
---|
1084 | procedure TFPCustomHTTPClient.Get(const AURL: String;
|
---|
1085 | const LocalFileName: String);
|
---|
1086 |
|
---|
1087 | Var
|
---|
1088 | F : TFileStream;
|
---|
1089 |
|
---|
1090 | begin
|
---|
1091 | F:=TFileStream.Create(LocalFileName,fmCreate);
|
---|
1092 | try
|
---|
1093 | Get(AURL,F);
|
---|
1094 | finally
|
---|
1095 | F.Free;
|
---|
1096 | end;
|
---|
1097 | end;
|
---|
1098 |
|
---|
1099 | procedure TFPCustomHTTPClient.Get(const AURL: String; Response: TStrings);
|
---|
1100 | begin
|
---|
1101 | Response.Text:=Get(AURL);
|
---|
1102 | end;
|
---|
1103 |
|
---|
1104 | function TFPCustomHTTPClient.Get(const AURL: String): String;
|
---|
1105 |
|
---|
1106 | Var
|
---|
1107 | SS : TStringStream;
|
---|
1108 |
|
---|
1109 | begin
|
---|
1110 | SS:=TStringStream.Create('');
|
---|
1111 | try
|
---|
1112 | Get(AURL,SS);
|
---|
1113 | Result:=SS.Datastring;
|
---|
1114 | finally
|
---|
1115 | SS.Free;
|
---|
1116 | end;
|
---|
1117 | end;
|
---|
1118 |
|
---|
1119 | class function TFPCustomHTTPClient.IsRedirect(ACode: Integer): Boolean;
|
---|
1120 | begin
|
---|
1121 | Case ACode of
|
---|
1122 | 301,
|
---|
1123 | 302,
|
---|
1124 | 303,
|
---|
1125 | 307,808 : Result:=True;
|
---|
1126 | else
|
---|
1127 | Result:=False;
|
---|
1128 | end;
|
---|
1129 | end;
|
---|
1130 |
|
---|
1131 | class function TFPCustomHTTPClient.RedirectForcesGET(ACode: Integer): Boolean;
|
---|
1132 | begin
|
---|
1133 | Result:=(ACode=303)
|
---|
1134 | end;
|
---|
1135 |
|
---|
1136 |
|
---|
1137 | class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
---|
1138 | Stream: TStream);
|
---|
1139 |
|
---|
1140 | begin
|
---|
1141 | With Self.Create(nil) do
|
---|
1142 | try
|
---|
1143 | RequestHeaders.Add('Connection: Close');
|
---|
1144 | Get(AURL,Stream);
|
---|
1145 | finally
|
---|
1146 | Free;
|
---|
1147 | end;
|
---|
1148 | end;
|
---|
1149 |
|
---|
1150 |
|
---|
1151 | class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
---|
1152 | const LocalFileName: String);
|
---|
1153 |
|
---|
1154 | begin
|
---|
1155 | With Self.Create(nil) do
|
---|
1156 | try
|
---|
1157 | RequestHeaders.Add('Connection: Close');
|
---|
1158 | Get(AURL,LocalFileName);
|
---|
1159 | finally
|
---|
1160 | Free;
|
---|
1161 | end;
|
---|
1162 | end;
|
---|
1163 |
|
---|
1164 |
|
---|
1165 | class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
---|
1166 | Response: TStrings);
|
---|
1167 |
|
---|
1168 | begin
|
---|
1169 | With Self.Create(nil) do
|
---|
1170 | try
|
---|
1171 | RequestHeaders.Add('Connection: Close');
|
---|
1172 | Get(AURL,Response);
|
---|
1173 | finally
|
---|
1174 | Free;
|
---|
1175 | end;
|
---|
1176 | end;
|
---|
1177 |
|
---|
1178 |
|
---|
1179 | class function TFPCustomHTTPClient.SimpleGet(const AURL: String): String;
|
---|
1180 |
|
---|
1181 | begin
|
---|
1182 | With Self.Create(nil) do
|
---|
1183 | try
|
---|
1184 | Result:=Get(AURL);
|
---|
1185 | finally
|
---|
1186 | Free;
|
---|
1187 | end;
|
---|
1188 | end;
|
---|
1189 |
|
---|
1190 |
|
---|
1191 | procedure TFPCustomHTTPClient.Post(const URL: string; const Response: TStream);
|
---|
1192 | begin
|
---|
1193 | HTTPMethod('POST',URL,Response,[]);
|
---|
1194 | end;
|
---|
1195 |
|
---|
1196 |
|
---|
1197 | procedure TFPCustomHTTPClient.Post(const URL: string; Response: TStrings);
|
---|
1198 | begin
|
---|
1199 | Response.Text:=Post(URL);
|
---|
1200 | end;
|
---|
1201 |
|
---|
1202 |
|
---|
1203 | procedure TFPCustomHTTPClient.Post(const URL: string;
|
---|
1204 | const LocalFileName: String);
|
---|
1205 |
|
---|
1206 | Var
|
---|
1207 | F : TFileStream;
|
---|
1208 |
|
---|
1209 | begin
|
---|
1210 | F:=TFileStream.Create(LocalFileName,fmCreate);
|
---|
1211 | try
|
---|
1212 | Post(URL,F);
|
---|
1213 | finally
|
---|
1214 | F.Free;
|
---|
1215 | end;
|
---|
1216 | end;
|
---|
1217 |
|
---|
1218 |
|
---|
1219 | function TFPCustomHTTPClient.Post(const URL: string): String;
|
---|
1220 | Var
|
---|
1221 | SS : TStringStream;
|
---|
1222 | begin
|
---|
1223 | SS:=TStringStream.Create('');
|
---|
1224 | try
|
---|
1225 | Post(URL,SS);
|
---|
1226 | Result:=SS.Datastring;
|
---|
1227 | finally
|
---|
1228 | SS.Free;
|
---|
1229 | end;
|
---|
1230 | end;
|
---|
1231 |
|
---|
1232 |
|
---|
1233 | class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
---|
1234 | const Response: TStream);
|
---|
1235 |
|
---|
1236 | begin
|
---|
1237 | With Self.Create(nil) do
|
---|
1238 | try
|
---|
1239 | RequestHeaders.Add('Connection: Close');
|
---|
1240 | Post(URL,Response);
|
---|
1241 | finally
|
---|
1242 | Free;
|
---|
1243 | end;
|
---|
1244 | end;
|
---|
1245 |
|
---|
1246 |
|
---|
1247 | class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
---|
1248 | Response: TStrings);
|
---|
1249 |
|
---|
1250 | begin
|
---|
1251 | With Self.Create(nil) do
|
---|
1252 | try
|
---|
1253 | RequestHeaders.Add('Connection: Close');
|
---|
1254 | Post(URL,Response);
|
---|
1255 | finally
|
---|
1256 | Free;
|
---|
1257 | end;
|
---|
1258 | end;
|
---|
1259 |
|
---|
1260 |
|
---|
1261 | class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
---|
1262 | const LocalFileName: String);
|
---|
1263 |
|
---|
1264 | begin
|
---|
1265 | With Self.Create(nil) do
|
---|
1266 | try
|
---|
1267 | RequestHeaders.Add('Connection: Close');
|
---|
1268 | Post(URL,LocalFileName);
|
---|
1269 | finally
|
---|
1270 | Free;
|
---|
1271 | end;
|
---|
1272 | end;
|
---|
1273 |
|
---|
1274 |
|
---|
1275 | class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
|
---|
1276 |
|
---|
1277 | begin
|
---|
1278 | With Self.Create(nil) do
|
---|
1279 | try
|
---|
1280 | RequestHeaders.Add('Connection: Close');
|
---|
1281 | Result:=Post(URL);
|
---|
1282 | finally
|
---|
1283 | Free;
|
---|
1284 | end;
|
---|
1285 | end;
|
---|
1286 |
|
---|
1287 | procedure TFPCustomHTTPClient.Put(const URL: string; const Response: TStream);
|
---|
1288 | begin
|
---|
1289 | HTTPMethod('PUT',URL,Response,[]);
|
---|
1290 | end;
|
---|
1291 |
|
---|
1292 | procedure TFPCustomHTTPClient.Put(const URL: string; Response: TStrings);
|
---|
1293 | begin
|
---|
1294 | Response.Text:=Put(URL);
|
---|
1295 | end;
|
---|
1296 |
|
---|
1297 | procedure TFPCustomHTTPClient.Put(const URL: string; const LocalFileName: String
|
---|
1298 | );
|
---|
1299 |
|
---|
1300 | Var
|
---|
1301 | F : TFileStream;
|
---|
1302 |
|
---|
1303 | begin
|
---|
1304 | F:=TFileStream.Create(LocalFileName,fmCreate);
|
---|
1305 | try
|
---|
1306 | Put(URL,F);
|
---|
1307 | finally
|
---|
1308 | F.Free;
|
---|
1309 | end;
|
---|
1310 | end;
|
---|
1311 |
|
---|
1312 | function TFPCustomHTTPClient.Put(const URL: string): String;
|
---|
1313 | Var
|
---|
1314 | SS : TStringStream;
|
---|
1315 | begin
|
---|
1316 | SS:=TStringStream.Create('');
|
---|
1317 | try
|
---|
1318 | Put(URL,SS);
|
---|
1319 | Result:=SS.Datastring;
|
---|
1320 | finally
|
---|
1321 | SS.Free;
|
---|
1322 | end;
|
---|
1323 | end;
|
---|
1324 |
|
---|
1325 | class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
---|
1326 | const Response: TStream);
|
---|
1327 |
|
---|
1328 | begin
|
---|
1329 | With Self.Create(nil) do
|
---|
1330 | try
|
---|
1331 | RequestHeaders.Add('Connection: Close');
|
---|
1332 | Put(URL,Response);
|
---|
1333 | finally
|
---|
1334 | Free;
|
---|
1335 | end;
|
---|
1336 | end;
|
---|
1337 |
|
---|
1338 | class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
---|
1339 | Response: TStrings);
|
---|
1340 |
|
---|
1341 | begin
|
---|
1342 | With Self.Create(nil) do
|
---|
1343 | try
|
---|
1344 | RequestHeaders.Add('Connection: Close');
|
---|
1345 | Put(URL,Response);
|
---|
1346 | finally
|
---|
1347 | Free;
|
---|
1348 | end;
|
---|
1349 | end;
|
---|
1350 |
|
---|
1351 | class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
---|
1352 | const LocalFileName: String);
|
---|
1353 |
|
---|
1354 | begin
|
---|
1355 | With Self.Create(nil) do
|
---|
1356 | try
|
---|
1357 | RequestHeaders.Add('Connection: Close');
|
---|
1358 | Put(URL,LocalFileName);
|
---|
1359 | finally
|
---|
1360 | Free;
|
---|
1361 | end;
|
---|
1362 | end;
|
---|
1363 |
|
---|
1364 | class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
|
---|
1365 |
|
---|
1366 | begin
|
---|
1367 | With Self.Create(nil) do
|
---|
1368 | try
|
---|
1369 | RequestHeaders.Add('Connection: Close');
|
---|
1370 | Result:=Put(URL);
|
---|
1371 | finally
|
---|
1372 | Free;
|
---|
1373 | end;
|
---|
1374 | end;
|
---|
1375 |
|
---|
1376 | procedure TFPCustomHTTPClient.Delete(const URL: string; const Response: TStream
|
---|
1377 | );
|
---|
1378 | begin
|
---|
1379 | HTTPMethod('DELETE',URL,Response,[]);
|
---|
1380 | end;
|
---|
1381 |
|
---|
1382 | procedure TFPCustomHTTPClient.Delete(const URL: string; Response: TStrings);
|
---|
1383 | begin
|
---|
1384 | Response.Text:=Delete(URL);
|
---|
1385 | end;
|
---|
1386 |
|
---|
1387 | procedure TFPCustomHTTPClient.Delete(const URL: string;
|
---|
1388 | const LocalFileName: String);
|
---|
1389 |
|
---|
1390 | Var
|
---|
1391 | F : TFileStream;
|
---|
1392 |
|
---|
1393 | begin
|
---|
1394 | F:=TFileStream.Create(LocalFileName,fmCreate);
|
---|
1395 | try
|
---|
1396 | Delete(URL,F);
|
---|
1397 | finally
|
---|
1398 | F.Free;
|
---|
1399 | end;
|
---|
1400 | end;
|
---|
1401 |
|
---|
1402 | function TFPCustomHTTPClient.Delete(const URL: string): String;
|
---|
1403 | Var
|
---|
1404 | SS : TStringStream;
|
---|
1405 | begin
|
---|
1406 | SS:=TStringStream.Create('');
|
---|
1407 | try
|
---|
1408 | Delete(URL,SS);
|
---|
1409 | Result:=SS.Datastring;
|
---|
1410 | finally
|
---|
1411 | SS.Free;
|
---|
1412 | end;
|
---|
1413 | end;
|
---|
1414 |
|
---|
1415 | class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
---|
1416 | const Response: TStream);
|
---|
1417 |
|
---|
1418 | begin
|
---|
1419 | With Self.Create(nil) do
|
---|
1420 | try
|
---|
1421 | RequestHeaders.Add('Connection: Close');
|
---|
1422 | Delete(URL,Response);
|
---|
1423 | finally
|
---|
1424 | Free;
|
---|
1425 | end;
|
---|
1426 | end;
|
---|
1427 |
|
---|
1428 | class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
---|
1429 | Response: TStrings);
|
---|
1430 |
|
---|
1431 | begin
|
---|
1432 | With Self.Create(nil) do
|
---|
1433 | try
|
---|
1434 | RequestHeaders.Add('Connection: Close');
|
---|
1435 | Delete(URL,Response);
|
---|
1436 | finally
|
---|
1437 | Free;
|
---|
1438 | end;
|
---|
1439 | end;
|
---|
1440 |
|
---|
1441 | class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
---|
1442 | const LocalFileName: String);
|
---|
1443 |
|
---|
1444 | begin
|
---|
1445 | With Self.Create(nil) do
|
---|
1446 | try
|
---|
1447 | RequestHeaders.Add('Connection: Close');
|
---|
1448 | Delete(URL,LocalFileName);
|
---|
1449 | finally
|
---|
1450 | Free;
|
---|
1451 | end;
|
---|
1452 | end;
|
---|
1453 |
|
---|
1454 | class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
|
---|
1455 |
|
---|
1456 | begin
|
---|
1457 | With Self.Create(nil) do
|
---|
1458 | try
|
---|
1459 | RequestHeaders.Add('Connection: Close');
|
---|
1460 | Result:=Delete(URL);
|
---|
1461 | finally
|
---|
1462 | Free;
|
---|
1463 | end;
|
---|
1464 | end;
|
---|
1465 |
|
---|
1466 | procedure TFPCustomHTTPClient.Options(const URL: string; const Response: TStream
|
---|
1467 | );
|
---|
1468 | begin
|
---|
1469 | HTTPMethod('OPTIONS',URL,Response,[]);
|
---|
1470 | end;
|
---|
1471 |
|
---|
1472 | procedure TFPCustomHTTPClient.Options(const URL: string; Response: TStrings);
|
---|
1473 | begin
|
---|
1474 | Response.Text:=Options(URL);
|
---|
1475 | end;
|
---|
1476 |
|
---|
1477 | procedure TFPCustomHTTPClient.Options(const URL: string;
|
---|
1478 | const LocalFileName: String);
|
---|
1479 |
|
---|
1480 | Var
|
---|
1481 | F : TFileStream;
|
---|
1482 |
|
---|
1483 | begin
|
---|
1484 | F:=TFileStream.Create(LocalFileName,fmCreate);
|
---|
1485 | try
|
---|
1486 | Options(URL,F);
|
---|
1487 | finally
|
---|
1488 | F.Free;
|
---|
1489 | end;
|
---|
1490 | end;
|
---|
1491 |
|
---|
1492 | function TFPCustomHTTPClient.Options(const URL: string): String;
|
---|
1493 | Var
|
---|
1494 | SS : TStringStream;
|
---|
1495 | begin
|
---|
1496 | SS:=TStringStream.Create('');
|
---|
1497 | try
|
---|
1498 | Options(URL,SS);
|
---|
1499 | Result:=SS.Datastring;
|
---|
1500 | finally
|
---|
1501 | SS.Free;
|
---|
1502 | end;
|
---|
1503 | end;
|
---|
1504 |
|
---|
1505 | class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
---|
1506 | const Response: TStream);
|
---|
1507 |
|
---|
1508 | begin
|
---|
1509 | With Self.Create(nil) do
|
---|
1510 | try
|
---|
1511 | RequestHeaders.Add('Connection: Close');
|
---|
1512 | Options(URL,Response);
|
---|
1513 | finally
|
---|
1514 | Free;
|
---|
1515 | end;
|
---|
1516 | end;
|
---|
1517 |
|
---|
1518 | class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
---|
1519 | Response: TStrings);
|
---|
1520 |
|
---|
1521 | begin
|
---|
1522 | With Self.Create(nil) do
|
---|
1523 | try
|
---|
1524 | RequestHeaders.Add('Connection: Close');
|
---|
1525 | Options(URL,Response);
|
---|
1526 | finally
|
---|
1527 | Free;
|
---|
1528 | end;
|
---|
1529 | end;
|
---|
1530 |
|
---|
1531 | class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
---|
1532 | const LocalFileName: String);
|
---|
1533 |
|
---|
1534 | begin
|
---|
1535 | With Self.Create(nil) do
|
---|
1536 | try
|
---|
1537 | RequestHeaders.Add('Connection: Close');
|
---|
1538 | Options(URL,LocalFileName);
|
---|
1539 | finally
|
---|
1540 | Free;
|
---|
1541 | end;
|
---|
1542 | end;
|
---|
1543 |
|
---|
1544 | class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
|
---|
1545 |
|
---|
1546 | begin
|
---|
1547 | With Self.Create(nil) do
|
---|
1548 | try
|
---|
1549 | RequestHeaders.Add('Connection: Close');
|
---|
1550 | Result:=Options(URL);
|
---|
1551 | finally
|
---|
1552 | Free;
|
---|
1553 | end;
|
---|
1554 | end;
|
---|
1555 |
|
---|
1556 | class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
|
---|
1557 | begin
|
---|
1558 | With Self.Create(nil) do
|
---|
1559 | try
|
---|
1560 | RequestHeaders.Add('Connection: Close');
|
---|
1561 | HTTPMethod('HEAD', AURL, Nil, [200]);
|
---|
1562 | Headers.Assign(ResponseHeaders);
|
---|
1563 | Finally
|
---|
1564 | Free;
|
---|
1565 | end;
|
---|
1566 | end;
|
---|
1567 |
|
---|
1568 | procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
|
---|
1569 | const Response: TStream);
|
---|
1570 |
|
---|
1571 | begin
|
---|
1572 | RequestBody:=TStringStream.Create(FormData);
|
---|
1573 | try
|
---|
1574 | AddHeader('Content-Type','application/x-www-form-urlencoded');
|
---|
1575 | Post(URL,Response);
|
---|
1576 | finally
|
---|
1577 | RequestBody.Free;
|
---|
1578 | RequestBody:=Nil;
|
---|
1579 | end;
|
---|
1580 | end;
|
---|
1581 |
|
---|
1582 | procedure TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings;
|
---|
1583 | const Response: TStream);
|
---|
1584 |
|
---|
1585 | Var
|
---|
1586 | I : Integer;
|
---|
1587 | S,N,V : String;
|
---|
1588 |
|
---|
1589 | begin
|
---|
1590 | S:='';
|
---|
1591 | For I:=0 to FormData.Count-1 do
|
---|
1592 | begin
|
---|
1593 | If (S<>'') then
|
---|
1594 | S:=S+'&';
|
---|
1595 | FormData.GetNameValue(i,n,v);
|
---|
1596 | S:=S+EncodeURLElement(N)+'='+EncodeURLElement(V);
|
---|
1597 | end;
|
---|
1598 | FormPost(URL,S,Response);
|
---|
1599 | end;
|
---|
1600 |
|
---|
1601 | procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
|
---|
1602 | const Response: TStrings);
|
---|
1603 | begin
|
---|
1604 | Response.Text:=FormPost(URL,FormData);
|
---|
1605 | end;
|
---|
1606 |
|
---|
1607 | procedure TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings;
|
---|
1608 | const Response: TStrings);
|
---|
1609 | begin
|
---|
1610 | Response.Text:=FormPost(URL,FormData);
|
---|
1611 | end;
|
---|
1612 |
|
---|
1613 | function TFPCustomHTTPClient.FormPost(const URL, FormData: string): String;
|
---|
1614 | Var
|
---|
1615 | SS : TStringStream;
|
---|
1616 | begin
|
---|
1617 | SS:=TStringStream.Create('');
|
---|
1618 | try
|
---|
1619 | FormPost(URL,FormData,SS);
|
---|
1620 | Result:=SS.Datastring;
|
---|
1621 | finally
|
---|
1622 | SS.Free;
|
---|
1623 | end;
|
---|
1624 | end;
|
---|
1625 |
|
---|
1626 | function TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings): String;
|
---|
1627 | Var
|
---|
1628 | SS : TStringStream;
|
---|
1629 | begin
|
---|
1630 | SS:=TStringStream.Create('');
|
---|
1631 | try
|
---|
1632 | FormPost(URL,FormData,SS);
|
---|
1633 | Result:=SS.Datastring;
|
---|
1634 | finally
|
---|
1635 | SS.Free;
|
---|
1636 | end;
|
---|
1637 | end;
|
---|
1638 |
|
---|
1639 | class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
|
---|
1640 | const Response: TStream);
|
---|
1641 |
|
---|
1642 | begin
|
---|
1643 | With Self.Create(nil) do
|
---|
1644 | try
|
---|
1645 | RequestHeaders.Add('Connection: Close');
|
---|
1646 | FormPost(URL,FormData,Response);
|
---|
1647 | Finally
|
---|
1648 | Free;
|
---|
1649 | end;
|
---|
1650 | end;
|
---|
1651 |
|
---|
1652 |
|
---|
1653 | class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
---|
1654 | FormData: TStrings; const Response: TStream);
|
---|
1655 |
|
---|
1656 | begin
|
---|
1657 | With Self.Create(nil) do
|
---|
1658 | try
|
---|
1659 | RequestHeaders.Add('Connection: Close');
|
---|
1660 | FormPost(URL,FormData,Response);
|
---|
1661 | Finally
|
---|
1662 | Free;
|
---|
1663 | end;
|
---|
1664 | end;
|
---|
1665 |
|
---|
1666 |
|
---|
1667 | class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
|
---|
1668 | const Response: TStrings);
|
---|
1669 |
|
---|
1670 | begin
|
---|
1671 | With Self.Create(nil) do
|
---|
1672 | try
|
---|
1673 | RequestHeaders.Add('Connection: Close');
|
---|
1674 | FormPost(URL,FormData,Response);
|
---|
1675 | Finally
|
---|
1676 | Free;
|
---|
1677 | end;
|
---|
1678 | end;
|
---|
1679 |
|
---|
1680 | class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
---|
1681 | FormData: TStrings; const Response: TStrings);
|
---|
1682 |
|
---|
1683 | begin
|
---|
1684 | With Self.Create(nil) do
|
---|
1685 | try
|
---|
1686 | RequestHeaders.Add('Connection: Close');
|
---|
1687 | FormPost(URL,FormData,Response);
|
---|
1688 | Finally
|
---|
1689 | Free;
|
---|
1690 | end;
|
---|
1691 | end;
|
---|
1692 |
|
---|
1693 | class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
|
---|
1694 | ): String;
|
---|
1695 |
|
---|
1696 | begin
|
---|
1697 | With Self.Create(nil) do
|
---|
1698 | try
|
---|
1699 | RequestHeaders.Add('Connection: Close');
|
---|
1700 | Result:=FormPost(URL,FormData);
|
---|
1701 | Finally
|
---|
1702 | Free;
|
---|
1703 | end;
|
---|
1704 | end;
|
---|
1705 |
|
---|
1706 | class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
---|
1707 | FormData: TStrings): String;
|
---|
1708 |
|
---|
1709 | begin
|
---|
1710 | With Self.Create(nil) do
|
---|
1711 | try
|
---|
1712 | RequestHeaders.Add('Connection: Close');
|
---|
1713 | Result:=FormPost(URL,FormData);
|
---|
1714 | Finally
|
---|
1715 | Free;
|
---|
1716 | end;
|
---|
1717 | end;
|
---|
1718 |
|
---|
1719 |
|
---|
1720 | procedure TFPCustomHTTPClient.FileFormPost(const AURL, AFieldName,
|
---|
1721 | AFileName: string; const Response: TStream);
|
---|
1722 | begin
|
---|
1723 | FileFormPost(AURL, nil, AFieldName, AFileName, Response);
|
---|
1724 | end;
|
---|
1725 |
|
---|
1726 | procedure TFPCustomHTTPClient.FileFormPost(const AURL: string;
|
---|
1727 | FormData: TStrings; AFieldName, AFileName: string; const Response: TStream);
|
---|
1728 | var
|
---|
1729 | F: TFileStream;
|
---|
1730 | begin
|
---|
1731 | F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
|
---|
1732 | try
|
---|
1733 | StreamFormPost(AURL, FormData, AFieldName, ExtractFileName(AFileName), F, Response);
|
---|
1734 | finally
|
---|
1735 | F.Free;
|
---|
1736 | end;
|
---|
1737 | end;
|
---|
1738 |
|
---|
1739 | procedure TFPCustomHTTPClient.StreamFormPost(const AURL, AFieldName,
|
---|
1740 | AFileName: string; const AStream: TStream; const Response: TStream);
|
---|
1741 | begin
|
---|
1742 | StreamFormPost(AURL, nil, AFieldName, AFileName, AStream, Response);
|
---|
1743 | end;
|
---|
1744 |
|
---|
1745 | procedure TFPCustomHTTPClient.StreamFormPost(const AURL: string;
|
---|
1746 | FormData: TStrings; const AFieldName, AFileName: string;
|
---|
1747 | const AStream: TStream; const Response: TStream);
|
---|
1748 | Var
|
---|
1749 | S, Sep : string;
|
---|
1750 | SS : TStringStream;
|
---|
1751 | I: Integer;
|
---|
1752 | N,V: String;
|
---|
1753 | begin
|
---|
1754 | Sep:=Format('%.8x_multipart_boundary',[Random($ffffff)]);
|
---|
1755 | AddHeader('Content-Type','multipart/form-data; boundary='+Sep);
|
---|
1756 | SS:=TStringStream.Create('');
|
---|
1757 | try
|
---|
1758 | if (FormData<>Nil) then
|
---|
1759 | for I:=0 to FormData.Count -1 do
|
---|
1760 | begin
|
---|
1761 | // not url encoded
|
---|
1762 | FormData.GetNameValue(I,N,V);
|
---|
1763 | S :='--'+Sep+CRLF;
|
---|
1764 | S:=S+Format('Content-Disposition: form-data; name="%s"'+CRLF+CRLF+'%s'+CRLF,[N, V]);
|
---|
1765 | SS.WriteBuffer(S[1],Length(S));
|
---|
1766 | end;
|
---|
1767 | S:='--'+Sep+CRLF;
|
---|
1768 | s:=s+Format('Content-Disposition: form-data; name="%s"; filename="%s"'+CRLF,[AFieldName,ExtractFileName(AFileName)]);
|
---|
1769 | s:=s+'Content-Type: application/octet-string'+CRLF+CRLF;
|
---|
1770 | SS.WriteBuffer(S[1],Length(S));
|
---|
1771 | AStream.Seek(0, soFromBeginning);
|
---|
1772 | SS.CopyFrom(AStream,AStream.Size);
|
---|
1773 | S:=CRLF+'--'+Sep+'--'+CRLF;
|
---|
1774 | SS.WriteBuffer(S[1],Length(S));
|
---|
1775 | SS.Position:=0;
|
---|
1776 | RequestBody:=SS;
|
---|
1777 | Post(AURL,Response);
|
---|
1778 | finally
|
---|
1779 | RequestBody:=Nil;
|
---|
1780 | SS.Free;
|
---|
1781 | end;
|
---|
1782 | end;
|
---|
1783 |
|
---|
1784 |
|
---|
1785 | class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
|
---|
1786 | AFileName: string; const Response: TStream);
|
---|
1787 |
|
---|
1788 | begin
|
---|
1789 | With Self.Create(nil) do
|
---|
1790 | try
|
---|
1791 | RequestHeaders.Add('Connection: Close');
|
---|
1792 | FileFormPost(AURL,AFieldName,AFileName,Response);
|
---|
1793 | Finally
|
---|
1794 | Free;
|
---|
1795 | end;
|
---|
1796 | end;
|
---|
1797 |
|
---|
1798 | end.
|
---|
1799 |
|
---|