?? httpprot.pas
字號(hào):
if lowercase(ExtractFileExt(FDocName)) = '.exe' then begin
if FContentType = 'text/html' then
ReplaceExt(FDocName, 'htm');
end;
StateChange(httpWaitingBody);
FNext := GetBodyLineNext;
TriggerHeaderEnd;
if FReceiveLen > 0 then begin
SetLength(FLastResponse, FReceiveLen);
Move(FReceiveBuffer, FLastResponse[1], FReceiveLen);
GetBodyLineNext;
FReceiveLen := 0;
end;
Exit;
end;
FRcvdHeader.Add(FLastResponse);
nSep := pos(':', FLastResponse);
if (Copy(FLastResponse, 1, 8) = 'HTTP/1.0') or
(Copy(FLastResponse, 1, 8) = 'HTTP/1.1') then begin
FStatusCode := StrToInt(Copy(FLastResponse, 10, 3));
FReasonPhrase := Copy(FLastResponse, 14, Length(FLastResponse));
end
else if nSep > 0 then begin
Field := LowerCase(Copy(FLastResponse, 1, nSep - 1));
{ Skip spaces }
Inc(nSep);
while (nSep < Length(FLastResponse)) and
(FLastResponse[nSep] = ' ') do
Inc(nSep);
Data := Copy(FLastResponse, nSep, Length(FLastResponse));
if Field = 'location' then begin { Change the URL ! }
{ URL with relocations: }
{ http://www.webcom.com/~wol2wol/ }
{ http://www.purescience.com/delphi/ }
{ http://www.maintron.com/ }
{ http://www.infoseek.com/AddURL/addurl }
{ http://www.micronpc.com/ }
{ http://www.amazon.com/ }
FLocationFlag := TRUE;
if Proxy <> '' then begin
{ We are using a proxy }
if Data[1] = '/' then begin
{ Relative location }
ParseURL(FPath, proto, user, pass, Host, port, Path);
if Proto = '' then
Proto := 'http';
FLocation := Proto + '://' + Host + Data;
FPath := FLocation;
end
else begin
ParseURL(Data, proto, user, pass, Host, port, Path);
if port <> '' then
FPort := port;
if (Proto <> '') and (Host <> '') then begin
{ We have a full relocation URL }
FTargetHost := Host;
FLocation := Proto + '://' + Host + Path;
FPath := FLocation;
end
else begin
if Proto = '' then
Proto := 'http';
if FPath = '' then
FLocation := Proto + '://' + FTargetHost + '/' + Host
else if Host = '' then
FLocation := Proto + '://' + FTargetHost + FPath
else
FTargetHost := Host;
end;
end;
end
{ We are not using a proxy }
else begin
if Data[1] = '/' then begin
{ Relative location }
FPath := Data;
if Proto = '' then
Proto := 'http';
FLocation := Proto + '://' + FHostName + FPath;
end
else begin
ParseURL(Data, proto, user, pass, FHostName, port, FPath);
if port <> '' then
FPort := port;
if (Proto <> '') and (FHostName <> '') then begin
{ We have a full relocation URL }
FTargetHost := FHostName;
if FPath = '' then begin
FPath := '/';
FLocation := Proto + '://' + FHostName;
end
else
FLocation := Proto + '://' + FHostName + FPath;
end
else begin
if Proto = '' then
Proto := 'http';
if FPath = '' then begin
FLocation := Proto + '://' + FTargetHost + '/' + FHostName;
FHostName := FTargetHost;
FPath := FLocation; { 26/11/99 }
end
else if FHostName = '' then begin
FLocation := Proto + '://' + FTargetHost + FPath;
FHostName := FTargetHost;
end
else
FTargetHost := FHostName;
end;
end;
end;
end
else if Field = 'content-length' then
FContentLength := StrToInt(Data)
else if Field = 'content-range' then begin {JMR!! Added this line!!!}
tmpInt := Pos('-', Data) + 1; {JMR!! Added this line!!!}
FContentRangeBegin := Copy(Data, 7, tmpInt-8); {JMR!! Added this line!!!}
FContentRangeEnd := Copy(Data, tmpInt, Pos('/', Data) - tmpInt); {JMR!! Added this line!!!}
end {JMR!! Added this line!!!}
else if Field = 'accept-ranges' then
FAcceptRanges := Data
else if Field = 'content-type' then
FContentType := LowerCase(Data)
else if Field = 'www-authenticate' then
FDoAuthor.add(Data)
else if Field = 'set-cookie' then begin
bAccept := TRUE;
TriggerCookie(Data, bAccept);
end
{ else if Field = 'date' then }
{ else if Field = 'mime-version' then }
{ else if Field = 'pragma' then }
{ else if Field = 'allow' then }
{ else if Field = 'server' then }
{ else if Field = 'content-encoding' then }
{ else if Field = 'expires' then }
{ else if Field = 'last-modified' then }
end
else { Ignore all other responses }
;
if Assigned(FOnHeaderData) then
FOnHeaderData(Self);
if FStatusCode >= 400 then
FWSocket.Close;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.DoRequestAsync(Rq : THttpRequest);
var
Proto, User, Pass, Host, Port, Path: String;
I : Integer;
begin
if FState <> httpReady then
raise EHttpException.Create('HTTP component is busy', httperrBusy);
if (Rq = httpPOST) and (not Assigned(FSendStream)) then
raise EHttpException.Create('HTTP component has nothing to post',
httperrNoData);
FRcvdHeader.Clear;
FRequestType := Rq;
FRequestDoneError := 0;
FWSocket.OnSessionClosed := SocketSessionClosed;
StateChange(httpNotConnected);
FDocName := '';
FStatusCode := 0;
FRcvdCount := 0;
FSentCount := 0;
FHeaderLineCount := 0;
FBodyLineCount := 0;
FContentLength := -1;
FContentType := ''; { 25/09/1999 }
FAllowedToSend := FALSE;
FLocation := FURL;
{ parse url and proxy to FHostName, FPath and FPort }
if FProxy <> '' then begin
ParseURL(FURL, Proto, User, Pass, Host, Port, Path);
FTargetHost := Host;
FPath := FURL;
FDocName := Path;
if User <> '' then
FUserName := User;
if Pass <> '' then
FPassword := Pass;
{ We need to remove usercode/Password from the URL given to the proxy }
{ but preserve the port }
if Port <> '' then
Port := ':' + Port;
if Proto = '' then
FPath := 'http://'+ Host + Port + Path
else
FPath := Proto + '://' + Host + Port + Path;
ParseURL(FProxy, Proto, User, Pass, Host, Port, Path);
if Port = '' then
Port := ProxyPort;
end
else begin
ParseURL(FURL, Proto, User, Pass, Host, Port, FPath);
FTargetHost := Host;
FDocName := FPath;
if User <> '' then
FUserName := User;
if Pass <> '' then
FPassword := Pass;
if Port = '' then
Port := '80';
end;
if Proto = '' then
Proto := 'http';
if FPath = '' then
FPath := '/';
if (FDocName = '') or (FDocName = '/') then
FDocName := 'document.htm'
else begin
if FDocName[Length(FDocName)] = '/' then
SetLength(FDocName, Length(FDocName) - 1);
FDocName := Copy(FDocName, Posn('/', FDocName, -1) + 1, 255);
I := Pos('?', FDocName);
if I > 0 then
FDocName := Copy(FDocName, 1, I - 1);
end;
FHostName := host;
FPort := Port;
{ Ask to connect. When connected, we go at SocketSeesionConnected. }
Login;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.DoRequestSync(Rq : THttpRequest);
begin
DoRequestAsync(Rq);
{$IFDEF VER80}
{ Delphi 1 has no support for multi-threading }
while FState <> httpReady do
Application.ProcessMessages;
{$ELSE}
if FMultiThreaded then begin
while FState <> httpReady do begin
FWSocket.ProcessMessages;
Sleep(0);
end;
end
else begin
while FState <> httpReady do begin
Application.ProcessMessages;
Sleep(0);
end;
end;
{$ENDIF}
if FStatusCode >= 400 then
raise EHttpException.Create(FReasonPhrase, FStatusCode);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.LocationSessionClosed(Sender: TObject; Error: Word);
begin
FConnected := FALSE;
FLocationFlag := FALSE;
{ Restore normal session closed event }
FWSocket.OnSessionClosed := SocketSessionClosed;
{ Trigger the location changed event }
if Assigned(FOnLocationChange) then
FOnLocationChange(Self);
{ Restart at login procedure }
PostMessage(FWindowHandle, WM_HTTP_LOGIN, 0, 0);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.WMHttpLogin(var msg: TMessage);
begin
Login;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.SocketSessionClosed(Sender: TObject; Error: Word);
begin
FConnected := FALSE;
if FBodyLineCount > 0 then
TriggerDocEnd;
SetReady; {StateChange(httpReady);}
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.SocketDataAvailable(Sender: TObject; Error: Word);
var
Len : Integer;
I : Integer;
begin
I := sizeof(FReceiveBuffer) - FReceiveLen - 1;
if I <= 0 then
raise EHttpException.Create('HTTP line too long', httperrOverflow);
Len := FWSocket.Receive(@FReceiveBuffer[FReceiveLen], I);
{ writeln('Received ', Len, '(asked ', I, ')'); }
if FRequestType = httpAbort then
Exit;
if Len <= 0 then
Exit;
FReceiveBuffer[FReceiveLen + Len] := #0;
FReceiveLen := FReceiveLen + Len;
if FState = httpWaitingBody then begin
if FReceiveLen > 0 then begin
SetLength(FLastResponse, FReceiveLen);
Move(FReceiveBuffer, FLastResponse[1], FReceiveLen);
if Assigned(FNext) then
FNext
else
SetReady; {StateChange(httpReady);}
end;
FReceiveLen := 0;
Exit;
end;
while FReceiveLen > 0 do begin
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -