pop3cli.pas

BaiduMp3 search baidu mp3

        Exit;

    if FTimeStamp = '' then begin
        FErrorMessage := '-ERR Server do not support APOP (no timestamp)';
        Display(FErrorMessage);
        Exit;
    end;

    SendCommand('APOP ' + Trim(FUserName)+ ' ' +
                StrMD5(FTimeStamp + FPassWord));
    if not GetResponse then
        Exit;
    Result         := TRUE;
    FProtocolState := pop3WaitingPass;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Pass : Boolean;
begin
    Result := PassRpop('PASS');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Rpop : Boolean;
begin
    Result := PassRpop('RPOP');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.PassRpop(OpCode : String) : Boolean;
begin
    Result := FALSE;
    if FProtocolState > pop3WaitingPass then begin
        FErrorMessage := '-ERR ' + OpCode + ' command invalid now';
        Display(FErrorMessage);
        Exit;
    end;

    if (FProtocolState < pop3WaitingPass) and (not User) then
        Exit;

    SendCommand(OpCode + ' ' + Trim(FPassWord));
    if not GetResponse then
        Exit;
    Result         := TRUE;
    FProtocolState := pop3Transaction;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Retr : Boolean;
begin
    Result := StartTransaction('RETR', IntToStr(FMsgNum));
    if not Result then
        Exit;
    Result := GetMultiLine(FOnMessageBegin, FOnMessageLine, FOnMessageEnd, nil);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Stat : Boolean;
begin
    FMsgCount := 0;
    FMsgSize  := 0;
    
    Result := StartTransaction('STAT', '');
    if not Result then
        Exit;

    Result := ExtractNumbers(FMsgCount, FMsgSize);
end;


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


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.List : Boolean;
begin
    if FMsgNum <= 0 then begin
        { Scan LIST command (all messages) }
        Result := StartTransaction('LIST', '');
        if not Result then
            Exit;
        Result := GetMultiLine(FOnListBegin, FOnListLine,
                               FOnListEnd,   ProcessList);
    end
    else begin
        { Single message LIST command }
        Result := StartTransaction('LIST', IntToStr(FMsgNum));
        if not Result then
            Exit;
        Result := ExtractNumbers(FMsgNum, FMsgSize);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Uidl : Boolean;
begin
    if FMsgNum <= 0 then begin
        { UIDL command (all messages) }
        Result := StartTransaction('UIDL', '');
        if not Result then
            Exit;
        Result := GetMultiLine(FOnUidlBegin, FOnUidlLine,
                               FOnUidlEnd,   ProcessUidl);
    end
    else begin
        { Single message UIDL command }
        Result := StartTransaction('UIDL', IntToStr(FMsgNum));
        if not Result then
            Exit;
        Result := ExtractUidl(FMsgNum, FMsgUidl);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Dele : Boolean;
begin
    Result := StartTransaction('DELE', IntToStr(FMsgNum));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Noop : Boolean;
begin
    Result := StartTransaction('NOOP', '');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Last : Boolean;
begin
    Result := StartTransaction('LAST', '');
    if Result then
        Result := ExtractNumbers(FMsgNum, FMsgSize);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Rset : Boolean;
begin
    Result := StartTransaction('RSET', '');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Top : Boolean;
begin
    if FMsgLines < 0 then
        Result := FALSE
    else
        Result := StartTransaction('TOP' , IntToStr(FMsgNum) + ' ' +
                                           IntToStr(FMsgLines));
    if not Result then
        Exit;
    Result := GetMultiLine(FOnMessageBegin, FOnMessageLine, FOnMessageEnd, nil);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.StartTransaction(OpCode, Params : String) : Boolean;
begin
    Result  := FALSE;

    if (FProtocolState < pop3Transaction) and (not Pass) then
        Exit;

    if FProtocolState <> pop3Transaction then begin
        FErrorMessage := '-ERR ' + OpCode + ' command invalid now';
        Display(FErrorMessage);
        Exit;
    end;

    if Params <> '' then
        SendCommand(OpCode + ' ' + Params)
    else
        SendCommand(OpCode);

    Result := GetResponse;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.GetMultiLine(
    aOnBegin : TNotifyEvent;
    aOnLine  : TNotifyEvent;
    aOnEnd   : TNotifyEvent;
    aProcess : TNotifyEvent) : Boolean;
var
    bFlag : Boolean;
begin
    { Let the application know that the message is beginning }
    if Assigned(aOnBegin) then
        aOnBegin(Self);

    bFlag := FALSE;
    try
        while TRUE do begin
            { Read a message line }
            FLineTooLong := FALSE;
            if FWSocket.State = wsConnected then
                FWSocket.ReadLine(FTimeout, FLastResponse);

            { Check if we are still connected }
            if FWSocket.State <> wsConnected then begin
                FErrorMessage := '-ERR Disconneced unexpectedly';
                Display(FErrorMessage);
                break;
            end;

            { Check if we timed out }
            if FTimeOutFlag then begin
                FErrorMessage := '-ERR Receive Timeout';
                Display(FErrorMessage);
                break;
            end;

            { Check if end of message }
            if (not bFlag) and (FLastResponse = '.') then begin
                FLastResponse := '';
                break;
            end;

            { Check if message contains end-of-message mark }
            if (Length(FLastResponse) >= 2) and
               (FLastResponse[1] = '.') and (FLastResponse[2] = '.') then
                { Remove byte-stuff }
                FLastResponse := Copy(FLastResponse, 2, Length(FLastResponse));

            { Additional process }
            if Assigned(aProcess) then
                aProcess(Self);

            { Let the application process the message line }
            if Assigned(aOnLine) then
                aOnLine(Self);

            bFlag := FLineTooLong;

            { Let other application breaze }
            Application.ProcessMessages;
        end;
    finally
        { Let the application know that the message is finished }
        if Assigned(aOnEnd) then
            aOnEnd(Self);
    end;

    Result := not FTimeOutFlag;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.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 TPop3Client.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 TPop3Client.WaitTimeOut(Sender : TObject);
begin
    FTimeOutFlag := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPop3Client.LineTooLong(Sender : TObject);
begin
    FLineTooLong := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPop3Client.SessionClosed(Sender : TObject; Error : WORD);
begin
    if Assigned(FWait) then
        FWait.Stop;
    FProtocolState := pop3Disconnected;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPop3Client.SendCommand(Cmd : String);
begin
    Display('> ' + Cmd);
    Application.ProcessMessages;
    FWSocket.SendStr(Cmd + #13 + #10);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.GetResponse : Boolean;
begin
    FWSocket.ReadLine(FTimeout, FLastResponse);
    Display('< ' + FLastResponse);
    Result := ((Length(FLastResponse) > 0) and (FLastResponse[1] = '+'));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPop3Client.SetWait(Value : TWait);
begin
    FWait             := Value;
    FWSocket.WaitCtrl := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPop3Client.Notification(AComponent: TComponent; Operation: TOperation);
begin
    inherited Notification(AComponent, Operation);
    if Operation = opRemove then begin
        if AComponent = FWait then
            FWait := nil
        else if AComponent = FWSocket then
            FWSocket := nil;
    end;
end;


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


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


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Register;
begin
    RegisterComponents('FPiette', [TPop3Client]);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.