📄 httpprot.pas
字号:
procedure TriggerSendData(Data : Pointer; Len : Integer); virtual;
procedure TriggerSendEnd; virtual;
procedure TriggerRequestDone;
procedure WndProc(var MsgRec: TMessage);
procedure SetReady;
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;
public
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure Get; { Synchronous blocking Get }
procedure Post; { Synchronous blocking Post }
procedure Head; { Synchronous blocking Head }
procedure GetASync; { Asynchronous, non-blocking Get }
procedure PostASync; { Asynchronous, non-blocking Post }
procedure HeadASync; { Asynchronous, non-blocking Head }
procedure Abort;
property WSocket : TWSocket read FWSocket;
property Handle : HWND read FWindowHandle;
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;
published
property URL : String read FURL
write FURL;
property Proxy : String read FProxy
write FProxy;
property ProxyPort : String read FProxyPort
write FProxyPort;
property Sender : String read FSender
write FSender;
property Agent : String read FAgent
write FAgent;
property Accept : String read FAccept
write FAccept;
property Reference : String read FReference
write FReference;
property Username : String read FUsername
write FUsername;
property Password : String read FPassword
write FPassword;
property ProxyUsername : String read FProxyUsername
write FProxyUsername;
property ProxyPassword : String read FProxyPassword
write FProxyPassword;
property NoCache : Boolean read FNoCache
write FNoCache;
property ModifiedSince : TDateTime read FModifiedSince
write FModifiedSince;
property Cookie : String read FCookie
write FCookie;
property ContentTypePost : String read FContentPost
write FContentPost;
property ContentRangeBegin: String read FContentRangeBegin {JMR!! Added this line!!!}
write FContentRangeBegin; {JMR!! Added this line!!!}
property ContentRangeEnd : String read FContentRangeEnd {JMR!! Added this line!!!}
write FContentRangeEnd; {JMR!! Added this line!!!}
property AcceptRanges : String read FAcceptRanges;
property MultiThreaded : Boolean read FMultiThreaded
write SetMultiThreaded;
property OnTrace : TNotifyEvent read FOnTrace
write FOnTrace;
property OnSessionConnected : TNotifyEvent read FOnSessionConnected
write FOnSessionConnected;
property OnHeaderData : TNotifyEvent read FOnHeaderData
write FOnHeaderData;
property OnCommand : TOnCommand read FOnCommand
write FOnCommand;
property OnHeaderBegin : TNotifyEvent read FOnHeaderBegin
write FOnHeaderBegin;
property OnHeaderEnd : TNotifyEvent read FOnHeaderEnd
write FOnHeaderEnd;
property OnRequestHeaderBegin : TNotifyEvent read FOnRequestHeaderBegin
write FOnRequestHeaderBegin;
property OnRequestHeaderEnd : TNotifyEvent read FOnRequestHeaderEnd
write FOnRequestHeaderEnd;
property OnDocBegin : TNotifyEvent read FOnDocBegin
write FOnDocBegin;
property OnDocData : TDocDataEvent read FOnDocData
write FOnDocData;
property OnDocEnd : TNotifyEvent read FOnDocEnd
write FOnDocEnd;
property OnSendBegin : TNotifyEvent read FOnSendBegin
write FOnSendBegin;
property OnSendData : TDocDataEvent read FOnSendData
write FOnSendData;
property OnSendEnd : TNotifyEvent read FOnSendEnd
write FOnSendEnd;
property OnStateChange : TNotifyEvent read FOnStateChange
write FOnStateChange;
property OnRequestDone : THttpRequestDone read FOnRequestDone
write FOnRequestDone;
property OnLocationChange : TNotifyEvent read FOnLocationChange
write FOnLocationChange;
property OnCookie : TCookieRcvdEvent read FOnCookie
write FOnCookie;
end;
procedure Register;
{ Syntax of an URL: protocol://[user[:password]@]server[:port]/path }
procedure ParseURL(const URL : String;
var Proto, User, Pass, Host, Port, Path : String);
function Posn(const s, t : String; count : Integer) : Integer;
function EncodeLine(Encoding : THttpEncoding;
SrcData : PChar; Size : Integer):String;
function EncodeStr(Encoding : THttpEncoding; const Value : String) : String;
function RFC1123_Date(aDate : TDateTime) : String;
implementation
const
bin2uue : String = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
bin2b64 : String = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
uue2bin : String = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ ';
b642bin : String = '~~~~~~~~~~~^~~~_TUVWXYZ[\]~~~|~~~ !"#$%&''()*+,-./0123456789~~~~~~:;<=>?@ABCDEFGHIJKLMNOPQRS';
linesize = 45;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Register;
begin
RegisterComponents('FPiette', [THttpCli]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor EHttpException.Create(const Msg : String; ErrCode : Word);
begin
Inherited Create(Msg);
ErrorCode := ErrCode;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
procedure SetLength(var S: string; NewLength: Integer);
begin
S[0] := chr(NewLength);
end;
{$ENDIF}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ We cannot use Delphi own function because the date must be specified in }
{ english and Delphi use the current language. }
function RFC1123_Date(aDate : TDateTime) : String;
const
StrWeekDay : String = 'MonTueWedThuFriSatSun';
StrMonth : String = 'JanFebMarAprMayJunJulAugSepOctNovDec';
var
Year, Month, Day : Word;
Hour, Min, Sec, MSec : Word;
DayOfWeek : Word;
begin
DecodeDate(aDate, Year, Month, Day);
DecodeTime(aDate, Hour, Min, Sec, MSec);
DayOfWeek := ((Trunc(aDate) - 2) mod 7);
Result := Copy(StrWeekDay, 1 + DayOfWeek * 3, 3) + ', ' +
Format('%2.2d %s %4.4d %2.2d:%2.2d:%2.2d',
[Day, Copy(StrMonth, 1 + 3 * (Month - 1), 3),
Year, Hour, Min, Sec]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor THttpCli.Create(Aowner:TComponent);
begin
inherited create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
FWSocket := TWSocket.Create(Self);
FProxyPort := DefaultProxyPort;
FContentPost := 'application/x-www-form-urlencoded';
FAccept := 'image/gif, image/x-xbitmap, ' +
'image/jpeg, image/pjpeg, */*';
FAgent := 'Mozilla/3.0 (compatible)';
FDoAuthor := TStringlist.Create;
FWSocket.OnSessionClosed := SocketSessionClosed;
FWSocket.OnDataAvailable := SocketDataAvailable;
FWSocket.OnSessionConnected := SocketSessionConnected;
FWSocket.OnDataSent := SocketDataSent;
FWSocket.OnDnsLookupDone := SocketDNSLookupDone;
FRcvdHeader := TStringList.Create;
FReqStream := TMemoryStream.Create;
FState := httpReady;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor THttpCli.Destroy;
begin
FDoAuthor.Free;
FWSocket.Free;
FRcvdHeader.Free;
FReqStream.Free;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.WndProc(var MsgRec: TMessage);
begin
with MsgRec do begin
case Msg of
WM_HTTP_REQUEST_DONE : WMHttpRequestDone(MsgRec);
WM_HTTP_SET_READY : WMHttpSetReady(MsgRec);
WM_HTTP_LOGIN : WMHttpLogin(MsgRec);
else
Result := DefWindowProc(Handle, Msg, wParam, lParam);
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.SetMultiThreaded(newValue : Boolean);
begin
FMultiThreaded := newValue;
FWSocket.MultiThreaded := newValue;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.SetReady;
begin
PostMessage(Handle, WM_HTTP_SET_READY, 0, 0);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.StateChange(NewState : THttpState);
begin
if FState <> NewState then begin
FState := NewState;
TriggerStateChange;
if NewState = httpReady then
TriggerRequestDone;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerStateChange;
begin
if Assigned(FOnStateChange) then
FOnStateChange(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerCookie(const Data : String; var bAccept : Boolean);
begin
if Assigned(FOnCookie) then
FOnCookie(Self, Data, bAccept);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerSessionConnected;
begin
if Assigned(FOnSessionConnected) then
FOnSessionConnected(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerDocBegin;
begin
if Assigned(FOnDocBegin) then
FOnDocBegin(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerDocEnd;
begin
if Assigned(FOnDocEnd) then
FOnDocEnd(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerDocData(Data : Pointer; Len : Integer);
begin
if Assigned(FOnDocData) then
FOnDocData(Self, Data, Len);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerSendBegin;
begin
if Assigned(FOnSendBegin) then
FOnSendBegin(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerSendEnd;
begin
if Assigned(FOnSendEnd) then
FOnSendEnd(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerSendData(Data : Pointer; Len : Integer);
begin
if Assigned(FOnSendData) then
FOnSendData(Self, Data, Len);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -