?? pop3prot.pas
字號:
while (i > 0) and (Str[i] = ' ') do
i := i - 1;
Result := Copy(Str, 1, i);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function LTrim(Str : String) : String;
var
i : Integer;
begin
if Str[1] <> ' ' then { Petite optimisation: pas d'espace }
Result := Str
else begin
i := 1;
while (i <= Length(Str)) and (Str[i] = ' ') do
i := i + 1;
Result := Copy(Str, i, Length(Str) - i + 1);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Trim(Str : String) : String;
begin
Result := LTrim(Rtrim(Str));
end;
{$ENDIF}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function stpblk(PValue : PChar) : PChar;
begin
Result := PValue;
while Result^ in [' ', #9, #10, #13] do
Inc(Result);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function atoi(PValue : PChar) : Integer;
begin
Result := 0;
PValue := stpblk(PValue);
while PValue^ in ['0'..'9'] do begin
Result := Result * 10 + ord(PValue^) - ord('0');
Inc(PValue);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TCustomPop3Cli.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
FWSocket := TWSocket.Create(nil);
FWSocket.OnSessionClosed := WSocketSessionClosed;
FProtocolState := pop3Disconnected;
FState := pop3Ready;
FPort := 'pop3';
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TCustomPop3Cli.Destroy;
begin
if Assigned(FWSocket) then begin
FWSocket.Destroy;
FWSocket := nil;
end;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.WndProc(var MsgRec: TMessage);
begin
with MsgRec do begin
case Msg of
WM_POP3_REQUEST_DONE : WMPop3RequestDone(MsgRec);
else
Result := DefWindowProc(Handle, Msg, wParam, lParam);
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.WMPop3RequestDone(var msg: TMessage);
begin
if Assigned(FOnRequestDone) then
FOnRequestDone(Self, FRequestType, Msg.LParam);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then begin
if AComponent = FWSocket then
FWSocket := nil;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.WSocketDnsLookupDone(Sender: TObject; Error: Word);
begin
if Error <> 0 then begin
FLastResponse := '-ERR ' + WSocketErrorDesc(Error) +
' (Winsock error #' + IntToStr(Error) + ')';
FStatusCode := 500;
FRequestResult := Error; { V2.02 }
SetErrorMessage;
TriggerRequestDone(Error);
end
else begin
FWSocket.Addr := FWSocket.DnsResult;
FWSocket.Proto := 'tcp';
FWSocket.Port := FPort;
FWSocket.OnSessionConnected := WSocketSessionConnected;
FWSocket.OnDataAvailable := WSocketDataAvailable;
StateChange(pop3Connecting);
try
FWSocket.Connect;
except
on E:Exception do begin
FLastResponse := '-ERR ' + E.ClassName + ': ' + E.Message;
FStatusCode := 500;
FRequestResult := FStatusCode;
SetErrorMessage;
TriggerRequestDone(FStatusCode);
end;
end
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.WSocketSessionConnected(Sender: TObject; Error: Word);
begin
{ Do not trigger the client SessionConnected from here. We must wait }
{ to have received the server banner. }
if Error <> 0 then begin
FLastResponse := '-ERR ' + WSocketErrorDesc(Error) +
' (Winsock error #' + IntToStr(Error) + ')';
FStatusCode := 500;
FConnected := FALSE;
FRequestResult := Error; { V2.02 }
SetErrorMessage; { V2.03 }
TriggerRequestDone(Error);
FWSocket.Close;
StateChange(pop3Ready);
end
else begin
FConnected := TRUE;
StateChange(pop3WaitingBanner);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.WSocketSessionClosed(Sender : TObject; Error : WORD);
begin
FConnected := FALSE;
TriggerSessionClosed(Error);
TriggerRequestDone(WSAEINTR);
FProtocolState := pop3Disconnected;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.WSocketDataAvailable(Sender: TObject; Error: Word);
var
Len : Integer;
I, J : Integer;
begin
Len := FWSocket.Receive(@FReceiveBuffer[FReceiveLen],
sizeof(FReceiveBuffer) - FReceiveLen - 1);
if Len <= 0 then
Exit;
FReceiveBuffer[FReceiveLen + Len] := #0;
FReceiveLen := FReceiveLen + Len;
while FReceiveLen > 0 do begin
{ Search CRLF pair. We can't use Pos because it stops at first #0 }
I := 1;
while (I < FReceiveLen) and
(FReceiveBuffer[I - 1] <> #13) and (FReceiveBuffer[I] <> #10) do
Inc(I);
if I >= FReceiveLen then
break; { CRLF not found }
{$IFDEF NEVER}
I := Pos(#13#10, FReceiveBuffer);
if I <= 0 then
break;
if I > FReceiveLen then
break;
{$ENDIF}
{ Found a CRLF. Extract data from buffer }
FLastResponse := Copy(FReceiveBuffer, 1, I - 1);
TriggerResponse(FLastResponse);
{$IFDEF DUMP}
FDumpBuf := '>|';
FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
FDumpStream.WriteBuffer(FLastResponse[1], Length(FLastResponse));
FDumpBuf := '|' + #13#10;
FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
{$ENDIF}
{$IFDEF VER80}
{ Add a nul byte at the end of string for Delphi 1 }
FLastResponse[Length(FLastResponse) + 1] := #0;
{$ENDIF}
FReceiveLen := FReceiveLen - I - 1;
if FReceiveLen > 0 then
Move(FReceiveBuffer[I + 1], FReceiveBuffer[0], FReceiveLen + 1);
if FState = pop3WaitingBanner then begin
DisplayLastResponse;
if not OkResponse then begin
SetErrorMessage;
FRequestResult := FStatusCode;
FWSocket.Close;
Exit;
end;
I := Pos('<', FLastResponse);
J := Pos('>', Copy(FLastResponse, I, Length(FLastREsponse)));
if (I > 0) and (J > 0) then
FTimeStamp := Copy(FLastResponse, I, J);
FProtocolState := pop3WaitingUser;
StateChange(pop3Connected);
TriggerSessionConnected(Error);
if Assigned(FWhenConnected) then
FWhenConnected
else begin
TriggerRequestDone(0);
end;
end
else if FState = pop3WaitingResponse then begin
if Assigned(FNext) then
FNext
else
raise Pop3Exception.Create('Program error: FNext is nil');
end
else begin
{ Unexpected data received }
DisplayLastResponse;
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.TriggerResponse(Msg : String);
begin
if Assigned(FOnResponse) then
FOnResponse(Self, Msg);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.TriggerStateChange;
begin
if Assigned(FOnStateChange) then
FOnStateChange(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.TriggerRequestDone(Error: Word);
begin
{ Special processing for Quit (Roger Morton 24-12-99) }
if FRequestType = pop3Quit then begin
if FWaitingOnQuit then
{ When the second RqDone arrives (from WSocketSessionClosed), }
{ treat it as a normal event by setting a zero Error code }
Error := 0
else begin
{ When the first RqDone arrives, set the FWaitingOnQuit flag so }
{ we're ready to handle a second RqDone. }
{ Take no other action (in particular, we don't advise the user }
{ that the first RqDone has happened) }
FWaitingOnQuit := True;
Exit;
end;
{ Fall down here for all normal RqDone, and after the second RqDone }
{ following a Quit }
FWaitingOnQuit := False;
end;
if not FRequestDoneFlag then begin
FRequestDoneFlag := TRUE;
if Assigned(FNextRequest) then begin
if FState <> pop3Abort then
StateChange(pop3InternalReady);
FNextRequest;
end
else begin
StateChange(pop3Ready);
{ Restore the lastresponse saved before quit command }
if FHighLevelFlag and (FStatusCodeSave >= 0) then begin
FLastResponse := FLastResponseSave;
FStatusCode := FStatusCodeSave;
end;
FHighLevelFlag := FALSE;
PostMessage(Handle, WM_POP3_REQUEST_DONE, 0, Error);
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.TriggerDisplay(Msg : String);
begin
if Assigned(FOnDisplay) then
FOnDisplay(Self, Msg);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.TriggerSessionConnected(Error : Word);
begin
if Assigned(FOnSessionConnected) then
FOnSessionConnected(Self, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.TriggerSessionClosed(Error : Word);
begin
if Assigned(FOnSessionClosed) then
FOnSessionClosed(Self, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomPop3Cli.DoHighLevelAsync;
begin
{$IFDEF TRACE} TriggerDisplay('! HighLevelAsync ' + IntToStr(FRequestResult)); {$ENDIF}
if FState = pop3Abort then begin
{$IFDEF TRACE} TriggerDisplay('! Abort detected'); {$ENDIF}
FFctSet := [];
FHighLevelResult := 426;
FErrorMessage := '426 Operation aborted.';
end;
FNextRequest := DoHighLevelAsync;
if FRequestResult <> 0 then begin
{ Previous command had errors }
FHighLevelResult := FRequestResult;
if (FFctPrv = pop3FctQuit) or (not (pop3FctQuit in FFctSet)) then
FFctSet := []
else
FFctSet := [pop3FctQuit];
end;
if pop3FctConnect in FFctSet then begin
FFctPrv := pop3FctConnect;
FFctSet := FFctSet - [FFctPrv];
Connect;
Exit;
end;
if pop3FctUser in FFctSet then begin
FFctPrv := pop3FctUser;
FFctSet := FFctSet - [FFctPrv];
User;
Exit;
end;
if pop3FctPass in FFctSet then begin
FFctPrv := pop3FctPass;
FFctSet := FFctSet - [FFctPrv];
Pass;
Exit;
end;
if pop3FctRPop in FFctSet then begin
FFctPrv := pop3FctRPop;
FFctSet := FFctSet - [FFctPrv];
RPop;
Exit;
end;
if pop3FctDele in FFctSet then begin
FFctPrv := pop3FctDele;
FFctSet := FFctSet - [FFctPrv];
Dele;
Exit;
end;
if pop3FctNoop in FFctSet then begin
FFctPrv := pop3FctNoop;
FFctSet := FFctSet - [FFctPrv];
Noop;
Exit;
end;
if pop3FctList in FFctSet then begin
FFctPrv := pop3FctList;
FFctSet := FFctSet - [FFctPrv];
List;
Exit;
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -