httpprot.pas

BaiduMp3 search baidu mp3

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THTTPCli.SocketErrorTransfer(Sender : TObject);
begin
    if (assigned(FOnSocketError)) then
        FOnSocketError(Self);  { Substitute Self for subcomponent's Sender. }
end;  { SocketErrorTransfer }


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THTTPCli.DoSocksAuthState(
    Sender    : TObject;
    AuthState : TSocksAuthState);
begin
    if Assigned(FOnSocksAuthState) then
        FOnSocksAuthState(Sender, AuthState);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THTTPCli.DoSocksError(
    Sender  : TObject;
    ErrCode : Integer;
    Msg     : String);
begin
    if Assigned(FOnSocksError) then
        FOnSocksError(Sender, ErrCode, Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.SetMultiThreaded(newValue : Boolean);
begin
    FMultiThreaded            := newValue;
    FCtrlSocket.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) and
{$IFDEF UseNTLMAuthentication}
           not PrepareNTLMAuth and
{$ENDIF}
           not PrepareBasicAuth then
            TriggerRequestDone;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerStateChange;
begin
{$IFDEF DEBUG_OUTPUT}
    case FState of
      httpReady               : OutputDebugString('State = httpReady');
      httpNotConnected        : OutputDebugString('State = httpNotConnected');
      httpConnected           : OutputDebugString('State = httpConnected');
      httpDnsLookup           : OutputDebugString('State = httpDnsLookup');
      httpDnsLookupDone       : OutputDebugString('State = httpDnsLookupDone');
      httpWaitingHeader       : OutputDebugString('State = httpWaitingHeader');
      httpWaitingBody         : OutputDebugString('State = httpWaitingBody');
      httpBodyReceived        : OutputDebugString('State = httpBodyReceived');
      httpWaitingProxyConnect : OutputDebugString('State = httpWaitingProxyConnect');
      httpClosing             : OutputDebugString('State = httpClosing');
      httpAborting            : OutputDebugString('State = httpAborting');
    else                        OutputDebugString('State = INVALID STATE');
    end;
{$ENDIF}
    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.TriggerSessionClosed;
begin
    if Assigned(FOnSessionClosed) then
        FOnSessionClosed(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerDocBegin;
begin
{$IFDEF DEBUG_OUTPUT}
    OutputDebugString('DocBegin');
{$ENDIF}
    if Assigned(FOnDocBegin) then
        FOnDocBegin(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerDocEnd;
begin
{$IFDEF DEBUG_OUTPUT}
    OutputDebugString('DocEnd');
{$ENDIF}
    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);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerHeaderBegin;
begin
    FHeaderEndFlag := TRUE;
    if Assigned(FOnHeaderBegin) then
        FOnHeaderBegin(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerHeaderEnd;
begin
    FHeaderEndFlag := FALSE;
    if Assigned(FOnHeaderEnd) then
        FOnHeaderEnd(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerBeforeHeaderSend(
    const Method : String;
    Headers      : TStrings);
begin
    if Assigned(FOnBeforeHeaderSend) then
        FOnBeforeHeaderSend(Self, Method, Headers);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerRequestHeaderBegin;
begin
    if Assigned(FOnRequestHeaderBegin) then
        FOnRequestHeaderBegin(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.TriggerRequestHeaderEnd;
begin
    if Assigned(FOnRequestHeaderEnd) then
        FOnRequestHeaderEnd(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF UseNTLMAuthentication}
function THttpCli.PrepareNTLMAuth : Boolean;
var
    TmpInt          : Integer;
begin
    { this flag can tell if we proceed with OnRequestDone or will try    }
    { to authenticate                                                    }
    Result := FALSE;
    if httpoNoNTLMAuth in FOptions then
        Exit;

    { if you place this code in GetHeaderLineNext, not each time will be }
    { called ...                                                         }
    if (FAuthNTLMState = ntlmMsg3) and (FStatusCode <> 401) then
        FAuthNTLMState := ntlmDone
    else if (FAuthNTLMState = ntlmDone) and (FStatusCode = 401) then
        FAuthNTLMState := ntlmNone;

    if (FProxyAuthNTLMState = ntlmMsg3) and (FStatusCode <> 407) then
        FProxyAuthNTLMState := ntlmDone
    else if (FProxyAuthNTLMState = ntlmDone) and (FStatusCode = 407) then begin
        { if we lost proxy authenticated line, most probaly we lost also }
        { the authenticated line of Proxy to HTTP server, so reset the   }
        { NTLM state of HTTP also to none                                }
        FProxyAuthNTLMState := ntlmNone;
        FAuthNTLMState      := ntlmNone;
    end;

    if (FStatusCode = 401) and (FDoAuthor.Count > 0) and
       (FUserName <> '')   and (FPassword <> '') then begin
        { We can handle authorization }
        TmpInt := FDoAuthor.Count - 1;
        while TmpInt >= 0  do begin
            if Copy(FDoAuthor.Strings[TmpInt], 1, 4) = 'NTLM' then begin
                Result := TRUE;
                StartAuthNTLM;
                Break;
            end;
            Dec(TmpInt);
        end
    end
    else if (FStatusCode = 407)    and (FDoAuthor.Count > 0) and
            (FProxyUsername <> '') and (FProxyPassword <> '') then begin
        {BLD proxy NTLM authentication}
        { We can handle authorization }
        TmpInt := FDoAuthor.Count - 1;
        while TmpInt >= 0  do begin
            if Copy(FDoAuthor.Strings[TmpInt], 1, 4) = 'NTLM' then begin
                Result := TRUE;
                StartProxyAuthNTLM;
                Break;
            end;
            Dec(TmpInt);
        end
    end;
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpCli.PrepareBasicAuth : Boolean;
var