httpprot.pas

互联网套件

        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 }
            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;
                        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
        I := Pos(#10, FReceiveBuffer);
        if I <= 0 then
            break;
        if I > FReceiveLen then