source: trunk/Packages/synapse/source/lib/httpsend.pas

Last change on this file was 2, checked in by chronos, 13 years ago
  • Přidáno: Základní kostra projektu.
  • Přidáno: Knihovna synapse.
File size: 27.4 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 003.012.006 |
3|==============================================================================|
4| Content: HTTP client |
5|==============================================================================|
6| Copyright (c)1999-2011, Lukas Gebauer |
7| All rights reserved. |
8| |
9| Redistribution and use in source and binary forms, with or without |
10| modification, are permitted provided that the following conditions are met: |
11| |
12| Redistributions of source code must retain the above copyright notice, this |
13| list of conditions and the following disclaimer. |
14| |
15| Redistributions in binary form must reproduce the above copyright notice, |
16| this list of conditions and the following disclaimer in the documentation |
17| and/or other materials provided with the distribution. |
18| |
19| Neither the name of Lukas Gebauer nor the names of its contributors may |
20| be used to endorse or promote products derived from this software without |
21| specific prior written permission. |
22| |
23| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
24| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
25| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
26| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
27| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
28| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
29| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
30| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
31| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
32| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
33| DAMAGE. |
34|==============================================================================|
35| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
36| Portions created by Lukas Gebauer are Copyright (c) 1999-2011. |
37| All Rights Reserved. |
38|==============================================================================|
39| Contributor(s): |
40|==============================================================================|
41| History: see HISTORY.HTM from distribution package |
42| (Found at URL: http://www.ararat.cz/synapse/) |
43|==============================================================================}
44
45{:@abstract(HTTP protocol client)
46
47Used RFC: RFC-1867, RFC-1947, RFC-2388, RFC-2616
48}
49
50{$IFDEF FPC}
51 {$MODE DELPHI}
52{$ENDIF}
53{$H+}
54//old Delphi does not have MSWINDOWS define.
55{$IFDEF WIN32}
56 {$IFNDEF MSWINDOWS}
57 {$DEFINE MSWINDOWS}
58 {$ENDIF}
59{$ENDIF}
60
61{$IFDEF UNICODE}
62 {$WARN IMPLICIT_STRING_CAST OFF}
63 {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
64{$ENDIF}
65
66unit httpsend;
67
68interface
69
70uses
71 SysUtils, Classes,
72 blcksock, synautil, synaip, synacode, synsock;
73
74const
75 cHttpProtocol = '80';
76
77type
78 {:These encoding types are used internally by the THTTPSend object to identify
79 the transfer data types.}
80 TTransferEncoding = (TE_UNKNOWN, TE_IDENTITY, TE_CHUNKED);
81
82 {:abstract(Implementation of HTTP protocol.)}
83 THTTPSend = class(TSynaClient)
84 protected
85 FSock: TTCPBlockSocket;
86 FTransferEncoding: TTransferEncoding;
87 FAliveHost: string;
88 FAlivePort: string;
89 FHeaders: TStringList;
90 FDocument: TMemoryStream;
91 FMimeType: string;
92 FProtocol: string;
93 FKeepAlive: Boolean;
94 FKeepAliveTimeout: integer;
95 FStatus100: Boolean;
96 FProxyHost: string;
97 FProxyPort: string;
98 FProxyUser: string;
99 FProxyPass: string;
100 FResultCode: Integer;
101 FResultString: string;
102 FUserAgent: string;
103 FCookies: TStringList;
104 FDownloadSize: integer;
105 FUploadSize: integer;
106 FRangeStart: integer;
107 FRangeEnd: integer;
108 FAddPortNumberToHost: Boolean;
109 function ReadUnknown: Boolean;
110 function ReadIdentity(Size: Integer): Boolean;
111 function ReadChunked: Boolean;
112 procedure ParseCookies;
113 function PrepareHeaders: AnsiString;
114 function InternalDoConnect(needssl: Boolean): Boolean;
115 function InternalConnect(needssl: Boolean): Boolean;
116 public
117 constructor Create;
118 destructor Destroy; override;
119
120 {:Reset headers and document and Mimetype.}
121 procedure Clear;
122
123 {:Decode ResultCode and ResultString from Value.}
124 procedure DecodeStatus(const Value: string);
125
126 {:Connects to host define in URL and access to resource defined in URL by
127 method. If Document is not empty, send it to server as part of HTTP request.
128 Server response is in Document and headers. Connection may be authorised
129 by username and password in URL. If you define proxy properties, connection
130 is made by this proxy. If all OK, result is @true, else result is @false.
131
132 If you use in URL 'https:' instead only 'http:', then your request is made
133 by SSL/TLS connection (if you not specify port, then port 443 is used
134 instead standard port 80). If you use SSL/TLS request and you have defined
135 HTTP proxy, then HTTP-tunnel mode is automaticly used .}
136 function HTTPMethod(const Method, URL: string): Boolean;
137
138 {:You can call this method from OnStatus event for break current data
139 transfer. (or from another thread.)}
140 procedure Abort;
141 published
142 {:Before HTTP operation you may define any non-standard headers for HTTP
143 request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type',
144 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.
145 After HTTP operation contains full headers of returned document.}
146 property Headers: TStringList read FHeaders;
147
148 {:This is stringlist with name-value stringlist pairs. Each this pair is one
149 cookie. After HTTP request is returned cookies parsed to this stringlist.
150 You can leave this cookies untouched for next HTTP request. You can also
151 save this stringlist for later use.}
152 property Cookies: TStringList read FCookies;
153
154 {:Stream with document to send (before request, or with document received
155 from HTTP server (after request).}
156 property Document: TMemoryStream read FDocument;
157
158 {:If you need download only part of requested document, here specify
159 possition of subpart begin. If here 0, then is requested full document.}
160 property RangeStart: integer read FRangeStart Write FRangeStart;
161
162 {:If you need download only part of requested document, here specify
163 possition of subpart end. If here 0, then is requested document from
164 rangeStart to end of document. (for broken download restoration,
165 for example.)}
166 property RangeEnd: integer read FRangeEnd Write FRangeEnd;
167
168 {:Mime type of sending data. Default is: 'text/html'.}
169 property MimeType: string read FMimeType Write FMimeType;
170
171 {:Define protocol version. Possible values are: '1.1', '1.0' (default)
172 and '0.9'.}
173 property Protocol: string read FProtocol Write FProtocol;
174
175 {:If @true (default value), keepalives in HTTP protocol 1.1 is enabled.}
176 property KeepAlive: Boolean read FKeepAlive Write FKeepAlive;
177
178 {:Define timeout for keepalives in seconds!}
179 property KeepAliveTimeout: integer read FKeepAliveTimeout Write FKeepAliveTimeout;
180
181 {:if @true, then server is requested for 100status capability when uploading
182 data. Default is @false (off).}
183 property Status100: Boolean read FStatus100 Write FStatus100;
184
185 {:Address of proxy server (IP address or domain name) where you want to
186 connect in @link(HTTPMethod) method.}
187 property ProxyHost: string read FProxyHost Write FProxyHost;
188
189 {:Port number for proxy connection. Default value is 8080.}
190 property ProxyPort: string read FProxyPort Write FProxyPort;
191
192 {:Username for connect to proxy server where you want to connect in
193 HTTPMethod method.}
194 property ProxyUser: string read FProxyUser Write FProxyUser;
195
196 {:Password for connect to proxy server where you want to connect in
197 HTTPMethod method.}
198 property ProxyPass: string read FProxyPass Write FProxyPass;
199
200 {:Here you can specify custom User-Agent indentification. By default is
201 used: 'Mozilla/4.0 (compatible; Synapse)'}
202 property UserAgent: string read FUserAgent Write FUserAgent;
203
204 {:After successful @link(HTTPMethod) method contains result code of
205 operation.}
206 property ResultCode: Integer read FResultCode;
207
208 {:After successful @link(HTTPMethod) method contains string after result code.}
209 property ResultString: string read FResultString;
210
211 {:if this value is not 0, then data download pending. In this case you have
212 here total sice of downloaded data. It is good for draw download
213 progressbar from OnStatus event.}
214 property DownloadSize: integer read FDownloadSize;
215
216 {:if this value is not 0, then data upload pending. In this case you have
217 here total sice of uploaded data. It is good for draw upload progressbar
218 from OnStatus event.}
219 property UploadSize: integer read FUploadSize;
220 {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
221 property Sock: TTCPBlockSocket read FSock;
222
223 {:To have possibility to switch off port number in 'Host:' HTTP header, by
224 default @TRUE. Some buggy servers not like port informations in this header.}
225 property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
226 end;
227
228{:A very usefull function, and example of use can be found in the THTTPSend
229 object. It implements the GET method of the HTTP protocol. This function sends
230 the GET method for URL document to an HTTP server. Returned document is in the
231 "Response" stringlist (without any headers). Returns boolean TRUE if all went
232 well.}
233function HttpGetText(const URL: string; const Response: TStrings): Boolean;
234
235{:A very usefull function, and example of use can be found in the THTTPSend
236 object. It implements the GET method of the HTTP protocol. This function sends
237 the GET method for URL document to an HTTP server. Returned document is in the
238 "Response" stream. Returns boolean TRUE if all went well.}
239function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
240
241{:A very useful function, and example of use can be found in the THTTPSend
242 object. It implements the POST method of the HTTP protocol. This function sends
243 the SEND method for a URL document to an HTTP server. The document to be sent
244 is located in "Data" stream. The returned document is in the "Data" stream.
245 Returns boolean TRUE if all went well.}
246function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
247
248{:A very useful function, and example of use can be found in the THTTPSend
249 object. It implements the POST method of the HTTP protocol. This function is
250 good for POSTing form data. It sends the POST method for a URL document to
251 an HTTP server. You must prepare the form data in the same manner as you would
252 the URL data, and pass this prepared data to "URLdata". The following is
253 a sample of how the data would appear: 'name=Lukas&field1=some%20data'.
254 The information in the field must be encoded by EncodeURLElement function.
255 The returned document is in the "Data" stream. Returns boolean TRUE if all
256 went well.}
257function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
258
259{:A very useful function, and example of use can be found in the THTTPSend
260 object. It implements the POST method of the HTTP protocol. This function sends
261 the POST method for a URL document to an HTTP server. This function simulate
262 posting of file by HTML form used method 'multipart/form-data'. Posting file
263 is in DATA stream. Its name is Filename string. Fieldname is for name of
264 formular field with file. (simulate HTML INPUT FILE) The returned document is
265 in the ResultData Stringlist. Returns boolean TRUE if all went well.}
266function HttpPostFile(const URL, FieldName, FileName: string;
267 const Data: TStream; const ResultData: TStrings): Boolean;
268
269implementation
270
271constructor THTTPSend.Create;
272begin
273 inherited Create;
274 FHeaders := TStringList.Create;
275 FCookies := TStringList.Create;
276 FDocument := TMemoryStream.Create;
277 FSock := TTCPBlockSocket.Create;
278 FSock.Owner := self;
279 FSock.ConvertLineEnd := True;
280 FSock.SizeRecvBuffer := c64k;
281 FSock.SizeSendBuffer := c64k;
282 FTimeout := 90000;
283 FTargetPort := cHttpProtocol;
284 FProxyHost := '';
285 FProxyPort := '8080';
286 FProxyUser := '';
287 FProxyPass := '';
288 FAliveHost := '';
289 FAlivePort := '';
290 FProtocol := '1.0';
291 FKeepAlive := True;
292 FStatus100 := False;
293 FUserAgent := 'Mozilla/4.0 (compatible; Synapse)';
294 FDownloadSize := 0;
295 FUploadSize := 0;
296 FAddPortNumberToHost := true;
297 FKeepAliveTimeout := 300;
298 Clear;
299end;
300
301destructor THTTPSend.Destroy;
302begin
303 FSock.Free;
304 FDocument.Free;
305 FCookies.Free;
306 FHeaders.Free;
307 inherited Destroy;
308end;
309
310procedure THTTPSend.Clear;
311begin
312 FRangeStart := 0;
313 FRangeEnd := 0;
314 FDocument.Clear;
315 FHeaders.Clear;
316 FMimeType := 'text/html';
317end;
318
319procedure THTTPSend.DecodeStatus(const Value: string);
320var
321 s, su: string;
322begin
323 s := Trim(SeparateRight(Value, ' '));
324 su := Trim(SeparateLeft(s, ' '));
325 FResultCode := StrToIntDef(su, 0);
326 FResultString := Trim(SeparateRight(s, ' '));
327 if FResultString = s then
328 FResultString := '';
329end;
330
331function THTTPSend.PrepareHeaders: AnsiString;
332begin
333 if FProtocol = '0.9' then
334 Result := FHeaders[0] + CRLF
335 else
336{$IFNDEF MSWINDOWS}
337 Result := {$IFDEF UNICODE}AnsiString{$ENDIF}(AdjustLineBreaks(FHeaders.Text, tlbsCRLF));
338{$ELSE}
339 Result := FHeaders.Text;
340{$ENDIF}
341end;
342
343function THTTPSend.InternalDoConnect(needssl: Boolean): Boolean;
344begin
345 Result := False;
346 FSock.CloseSocket;
347 FSock.Bind(FIPInterface, cAnyPort);
348 if FSock.LastError <> 0 then
349 Exit;
350 FSock.Connect(FTargetHost, FTargetPort);
351 if FSock.LastError <> 0 then
352 Exit;
353 if needssl then
354 begin
355 if (FSock.SSL.SNIHost='') then
356 FSock.SSL.SNIHost:=FTargetHost;
357 FSock.SSLDoConnect;
358 FSock.SSL.SNIHost:=''; //don't need it anymore and don't wan't to reuse it in next connection
359 if FSock.LastError <> 0 then
360 Exit;
361 end;
362 FAliveHost := FTargetHost;
363 FAlivePort := FTargetPort;
364 Result := True;
365end;
366
367function THTTPSend.InternalConnect(needssl: Boolean): Boolean;
368begin
369 if FSock.Socket = INVALID_SOCKET then
370 Result := InternalDoConnect(needssl)
371 else
372 if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort)
373 or FSock.CanRead(0) then
374 Result := InternalDoConnect(needssl)
375 else
376 Result := True;
377end;
378
379function THTTPSend.HTTPMethod(const Method, URL: string): Boolean;
380var
381 Sending, Receiving: Boolean;
382 status100: Boolean;
383 status100error: string;
384 ToClose: Boolean;
385 Size: Integer;
386 Prot, User, Pass, Host, Port, Path, Para, URI: string;
387 s, su: AnsiString;
388 HttpTunnel: Boolean;
389 n: integer;
390 pp: string;
391 UsingProxy: boolean;
392 l: TStringList;
393 x: integer;
394begin
395 {initial values}
396 Result := False;
397 FResultCode := 500;
398 FResultString := '';
399 FDownloadSize := 0;
400 FUploadSize := 0;
401
402 URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
403 User := DecodeURL(user);
404 Pass := DecodeURL(pass);
405 if User = '' then
406 begin
407 User := FUsername;
408 Pass := FPassword;
409 end;
410 if UpperCase(Prot) = 'HTTPS' then
411 begin
412 HttpTunnel := FProxyHost <> '';
413 FSock.HTTPTunnelIP := FProxyHost;
414 FSock.HTTPTunnelPort := FProxyPort;
415 FSock.HTTPTunnelUser := FProxyUser;
416 FSock.HTTPTunnelPass := FProxyPass;
417 end
418 else
419 begin
420 HttpTunnel := False;
421 FSock.HTTPTunnelIP := '';
422 FSock.HTTPTunnelPort := '';
423 FSock.HTTPTunnelUser := '';
424 FSock.HTTPTunnelPass := '';
425 end;
426 UsingProxy := (FProxyHost <> '') and not(HttpTunnel);
427 Sending := FDocument.Size > 0;
428 {Headers for Sending data}
429 status100 := FStatus100 and Sending and (FProtocol = '1.1');
430 if status100 then
431 FHeaders.Insert(0, 'Expect: 100-continue');
432 if Sending then
433 begin
434 FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
435 if FMimeType <> '' then
436 FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
437 end;
438 { setting User-agent }
439 if FUserAgent <> '' then
440 FHeaders.Insert(0, 'User-Agent: ' + FUserAgent);
441 { setting Ranges }
442 if (FRangeStart > 0) or (FRangeEnd > 0) then
443 begin
444 if FRangeEnd >= FRangeStart then
445 FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd))
446 else
447 FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-');
448 end;
449 { setting Cookies }
450 s := '';
451 for n := 0 to FCookies.Count - 1 do
452 begin
453 if s <> '' then
454 s := s + '; ';
455 s := s + FCookies[n];
456 end;
457 if s <> '' then
458 FHeaders.Insert(0, 'Cookie: ' + s);
459 { setting KeepAlives }
460 pp := '';
461 if UsingProxy then
462 pp := 'Proxy-';
463 if FKeepAlive then
464 begin
465 FHeaders.Insert(0, pp + 'Connection: keep-alive');
466 FHeaders.Insert(0, 'Keep-Alive: ' + IntToStr(FKeepAliveTimeout));
467 end
468 else
469 FHeaders.Insert(0, pp + 'Connection: close');
470 { set target servers/proxy, authorizations, etc... }
471 if User <> '' then
472 FHeaders.Insert(0, 'Authorization: Basic ' + EncodeBase64(User + ':' + Pass));
473 if UsingProxy and (FProxyUser <> '') then
474 FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
475 EncodeBase64(FProxyUser + ':' + FProxyPass));
476 if isIP6(Host) then
477 s := '[' + Host + ']'
478 else
479 s := Host;
480 if FAddPortNumberToHost and (Port <> '80') then
481 FHeaders.Insert(0, 'Host: ' + s + ':' + Port)
482 else
483 FHeaders.Insert(0, 'Host: ' + s);
484 if UsingProxy then
485 URI := Prot + '://' + s + ':' + Port + URI;
486 if URI = '/*' then
487 URI := '*';
488 if FProtocol = '0.9' then
489 FHeaders.Insert(0, UpperCase(Method) + ' ' + URI)
490 else
491 FHeaders.Insert(0, UpperCase(Method) + ' ' + URI + ' HTTP/' + FProtocol);
492 if UsingProxy then
493 begin
494 FTargetHost := FProxyHost;
495 FTargetPort := FProxyPort;
496 end
497 else
498 begin
499 FTargetHost := Host;
500 FTargetPort := Port;
501 end;
502 if FHeaders[FHeaders.Count - 1] <> '' then
503 FHeaders.Add('');
504
505 { connect }
506 if not InternalConnect(UpperCase(Prot) = 'HTTPS') then
507 begin
508 FAliveHost := '';
509 FAlivePort := '';
510 Exit;
511 end;
512
513 { reading Status }
514 FDocument.Position := 0;
515 Status100Error := '';
516 if status100 then
517 begin
518 { send Headers }
519 FSock.SendString(PrepareHeaders);
520 if FSock.LastError <> 0 then
521 Exit;
522 repeat
523 s := FSock.RecvString(FTimeout);
524 if s <> '' then
525 Break;
526 until FSock.LastError <> 0;
527 DecodeStatus(s);
528 Status100Error := s;
529 repeat
530 s := FSock.recvstring(FTimeout);
531 if s = '' then
532 Break;
533 until FSock.LastError <> 0;
534 if (FResultCode >= 100) and (FResultCode < 200) then
535 begin
536 { we can upload content }
537 Status100Error := '';
538 FUploadSize := FDocument.Size;
539 FSock.SendBuffer(FDocument.Memory, FDocument.Size);
540 end;
541 end
542 else
543 { upload content }
544 if sending then
545 begin
546 if FDocument.Size >= c64k then
547 begin
548 FSock.SendString(PrepareHeaders);
549 FUploadSize := FDocument.Size;
550 FSock.SendBuffer(FDocument.Memory, FDocument.Size);
551 end
552 else
553 begin
554 s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size);
555 FUploadSize := Length(s);
556 FSock.SendString(s);
557 end;
558 end
559 else
560 begin
561 { we not need to upload document, send headers only }
562 FSock.SendString(PrepareHeaders);
563 end;
564
565 if FSock.LastError <> 0 then
566 Exit;
567
568 Clear;
569 Size := -1;
570 FTransferEncoding := TE_UNKNOWN;
571
572 { read status }
573 if Status100Error = '' then
574 begin
575 repeat
576 repeat
577 s := FSock.RecvString(FTimeout);
578 if s <> '' then
579 Break;
580 until FSock.LastError <> 0;
581 if Pos('HTTP/', UpperCase(s)) = 1 then
582 begin
583 FHeaders.Add(s);
584 DecodeStatus(s);
585 end
586 else
587 begin
588 { old HTTP 0.9 and some buggy servers not send result }
589 s := s + CRLF;
590 WriteStrToStream(FDocument, s);
591 FResultCode := 0;
592 end;
593 until (FSock.LastError <> 0) or (FResultCode <> 100);
594 end
595 else
596 FHeaders.Add(Status100Error);
597
598 { if need receive headers, receive and parse it }
599 ToClose := FProtocol <> '1.1';
600 if FHeaders.Count > 0 then
601 begin
602 l := TStringList.Create;
603 try
604 repeat
605 s := FSock.RecvString(FTimeout);
606 l.Add(s);
607 if s = '' then
608 Break;
609 until FSock.LastError <> 0;
610 x := 0;
611 while l.Count > x do
612 begin
613 s := NormalizeHeader(l, x);
614 FHeaders.Add(s);
615 su := UpperCase(s);
616 if Pos('CONTENT-LENGTH:', su) = 1 then
617 begin
618 Size := StrToIntDef(Trim(SeparateRight(s, ' ')), -1);
619 if (Size <> -1) and (FTransferEncoding = TE_UNKNOWN) then
620 FTransferEncoding := TE_IDENTITY;
621 end;
622 if Pos('CONTENT-TYPE:', su) = 1 then
623 FMimeType := Trim(SeparateRight(s, ' '));
624 if Pos('TRANSFER-ENCODING:', su) = 1 then
625 begin
626 s := Trim(SeparateRight(su, ' '));
627 if Pos('CHUNKED', s) > 0 then
628 FTransferEncoding := TE_CHUNKED;
629 end;
630 if UsingProxy then
631 begin
632 if Pos('PROXY-CONNECTION:', su) = 1 then
633 if Pos('CLOSE', su) > 0 then
634 ToClose := True;
635 end
636 else
637 begin
638 if Pos('CONNECTION:', su) = 1 then
639 if Pos('CLOSE', su) > 0 then
640 ToClose := True;
641 end;
642 end;
643 finally
644 l.free;
645 end;
646 end;
647
648 Result := FSock.LastError = 0;
649 if not Result then
650 Exit;
651
652 {if need receive response body, read it}
653 Receiving := Method <> 'HEAD';
654 Receiving := Receiving and (FResultCode <> 204);
655 Receiving := Receiving and (FResultCode <> 304);
656 if Receiving then
657 case FTransferEncoding of
658 TE_UNKNOWN:
659 Result := ReadUnknown;
660 TE_IDENTITY:
661 Result := ReadIdentity(Size);
662 TE_CHUNKED:
663 Result := ReadChunked;
664 end;
665
666 FDocument.Seek(0, soFromBeginning);
667 if ToClose then
668 begin
669 FSock.CloseSocket;
670 FAliveHost := '';
671 FAlivePort := '';
672 end;
673 ParseCookies;
674end;
675
676function THTTPSend.ReadUnknown: Boolean;
677var
678 s: ansistring;
679begin
680 Result := false;
681 repeat
682 s := FSock.RecvPacket(FTimeout);
683 if FSock.LastError = 0 then
684 WriteStrToStream(FDocument, s);
685 until FSock.LastError <> 0;
686 if FSock.LastError = WSAECONNRESET then
687 begin
688 Result := true;
689 FSock.ResetLastError;
690 end;
691end;
692
693function THTTPSend.ReadIdentity(Size: Integer): Boolean;
694begin
695 if Size > 0 then
696 begin
697 FDownloadSize := Size;
698 FSock.RecvStreamSize(FDocument, FTimeout, Size);
699 FDocument.Position := FDocument.Size;
700 Result := FSock.LastError = 0;
701 end
702 else
703 Result := true;
704end;
705
706function THTTPSend.ReadChunked: Boolean;
707var
708 s: ansistring;
709 Size: Integer;
710begin
711 repeat
712 repeat
713 s := FSock.RecvString(FTimeout);
714 until (s <> '') or (FSock.LastError <> 0);
715 if FSock.LastError <> 0 then
716 Break;
717 s := Trim(SeparateLeft(s, ' '));
718 s := Trim(SeparateLeft(s, ';'));
719 Size := StrToIntDef('$' + s, 0);
720 if Size = 0 then
721 Break;
722 if not ReadIdentity(Size) then
723 break;
724 until False;
725 Result := FSock.LastError = 0;
726end;
727
728procedure THTTPSend.ParseCookies;
729var
730 n: integer;
731 s: string;
732 sn, sv: string;
733begin
734 for n := 0 to FHeaders.Count - 1 do
735 if Pos('set-cookie:', lowercase(FHeaders[n])) = 1 then
736 begin
737 s := SeparateRight(FHeaders[n], ':');
738 s := trim(SeparateLeft(s, ';'));
739 sn := trim(SeparateLeft(s, '='));
740 sv := trim(SeparateRight(s, '='));
741 FCookies.Values[sn] := sv;
742 end;
743end;
744
745procedure THTTPSend.Abort;
746begin
747 FSock.StopFlag := True;
748end;
749
750{==============================================================================}
751
752function HttpGetText(const URL: string; const Response: TStrings): Boolean;
753var
754 HTTP: THTTPSend;
755begin
756 HTTP := THTTPSend.Create;
757 try
758 Result := HTTP.HTTPMethod('GET', URL);
759 if Result then
760 Response.LoadFromStream(HTTP.Document);
761 finally
762 HTTP.Free;
763 end;
764end;
765
766function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
767var
768 HTTP: THTTPSend;
769begin
770 HTTP := THTTPSend.Create;
771 try
772 Result := HTTP.HTTPMethod('GET', URL);
773 if Result then
774 begin
775 Response.Seek(0, soFromBeginning);
776 Response.CopyFrom(HTTP.Document, 0);
777 end;
778 finally
779 HTTP.Free;
780 end;
781end;
782
783function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
784var
785 HTTP: THTTPSend;
786begin
787 HTTP := THTTPSend.Create;
788 try
789 HTTP.Document.CopyFrom(Data, 0);
790 HTTP.MimeType := 'Application/octet-stream';
791 Result := HTTP.HTTPMethod('POST', URL);
792 Data.Size := 0;
793 if Result then
794 begin
795 Data.Seek(0, soFromBeginning);
796 Data.CopyFrom(HTTP.Document, 0);
797 end;
798 finally
799 HTTP.Free;
800 end;
801end;
802
803function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
804var
805 HTTP: THTTPSend;
806begin
807 HTTP := THTTPSend.Create;
808 try
809 WriteStrToStream(HTTP.Document, URLData);
810 HTTP.MimeType := 'application/x-www-form-urlencoded';
811 Result := HTTP.HTTPMethod('POST', URL);
812 if Result then
813 Data.CopyFrom(HTTP.Document, 0);
814 finally
815 HTTP.Free;
816 end;
817end;
818
819function HttpPostFile(const URL, FieldName, FileName: string;
820 const Data: TStream; const ResultData: TStrings): Boolean;
821var
822 HTTP: THTTPSend;
823 Bound, s: string;
824begin
825 Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
826 HTTP := THTTPSend.Create;
827 try
828 s := '--' + Bound + CRLF;
829 s := s + 'content-disposition: form-data; name="' + FieldName + '";';
830 s := s + ' filename="' + FileName +'"' + CRLF;
831 s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
832 WriteStrToStream(HTTP.Document, s);
833 HTTP.Document.CopyFrom(Data, 0);
834 s := CRLF + '--' + Bound + '--' + CRLF;
835 WriteStrToStream(HTTP.Document, s);
836 HTTP.MimeType := 'multipart/form-data; boundary=' + Bound;
837 Result := HTTP.HTTPMethod('POST', URL);
838 if Result then
839 ResultData.LoadFromStream(HTTP.Document);
840 finally
841 HTTP.Free;
842 end;
843end;
844
845end.
Note: See TracBrowser for help on using the repository browser.