pop3prot.pas

BaiduMp3 search baidu mp3

    FLastResponseSave := FLastResponse;
    FStatusCodeSave   := -1;
    FRequestType      := RqType;
    FRequestResult    := 0;
    FFctSet           := Fcts;
    FFctPrv           := pop3FctNone;
    FHighLevelResult  := 0;
    FHighLevelFlag    := TRUE;
    FLastResponse     := '';
    FRestartFlag      := FALSE;
    ClearErrorMessage;
    DoHighLevelAsync;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.ProcessUidl(Sender : TObject);
begin
    ExtractUidl(FMsgNum, FMsgUidl);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.ProcessList(Sender : TObject);
begin
    ExtractNumbers(FMsgNum, FMsgSize);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TCustomPop3Cli.ExtractUidl(var N1 : Integer; var N2 : String) : Boolean;
var
    p : PChar;
begin
    Result := FALSE;
    N1     := 0;
    N2     := '';

{$IFDEF VER80}
    { Delphi 1 do not automatically nul terminate strings }
    FLastResponse := FLastResponse + #0;
{$ENDIF}

    { Search for first digit in response }
    p := @FLastResponse[1];
    while (p^ <> #0) and (not (p^ in ['0'..'9'])) do
        Inc(p);
    if p^ = #0 then { Invalid response, need a number }
        Exit;

    { Convert first number }
    N1 := atoi(p);

    { Search end of number }
    while (p^ <> #0) and (p^ in ['0'..'9']) do
        Inc(p);

    { Search Uidl }
    while (p^ = ' ') do
        Inc(p);

    { Copy UIDL }
    while (p^ <> #0) and (p^ in [#33..#126]) do begin
        N2 := N2 + p^;
        Inc(p);
    end;

    Result := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TCustomPop3Cli.ExtractNumbers(var N1 : Integer; var N2 : Integer) : Boolean;
var
    p : PChar;
begin
    Result := FALSE;

{$IFDEF VER80}
    { Delphi 1 do not automatically nul terminate strings }
    FLastResponse := FLastResponse + #0;
{$ENDIF}

    { Search for first digit in response }
    p := @FLastResponse[1];
    while (p^ <> #0) and (not (p^ in ['0'..'9'])) do
        Inc(p);
    if p^ = #0 then begin
        { Invalid response, need a number }
        N1 := 0;
        N2 := 0;
        Exit;
    end;

    { Convert first number }
    N1 := atoi(p);

    { Search end of number }
    while (p^ <> #0) and (p^ in ['0'..'9']) do
        Inc(p);

    { Search next number }
    p := stpblk(p);

    if p^ = #0 then begin
        { Invalid response, need a number }
        N1 := 0;
        N2 := 0;
        Exit;
    end;

    N2     := atoi(p);
    Result := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.SendCommand(Cmd : String);
begin
    Display('> ' + Cmd);
    { Application.ProcessMessages;        //FP Should it be removed ?! }
    FWSocket.SendStr(Cmd + #13 + #10);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TCustomPop3Cli.OkResponse : Boolean;
begin
    Result := ((Length(FLastResponse) > 0) and (FLastResponse[1] = '+'));
    if Result then
        FStatusCode := 0
    else
        FStatusCode := 500;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Display(Msg : String);
begin
    if Assigned(FOnDisplay) then
        FOnDisplay(Self, Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.ClearErrorMessage;
begin
    FErrorMessage := '';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.SetErrorMessage;
begin
    if FErrorMessage = '' then
        FErrorMessage := FLastResponse;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.CheckReady;
begin
    if not (FState in [pop3Ready, pop3InternalReady]) then
        raise pop3Exception.Create('POP3 component not ready');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.StateChange(NewState : TPop3State);
begin
    if FState <> NewState then begin
        FState := NewState;
        TriggerStateChange;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.DisplayLastResponse;
begin
     TriggerDisplay('< ' + FLastResponse);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.ExecAsync(
    RqType      : TPop3Request;
    Cmd         : String;             { Command to execute                     }
    NextState   : TPop3ProtocolState; { Next protocol state in case of success }
    DoneAsync   : TPop3NextProc);     { What to do when done                   }
begin
    CheckReady;

    if not FConnected then
        raise Pop3Exception.Create('POP3 component not connected');

    if not FHighLevelFlag then
        FRequestType := RqType;

    FRequestDoneFlag   := FALSE;
    FNext              := NextExecAsync;
    FNextProtocolState := NextState;
    FDoneAsync         := DoneAsync;
    StateChange(pop3WaitingResponse);
    SendCommand(Cmd);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.NextExecAsync;
begin
    DisplayLastResponse;

    if not OkResponse then begin
        FRequestResult := FStatusCode;
        SetErrorMessage;
        TriggerRequestDone(FRequestResult);
        Exit;
    end;

    FRequestResult := 0;
    FProtocolState := FNextProtocolState;

    if Assigned(FDoneAsync) then
        FDoneAsync
    else
        TriggerRequestDone(FRequestResult);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.AuthLoginNext; {HLX}
begin
    if FRequestResult <> 0 then begin
        TriggerRequestDone(FRequestResult);
        Exit;
    end;

    FState := pop3InternalReady;
    ExecAsync(pop3User, Base64Encode(FUsername), pop3WaitingUser, AuthLoginPass);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.AuthLoginPass; {HLX}
begin
    if FRequestResult <> 0 then begin
        TriggerRequestDone(FRequestResult);
        Exit;
    end;

    FState := pop3InternalReady;
    ExecAsync(pop3Pass, Base64Encode(FPassword), pop3Transaction, nil);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF DELPHI5_UP}
procedure TCustomPop3Cli.AuthCramSha1; {HLX}
var
    Challenge  : String;
    Response   : String;
    Digest     : SHA1Digest;
    count      : Integer;
begin
    if FRequestResult <> 0 then begin
        TriggerRequestDone(FRequestResult);
        Exit;
    end;
    if Length(FLastResponse) < 3 then begin
        FLastResponse := '-ERR Malformed SHA1 Challenge: ' + FLastResponse;
        SetErrorMessage;
        TriggerRequestDone(500);
        Exit;
    end;
    Challenge := Copy(FLastResponse, 3, Length(FLastResponse) - 2);
    Challenge := Base64Decode(Challenge);
    HMAC_SHA1(Challenge[1], Length(Challenge),
              FPassword[1], Length(FPassword), Digest);
    Response := FUsername + ' ';
    for Count := 0 to SHA1HashSize-1 do begin
        Response := Response + HexDigits[((Byte(Digest[Count]) and $F0) shr 4)];
        Response := Response + HexDigits[(Byte(Digest[Count]) and $0F)];
    end;
    FState := pop3InternalReady;
    ExecAsync(pop3Pass, Base64Encode(Response), pop3Transaction, nil);
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.AuthCramMd5; {HLX}
var
    Challenge  : String;
    Response   : String;
    MD5Digest  : TMD5Digest;
    MD5Context : TMD5Context;
    Count      : Integer;
    IPAD       : array [0..63] of Byte;
    OPAD       : array [0..63] of Byte;
begin
    if FRequestResult <> 0 then begin
        TriggerRequestDone(FRequestResult);
        Exit;
    end;

    if Length(FLastResponse) < 3 then begin
        FLastResponse := '500 Malformed MD5 Challenge: ' + FLastResponse;
        SetErrorMessage;
        TriggerRequestDone(500);
        Exit;
    end;

    Challenge := Copy(FLastResponse, 3, Length(FLastResponse) - 2);
    Challenge := Base64Decode(Challenge);

    {See RFC2104 }
    for Count := 0 to 63 do begin
        if (Count + 1) <= Length(FPassword) then begin
            IPAD[Count] := Byte(FPassword[Count+1]) xor $36;
            OPAD[Count] := Byte(FPassword[Count+1]) xor $5C;
        end
        else begin
            IPAD[Count] := 0 xor $36;
            OPAD[Count] := 0 xor $5C;
        end;
    end;

    MD5Init(MD5Context);
    MD5Update(MD5Context, IPAD, 64);
    MD5UpdateBuffer(MD5Context, @Challenge[1], Length(Challenge));
    MD5Final(MD5Digest, MD5Context);
    MD5Init(MD5Context);
    MD5Update(MD5Context, OPAD, 64);
    MD5Update(MD5Context, MD5Digest, 16);
    MD5Final(MD5Digest, MD5Context);

    Response := FUsername;
    Response := Response + ' ';
    for Count := 0 to 15 do begin
        Response := Response + HexDigits[((Byte(MD5Digest[Count]) and $F0) shr 4)];
        Response := Response + HexDigits[(Byte(MD5Digest[Count]) and $0F)];
    end;

    FState := pop3InternalReady;
    ExecAsync(pop3Pass, Base64encode(Response), pop3Transaction, nil);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Auth; {HLX}
begin
    if FProtocolState > pop3WaitingUser then begin
        FErrorMessage := '-ERR AUTH command invalid now';
        Display(FErrorMessage);
        raise Pop3Exception.Create(FErrorMessage);
    end;

    case FAuthType of
    popAuthLogin    : ExecAsync(pop3Auth, 'AUTH LOGIN',
                                pop3WaitingUser, AuthLoginNext);
    popAuthCramSHA1 :
{$IFDEF DELPHI5_UP}