📄 httpprot.pas
字号:
Headers.Add('If-Modified-Since: ' +
RFC1123_Date(FModifiedSince) + ' GMT');
if FUsername <> '' then
Headers.Add('Authorization: Basic ' +
EncodeStr(encBase64, FUsername + ':' + FPassword));
if (FProxy <> '') and (FProxyUsername <> '') then
Headers.Add('Proxy-Authorization: Basic ' +
EncodeStr(encBase64, FProxyUsername + ':' + FProxyPassword));
if FCookie <> '' then
Headers.Add('Cookie: ' + FCookie);
if (FContentRangeBegin <> '') or (FContentRangeEnd <> '') then begin {JMR!! Added this line!!!}
Headers.Add('Range: bytes=' + FContentRangeBegin + '-' + FContentRangeEnd); {JMR!! Added this line!!!}
FContentRangeBegin := ''; {JMR!! Added this line!!!}
FContentRangeEnd := ''; {JMR!! Added this line!!!}
end; {JMR!! Added this line!!!}
FAcceptRanges := '';
{SendCommand('UA-pixels: 1024x768'); }
{SendCommand('UA-color: color8'); }
{SendCommand('UA-OS: Windows 95'); }
{SendCommand('UA-CPU: x86'); }
{SendCommand('User-Agent: Mozilla/3.0 (compatible)');} {; MSIE 3.01; Update a; Windows 95)');}
{SendCommand('Proxy-Connection: Keep-Alive'); }
TriggerBeforeHeaderSend(Method, Headers);
for N := 0 to Headers.Count - 1 do
SendCommand(Headers[N]);
TriggerRequestHeaderEnd;
SendCommand('');
FCtrlSocket.Send(FReqStream.Memory, FReqStream.Size);
FReqStream.Clear;
finally
Headers.Free;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.GetBodyLineNext;
var
Len : Integer;
Data : Pointer;
const
CRLF : String[2] = #13#10;
begin
if FBodyLineCount = 0 then
TriggerDocBegin;
Inc(FBodyLineCount);
Len := Length(FLastResponse);
if Len > 0 then
Data := @FLastResponse[1]
else
Data := @Len;
FRcvdCount := FRcvdCount + Len;
if Assigned(FRcvdStream) then
FRcvdStream.WriteBuffer(Data^, Len);
TriggerDocData(Data, Len);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.GetHeaderLineNext;
var
proto : String;
user : String;
pass : String;
port : String;
Host : String;
Path : String;
Field : String;
Data : String;
nSep : Integer;
tmpInt : LongInt;
bAccept : Boolean;
DocExt : String;
begin
if FHeaderLineCount = 0 then
TriggerHeaderBegin;
Inc(FHeaderLineCount);
{ Some server send HTML document without header ! I don't know if it is }
{ legal, but it exists (AltaVista Discovery does that). }
if UpperCase(Copy(FLastResponse, 1, 6)) = '<HTML>' then begin { 15/09/98 }
if FContentType = '' then
FContentType := 'text/html';
StateChange(httpWaitingBody);
FNext := GetBodyLineNext;
TriggerHeaderEnd;
GetBodyLineNext;
Exit;
end;
if FLastResponse = '' then begin
if FLocationFlag then begin
TriggerHeaderEnd;
FReceiveLen := 0;
FHeaderLineCount := 0;
FBodyLineCount := 0;
FCtrlSocket.OnSessionClosed := LocationSessionClosed;
FCtrlSocket.Close;
Exit;
end;
{ FContentLength = -1 when server doesn't send a value }
if FContentLength = 0 then begin
TriggerHeaderEnd;
SetReady;
Exit;
end;
DocExt := lowercase(ExtractFileExt(FDocName));
if (DocExt = '.exe') or (DocExt = '') 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;
if FStatusCode >= 400 then { 01/11/01 }
FCtrlSocket.Close;
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/ }
{ http://count.paycounter.com/?fn=0&si=44860&bt=msie&bv=5& }
{ co=32&js=1.4&sr=1024x768&re=http://www.thesite.com/you.html }
FLocationFlag := TRUE;
if Proxy <> '' then begin
{ We are using a proxy }
if Data[1] = '/' then begin
{ Absolute location }
ParseURL(FPath, proto, user, pass, Host, port, Path);
if Proto = '' then
Proto := 'http';
FLocation := Proto + '://' + Host + Data;
FPath := FLocation;
if (user <> '') and (pass <> '') then begin
{ save user and password given in location @@@}
FUsername := user;
FPassword := pass;
end;
end
else if Copy(Data, 1, 7) <> 'http://' then begin
{ Relative location }
FPath := GetBaseUrl(FPath) + Data;
if Proto = '' then
Proto := 'http';
FLocation := Proto + '://' + FHostName + '/' + FPath;
end
else begin
ParseURL(Data, proto, user, pass, Host, port, Path);
if port <> '' then
FPort := port
else
FPort := '80';
if (user <> '') and (pass <> '') then begin
{ save user and password given in location @@@}
FUsername := user;
FPassword := pass;
end;
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
{ Absolute location }
FPath := Data;
if Proto = '' then
Proto := 'http';
FLocation := Proto + '://' + FHostName + FPath;
end
else if Copy(Data, 1, 7) <> 'http://' then begin
{ Relative location }
FPath := GetBaseUrl(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
else
FPort := '80';
if (user <> '') and (pass <> '') then begin
{ save user and password given in location @@@}
FUsername := user;
FPassword := pass;
end;
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(Trim(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) t⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -