?? pop3prot.pas
字號:
if pop3FctRSet in FFctSet then begin
FFctPrv := pop3FctRSet;
FFctSet := FFctSet - [FFctPrv];
RSet;
Exit;
end;
if pop3FctAPop in FFctSet then begin
FFctPrv := pop3FctAPop;
FFctSet := FFctSet - [FFctPrv];
APop;
Exit;
end;
if pop3FctRetr in FFctSet then begin
FFctPrv := pop3FctRetr;
FFctSet := FFctSet - [FFctPrv];
Retr;
Exit;
end;
if pop3FctTop in FFctSet then begin
FFctPrv := pop3FctTop;
FFctSet := FFctSet - [FFctPrv];
Top;
Exit;
end;
if pop3FctStat in FFctSet then begin
FFctPrv := pop3FctStat;
FFctSet := FFctSet - [FFctPrv];
Stat;
Exit;
end;
if pop3FctUidl in FFctSet then begin
FFctPrv := pop3FctUidl;
FFctSet := FFctSet - [FFctPrv];
Uidl;
Exit;
end;
if pop3FctLast in FFctSet then begin
FFctPrv := pop3FctLast;
FFctSet := FFctSet - [FFctPrv];
Last;
Exit;
end;
if pop3FctQuit in FFctSet then begin
FFctPrv := pop3FctQuit;
FFctSet := FFctSet - [FFctPrv];
Quit;
Exit;
end;
{$IFDEF TRACE} TriggerDisplay('! HighLevelAsync done'); {$ENDIF}
FFctSet := [];
FNextRequest := nil;
FRequestDoneFlag := FALSE;
TriggerRequestDone(FHighLevelResult);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.HighLevelAsync(
RqType : Tpop3Request; Fcts : Tpop3FctSet);
begin
if FConnected and (pop3FctConnect in Fcts) then
raise pop3Exception.Create('pop3 component already connected');
CheckReady;
FLastResponseSave := FLastResponse;
FStatusCodeSave := -1;
FRequestType := RqType;
FRequestResult := 0;
FFctSet := Fcts;
FFctPrv := pop3FctNone;
FHighLevelResult := 0;
FHighLevelFlag := TRUE;
FLastResponse := '';
FErrorMessage := '';
FRestartFlag := FALSE;
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;
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.User;
begin
if FProtocolState > pop3WaitingUser then begin
FErrorMessage := '-ERR USER command invalid now';
Display(FErrorMessage);
raise Pop3Exception.Create(FErrorMessage);
end;
FFctPrv := pop3FctUser;
ExecAsync(pop3User, 'USER ' + Trim(FUserName), pop3WaitingPass, nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Connect;
begin
CheckReady;
if FConnected then
raise Pop3Exception.Create('POP3 component already connected');
if not FHighLevelFlag then
FRequestType := pop3Connect;
FRequestDoneFlag := FALSE;
FReceiveLen := 0;
FRequestResult := 0;
StateChange(pop3DnsLookup);
FWSocket.OnDataSent := nil;
FWSocket.OnDnsLookupDone := WSocketDnsLookupDone;
FWSocket.DnsLookup(FHost);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Abort;
begin
StateChange(pop3Abort);
FWSocket.CancelDnsLookup;
FWSocket.Abort;
StateChange(pop3Ready);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Pass;
begin
if FProtocolState > pop3WaitingPass then begin
FErrorMessage := '-ERR PASS command invalid now';
Display(FErrorMessage);
raise Pop3Exception.Create(FErrorMessage);
end;
FFctPrv := pop3FctPass;
ExecAsync(pop3Pass, 'PASS ' + Trim(FPassWord), pop3Transaction, nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.RPop;
begin
if FProtocolState > pop3WaitingPass then begin
FErrorMessage := '-ERR RPOP command invalid now';
Display(FErrorMessage);
raise Pop3Exception.Create(FErrorMessage);
end;
FFctPrv := pop3FctRPop;
ExecAsync(pop3RPop, 'RPOP ' + Trim(FPassWord), pop3Transaction, nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.APop;
begin
if FProtocolState <> pop3WaitingUser then begin
FErrorMessage := '-ERR APOP command invalid now';
Display(FErrorMessage);
raise Pop3Exception.Create(FErrorMessage);
end;
if FTimeStamp = '' then begin
FErrorMessage := '-ERR Server do not support APOP (no timestamp)';
Display(FErrorMessage);
raise Pop3Exception.Create(FErrorMessage);
end;
FFctPrv := pop3FctAPop;
ExecAsync(pop3APop, 'APOP ' + Trim(FUserName) + ' ' +
StrMD5(FTimeStamp + FPassWord),
pop3Transaction, nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Quit;
begin
CheckReady;
FFctPrv := pop3FctQuit;
if not FConnected then begin
{ We are not connected, it's ok... }
FRequestType := pop3Quit;
FRequestDoneFlag := FALSE;
TriggerRequestDone(0);
Exit;
end;
ExecAsync(pop3Quit, 'QUIT', pop3Disconnected, nil); { Should I force a FWSocket.Close }
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Stat;
begin
FFctPrv := pop3FctStat;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -