📄 overbyte.ics.httpclient.pas
字号:
{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: Fran鏾is PIETTE
Creation: November 23, 1997 (Win32 version)
Version: 1.80
Description: THttpCli is an implementation for the HTTP protocol
RFC 1945 (V1.0), and some of RFC 2068 (V1.1)
Credit: This component was based on a freeware from by Andreas
Hoerstemeier and used with his permission.
andy@hoerstemeier.de http://www.hoerstemeier.com/index.htm
EMail: http://www.overbyte.be http://www.rtfm.be/fpiette
francois.piette@overbyte.be francois.piette@rtfm.be
francois.piette@pophost.eunet.be
Support: Use the mailing list twsocket@elists.org
Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1997-2005 by Fran鏾is PIETTE
Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
<francois.piette@overbyte.be>
This software is provided 'as-is', without any express or
implied warranty. In no event will the author be held liable
for any damages arising from the use of this software.
Permission is granted to anyone to use this software for any
purpose, including commercial applications, and to alter it
and redistribute it freely, subject to the following
restrictions:
1. The origin of this software must not be misrepresented,
you must not claim that you wrote the original software.
If you use this software in a product, an acknowledgment
in the product documentation would be appreciated but is
not required.
2. Altered source versions must be plainly marked as such, and
must not be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
distribution.
4. You must register this software by sending a picture postcard
to the author. Use a nice stamp and mention your name, street
address, EMail address and any comment you like to say.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit Overbyte.Ics.HttpClient platform;
interface
uses
System.IO,
System.Threading,
Borland.Vcl.Windows,
Borland.Vcl.Messages,
Borland.Vcl.Classes,
Borland.Vcl.SysUtils,
Borland.Vcl.WinUtils,
Overbyte.Ics.Component,
OverByte.Ics.WinSock,
OverByte.Ics.WSocket;
const
HttpCliVersion = 154;
CopyRight : String = ' THttpCli (c) 1997-2005 F. Piette V1.54 ';
DefaultProxyPort = '80';
{$IFDEF VER80}
{ Delphi 1 has a 255 characters string limitation }
HTTP_RCV_BUF_SIZE = 255;
HTTP_SND_BUF_SIZE = 8193;
{$ELSE}
HTTP_RCV_BUF_SIZE = 8193;
HTTP_SND_BUF_SIZE = 8193;
{$ENDIF}
WM_HTTP_REQUEST_DONE = WM_USER + 1;
WM_HTTP_SET_READY = WM_USER + 2;
WM_HTTP_LOGIN = WM_USER + 3;
httperrNoError = 0;
httperrBusy = 1;
httperrNoData = 2;
httperrAborted = 3;
httperrOverflow = 4;
httperrVersion = 5;
httperrWindow = 6;
type
EHttpException = class(Exception)
ErrorCode : Word;
constructor Create(const Msg : String; ErrCode : Word);
end;
THttpEncoding = (encUUEncode, encBase64, encMime);
THttpRequest = (httpABORT, httpGET, httpPOST, httpPUT,
httpHEAD, httpCLOSE);
THttpState = (httpReady, httpNotConnected, httpConnected,
httpDnsLookup, httpDnsLookupDone,
httpWaitingHeader, httpWaitingBody, httpBodyReceived,
httpWaitingProxyConnect,
httpClosing, httpAborting);
TOnCommand = procedure (Sender : TObject;
var S: String) of object;
TDocDataEvent = procedure (Sender : TObject;
const Buffer : TBytes;
Offset : Integer;
Len : Integer) of object;
TCookieRcvdEvent = procedure (Sender : TObject;
const Data : String;
var Accept : Boolean) of object;
THttpRequestDone = procedure (Sender : TObject;
RqType : THttpRequest;
ErrCode : Word) of object;
TBeforeHeaderSendEvent = procedure (Sender : TObject;
const Method : String;
Headers : TStrings) of object;
type
THttpClient = class(TIcsComponent)
protected
FCtrlSocket : TWSocket;
FMultiThreaded : Boolean;
FState : THttpState;
FLocalAddr : String;
FHostName : String;
FTargetHost : String;
FTargetPort : String;
FPort : String;
FProtocol : String;
FProxy : String;
FProxyPort : String;
FUsername : String;
FPassword : String;
FProxyUsername : String;
FProxyPassword : String;
FProxyConnected : Boolean;
FLocation : String;
FCurrentHost : String;
FCurrentPort : String;
FCurrentProtocol : String;
FConnected : Boolean;
FDnsResult : String;
FSendBuffer : TBytes;
FRequestType : THttpRequest;
FReceiveBuffer : TBytes;
FReceiveLen : Integer;
FLastResponse : String;
FHeaderLineCount : Integer;
FBodyLineCount : Integer;
FAllowedToSend : Boolean;
FURL : String;
FPath : String;
FDocName : String;
FSender : String;
FReference : String;
FConnection : String; { for Keep-alive }
FAgent : String;
FAccept : String;
FAcceptLanguage : String;
FModifiedSince : TDateTime; { Warning ! Use GMT date/Time }
FNoCache : Boolean;
FStatusCode : Integer;
FReasonPhrase : String;
FResponseVer : String;
FRequestVer : String;
FContentLength : LongInt;
FContentType : String;
FDoAuthor : TStringList;
FContentPost : String; { Also used for PUT }
FContentRangeBegin : String;
FContentRangeEnd : String;
FAcceptRanges : String;
FCookie : String;
FLocationFlag : Boolean;
FHeaderEndFlag : Boolean;
FRcvdHeader : TStrings;
FRcvdStream : TStream; { If assigned, will recv the answer }
FRcvdCount : LongInt; { Number of rcvd bytes for the body }
FSentCount : LongInt;
FSendStream : TStream; { Contains the data to send }
FReqStream : TMemoryStream;
FRequestDoneError : Integer;
FNext : procedure of object;
FBodyData : Integer;
FBodyDataLen : Integer;
FOnStateChange : TNotifyEvent;
FOnSessionConnected : TNotifyEvent;
FOnRequestHeaderBegin : TNotifyEvent;
FOnRequestHeaderEnd : TNotifyEvent;
FOnHeaderBegin : TNotifyEvent;
FOnHeaderEnd : TNotifyEvent;
FOnHeaderData : TNotifyEvent;
FOnDocBegin : TNotifyEvent;
FOnDocEnd : TNotifyEvent;
FOnDocData : TDocDataEvent;
FOnSendBegin : TNotifyEvent;
FOnSendEnd : TNotifyEvent;
FOnSendData : TDocDataEvent;
FOnTrace : TNotifyEvent;
FOnCommand : TOnCommand;
FOnCookie : TCookieRcvdEvent;
FOnDataAvailable : TDataAvailable;
FOnRequestDone : THttpRequestDone;
FOnLocationChange : TNotifyEvent;
{ Added by Eugene Mayevski }
FOnSocksConnected : TSessionConnected;
FOnSocksAuthState : TSocksAuthStateEvent;
FOnSocksError : TSocksErrorEvent;
FOnSocketError : TNotifyEvent;
FOnBeforeHeaderSend : TBeforeHeaderSendEvent; { Wilfried 9 sep 02}
procedure WndProc(var MsgRec: TMessage); override;
procedure CreateSocket; virtual;
procedure DoBeforeConnect; virtual;
procedure DoSocksConnected(Sender: TObject; ErrCode: Word);
procedure DoSocksAuthState(Sender : TObject; AuthState : TSocksAuthState);
procedure DoSocksError(Sender : TObject; ErrCode : Integer; Msg : String);
procedure SocketErrorTransfer(Sender : TObject);
procedure SetSocksServer(value : String);
procedure SetSocksLevel(value : String);
procedure SetSocksPort(value : String);
procedure SetSocksUsercode(value : String);
procedure SetSocksPassword(value : String);
procedure SetSocksAuthentication(value : TSocksAuthentication);
function GetSocksServer : String;
function GetSocksLevel : String;
function GetSocksPort : String;
function GetSocksUsercode : String;
function GetSocksPassword : String;
function GetSocksAuthentication : TSocksAuthentication;
{ Mayevski additions end }
procedure SendRequest(const method, Version: String);
procedure GetHeaderLineNext; virtual;
procedure GetBodyLineNext; virtual;
procedure SendCommand(const Cmd : String); virtual;
procedure Login; virtual;
procedure Logout; virtual;
procedure InternalClear; virtual;
procedure SocketDNSLookupDone(Sender: TObject; ErrCode: Word); virtual;
procedure SocketSessionClosed(Sender: TObject; ErrCode: Word); virtual;
procedure SocketSessionConnected(Sender : TObject; ErrCode : Word); virtual;
procedure SocketDataSent(Sender : TObject; ErrCode : Word); virtual;
procedure SocketDataAvailable(Sender: TObject; ErrCode: Word); virtual;
procedure LocationSessionClosed(Sender: TObject; ErrCode: Word); virtual;
procedure DoRequestAsync(Rq : THttpRequest); virtual;
procedure DoRequestSync(Rq : THttpRequest); virtual;
procedure SetMultiThreaded(newValue : Boolean); virtual;
procedure StateChange(NewState : THttpState); virtual;
procedure TriggerStateChange; virtual;
procedure TriggerCookie(const Data : String;
var bAccept : Boolean); virtual;
procedure TriggerSessionConnected; virtual;
procedure TriggerBeforeHeaderSend(const Method : String;
Headers : TStrings); virtual;
procedure TriggerRequestHeaderBegin; virtual;
procedure TriggerRequestHeaderEnd; virtual;
procedure TriggerHeaderBegin; virtual;
procedure TriggerHeaderEnd; virtual;
procedure TriggerDocBegin; virtual;
procedure TriggerDocData(Data : TBytes; Offset, Len : Integer); virtual;
procedure TriggerDocEnd; virtual;
procedure TriggerSendBegin; virtual;
procedure TriggerSendData(var Data : TBytes; Offset, Len : Integer); virtual;
procedure TriggerSendEnd; virtual;
procedure TriggerRequestDone; virtual;
procedure SetReady; virtual;
procedure AdjustDocName; virtual;
procedure SetRequestVer(const Ver : String);
procedure WMHttpRequestDone(var msg: TMessage);
message WM_HTTP_REQUEST_DONE;
procedure WMHttpSetReady(var msg: TMessage);
message WM_HTTP_SET_READY;
procedure WMHttpLogin(var msg: TMessage);
message WM_HTTP_LOGIN;
procedure AbortComponent; override;
{$IFDEF USE_SSL}
procedure SslHandshakeDone(Sender : TObject; ErrCode : Word);
{$ENDIF}
public
constructor Create(AOwner: {$IFDEF ICS_COMPONENT}TComponent
{$ELSE}TObject{$ENDIF}); override;
destructor Destroy; override;
procedure Get; { Synchronous blocking Get }
procedure Post; { Synchronous blocking Post }
procedure Put; { Synchronous blocking Put }
procedure Head; { Synchronous blocking Head }
procedure Close; { Synchronous blocking Close }
procedure GetASync; { Asynchronous, non-blocking Get }
procedure PostASync; { Asynchronous, non-blocking Post }
procedure PutASync; { Asynchronous, non-blocking Put }
procedure HeadASync; { Asynchronous, non-blocking Head }
procedure CloseAsync; { Synchronous blocking Close }
procedure Abort;
property CtrlSocket : TWSocket read FCtrlSocket;
property State : THttpState read FState;
property LastResponse : String read FLastResponse;
property ContentLength : LongInt read FContentLength;
property ContentType : String read FContentType;
property RcvdCount : LongInt read FRcvdCount;
property SentCount : LongInt read FSentCount;
property StatusCode : Integer read FStatusCode;
property ReasonPhrase : String read FReasonPhrase;
property DnsResult : String read FDnsResult;
property AuthorizationRequest : TStringList read FDoAuthor;
property DocName : String read FDocName;
property Location : String read FLocation
write FLocation;
property RcvdStream : TStream read FRcvdStream
write FRcvdStream;
property SendStream : TStream read FSendStream
write FSendStream;
property RcvdHeader : TStrings read FRcvdHeader;
property Hostname : String read FHostname;
property Protocol : String read FProtocol;
published
property URL : String read FURL
write FURL;
property LocalAddr : String read FLocalAddr {bb}
write FLocalAddr; {bb}
property Proxy : String read FProxy
write FProxy;
property ProxyPort : String read FProxyPort
write FProxyPort;
property Sender : String read FSender
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -