pop3prot.pas

灰鸽子1.23源码,,,,,,,

    FFctPrv := pop3FctRSet;
    StartTransaction('RSET', '', pop3RSet, pop3Transaction, nil);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Last;
begin
    FFctPrv := pop3FctLast;
    StartTransaction('LAST', '', pop3Last, pop3Transaction, LastDone);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.LastDone;
begin
    ExtractNumbers(FMsgNum, FMsgSize);
    TriggerRequestDone(FRequestResult);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Open;
begin
    HighLevelAsync(pop3Open, [pop3FctConnect, pop3FctUser, pop3FctPass]);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.StartTransaction(
    OpCode      : String;
    Params      : String;
    RqType      : TPop3Request;
    NextState   : TPop3ProtocolState;  { Next protocol state in case of success}
    DoneTrans   : TPop3NextProc);      { What to do when done                  }
var
    Cmd : String;
begin
    if FProtocolState <> pop3Transaction then begin
        FErrorMessage := '-ERR ' + OpCode + ' command invalid now';
        Display(FErrorMessage);
        raise Pop3Exception.Create(FErrorMessage);
    end;

    FHeaderPart         := TRUE;
    FHeaderKeyword      := '';
    FHeaderData         := '';
    FHeaderFrom         := '';
    FHeaderTo           := '';
    FHeaderSubject      := '';
    FHeaderReplyTo      := '';
    FHeaderReturnPath   := '';
    FHeaderMessageId    := '';
    FHeaderDate         := '';

    Cmd := OpCode;
    if Params <> '' then
        Cmd := Cmd + ' ' + Params;
    ExecAsync(RqType, Cmd, NextState, DoneTrans);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.StartMultiLine(
    aOnBegin : TNotifyEvent;
    aOnLine  : TNotifyEvent;
    aOnEnd   : TNotifyEvent;
    aProcess : TNotifyEvent);
begin
    FMultiLineLine    := aOnLine;
    FMultiLineEnd     := aOnEnd;
    FMultiLineProcess := aProcess;

    { Let the application know that the message is beginning }
    if Assigned(aOnBegin) then
        aOnBegin(Self);

    FNext := GetALine;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.GetALine;
var
    I : Integer;
begin
    { Check if we are still connected }
    if not FConnected then begin
        FErrorMessage  := '-ERR Disconneced unexpectedly';
        FRequestResult := 500;
        Display(FErrorMessage);
        TriggerRequestDone(FRequestResult);
        Exit;
    end;

    { Check if end of message }
    if FLastResponse = '.' then begin
        { Let the application know that the message is finished }
        if Assigned(FMultiLineEnd) then
            FMultiLineEnd(Self);
        FLastResponse := '';
        FNext         := nil;
        TriggerRequestDone(0);
        Exit;
    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));

    { Check if end of header }
    if FHeaderPart then begin
        if FLastResponse = '' then begin
            { Last header line }
            FHeaderPart := FALSE;
            if Assigned(FOnHeaderEnd) then
                FOnHeaderEnd(Self);
        end
        else if FLastResponse[1] = #9 then
            { Continuation line }
            { Ignore            }
        else begin
            I := Pos(':', FLastResponse);
            if I > 0 then begin
                FHeaderKeyword := LowerCase(Trim(Copy(FLastResponse, 1, I - 1)));
                FHeaderData    := Copy(FLastResponse, I + 1, 10000);
                if FHeaderKeyword      = 'from'        then
                    FHeaderFrom       := FHeaderData
                else if FHeaderKeyword = 'to'          then
                    FHeaderTo         := FHeaderData
                else if FHeaderKeyword = 'subject'     then
                    FHeaderSubject    := FHeaderData
                else if FHeaderKeyword = 'date'        then
                    FHeaderDate       := FHeaderData
                else if FHeaderKeyword = 'message-id'  then
                    FHeaderMessageId  := FHeaderData
                else if FHeaderKeyword = 'replyto'     then
                    FHeaderReplyTo    := FHeaderData
                else if FHeaderKeyword = 'return-path' then
                    FHeaderReturnPath := FHeaderData;
            end;
        end;
    end;

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

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

    { To process next line }
    FNext := GetALine;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TSyncPop3Cli.Create(AOwner : TComponent);
begin
    inherited Create(AOwner);
    FTimeout := 15;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSyncPop3Cli.TriggerResponse(Msg : String);  { angus }
begin
    inherited TriggerResponse(Msg);
    { Evaluate the timeout period again }
    if FTimeout > 0 then
        FTimeStop := Integer(GetTickCount) + FTimeout * 1000;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.WaitUntilReady : Boolean;
begin
    Result := TRUE;           { Suppose success }
    FTimeStop := Integer(GetTickCount) + FTimeout * 1000;
    while TRUE do begin
        if FState = pop3Ready then begin
            { Back to ready state, the command is finiched }
            Result := (FRequestResult = 0);
            break;
        end;

        if  Application.Terminated or
            ((FTimeout > 0) and (Integer(GetTickCount) > FTimeStop)) then begin
            { Application is terminated or timeout occured }
            inherited Abort;
            FErrorMessage := '426 Timeout';
            FStatusCode   := 426;
            Result        := FALSE; { Command failed }
            break;
        end;
{$IFNDEF VER80}
        if FMultiThreaded then
            FWSocket.ProcessMessages
        else
{$ENDIF}
            Application.ProcessMessages;
{$IFNDEF VER80}
        { Do not use 100% CPU, but slow down transfert on high speed LAN }
        Sleep(0);
{$ENDIF}
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.Synchronize(Proc : TPop3NextProc) : Boolean;
begin
    try
        Proc;
        Result := WaitUntilReady;
    except
        Result := FALSE;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.ConnectSync : Boolean;
begin
    Result := Synchronize(Connect);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.OpenSync : Boolean;
begin
    Result := Synchronize(Open);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.UserSync : Boolean;
begin
    Result := Synchronize(User);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.PassSync : Boolean;
begin
    Result := Synchronize(Pass);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.RetrSync : Boolean;
begin
    Result := Synchronize(Retr);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.DeleSync : Boolean;
begin
    Result := Synchronize(Dele);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.UidlSync : Boolean;
begin
    Result := Synchronize(Uidl);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.LastSync : Boolean;
begin
    Result := Synchronize(Last);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.RPopSync : Boolean;
begin
    Result := Synchronize(RPop);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.TopSync : Boolean;
begin
    Result := Synchronize(Top);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.ListSync : Boolean;
begin
    Result := Synchronize(List);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.StatSync : Boolean;
begin
    Result := Synchronize(Stat);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.QuitSync : Boolean;
begin
    Result := Synchronize(Quit);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.APopSync : Boolean;
begin
    Result := Synchronize(APop);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.AbortSync : Boolean;
begin
    Result := Synchronize(Abort);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.RSetSync : Boolean;
begin
    Result := Synchronize(RSet);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSyncPop3Cli.NoopSync : Boolean;
begin
    Result := Synchronize(Noop);
end;


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


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

end.