source: trunk/Packages/synapse/httpsend.pas

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