You've already forked lazarus-ccr
First Commit. Tested Laz1.7 fpc 3.1.1
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5304 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
gbamber
483
components/lazautoupdate/synapse/source/lib/pop3send.pas
Normal file
483
components/lazautoupdate/synapse/source/lib/pop3send.pas
Normal file
@ -0,0 +1,483 @@
|
||||
{==============================================================================|
|
||||
| Project : Ararat Synapse | 002.006.002 |
|
||||
|==============================================================================|
|
||||
| Content: POP3 client |
|
||||
|==============================================================================|
|
||||
| Copyright (c)1999-2010, Lukas Gebauer |
|
||||
| All rights reserved. |
|
||||
| |
|
||||
| Redistribution and use in source and binary forms, with or without |
|
||||
| modification, are permitted provided that the following conditions are met: |
|
||||
| |
|
||||
| Redistributions of source code must retain the above copyright notice, this |
|
||||
| list of conditions and the following disclaimer. |
|
||||
| |
|
||||
| Redistributions in binary form must reproduce the above copyright notice, |
|
||||
| this list of conditions and the following disclaimer in the documentation |
|
||||
| and/or other materials provided with the distribution. |
|
||||
| |
|
||||
| Neither the name of Lukas Gebauer nor the names of its contributors may |
|
||||
| be used to endorse or promote products derived from this software without |
|
||||
| specific prior written permission. |
|
||||
| |
|
||||
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
|
||||
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
|
||||
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|
||||
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
|
||||
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
||||
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
|
||||
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
|
||||
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
|
||||
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
|
||||
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
|
||||
| DAMAGE. |
|
||||
|==============================================================================|
|
||||
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
|
||||
| Portions created by Lukas Gebauer are Copyright (c)2001-2010. |
|
||||
| All Rights Reserved. |
|
||||
|==============================================================================|
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
{:@abstract(POP3 protocol client)
|
||||
|
||||
Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$ENDIF}
|
||||
{$H+}
|
||||
{$M+}
|
||||
|
||||
{$IFDEF UNICODE}
|
||||
{$WARN IMPLICIT_STRING_CAST OFF}
|
||||
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
|
||||
{$ENDIF}
|
||||
|
||||
unit pop3send;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes,
|
||||
blcksock, synautil, synacode;
|
||||
|
||||
const
|
||||
cPop3Protocol = '110';
|
||||
|
||||
type
|
||||
|
||||
{:The three types of possible authorization methods for "logging in" to a POP3
|
||||
server.}
|
||||
TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP);
|
||||
|
||||
{:@abstract(Implementation of POP3 client protocol.)
|
||||
|
||||
Note: Are you missing properties for setting Username and Password? Look to
|
||||
parent @link(TSynaClient) object!
|
||||
|
||||
Are you missing properties for specify server address and port? Look to
|
||||
parent @link(TSynaClient) too!}
|
||||
TPOP3Send = class(TSynaClient)
|
||||
private
|
||||
FSock: TTCPBlockSocket;
|
||||
FResultCode: Integer;
|
||||
FResultString: string;
|
||||
FFullResult: TStringList;
|
||||
FStatCount: Integer;
|
||||
FStatSize: Integer;
|
||||
FListSize: Integer;
|
||||
FTimeStamp: string;
|
||||
FAuthType: TPOP3AuthType;
|
||||
FPOP3cap: TStringList;
|
||||
FAutoTLS: Boolean;
|
||||
FFullSSL: Boolean;
|
||||
function ReadResult(Full: Boolean): Integer;
|
||||
function Connect: Boolean;
|
||||
function AuthLogin: Boolean;
|
||||
function AuthApop: Boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
{:You can call any custom by this method. Call Command without trailing CRLF.
|
||||
If MultiLine parameter is @true, multilined response are expected.
|
||||
Result is @true on sucess.}
|
||||
function CustomCommand(const Command: string; MultiLine: Boolean): boolean;
|
||||
|
||||
{:Call CAPA command for get POP3 server capabilites.
|
||||
note: not all servers support this command!}
|
||||
function Capability: Boolean;
|
||||
|
||||
{:Connect to remote POP3 host. If all OK, result is @true.}
|
||||
function Login: Boolean;
|
||||
|
||||
{:Disconnects from POP3 server.}
|
||||
function Logout: Boolean;
|
||||
|
||||
{:Send RSET command. If all OK, result is @true.}
|
||||
function Reset: Boolean;
|
||||
|
||||
{:Send NOOP command. If all OK, result is @true.}
|
||||
function NoOp: Boolean;
|
||||
|
||||
{:Send STAT command and fill @link(StatCount) and @link(StatSize) property.
|
||||
If all OK, result is @true.}
|
||||
function Stat: Boolean;
|
||||
|
||||
{:Send LIST command. If Value is 0, LIST is for all messages. After
|
||||
successful operation is listing in FullResult. If all OK, result is @True.}
|
||||
function List(Value: Integer): Boolean;
|
||||
|
||||
{:Send RETR command. After successful operation dowloaded message in
|
||||
@link(FullResult). If all OK, result is @true.}
|
||||
function Retr(Value: Integer): Boolean;
|
||||
|
||||
{:Send RETR command. After successful operation dowloaded message in
|
||||
@link(Stream). If all OK, result is @true.}
|
||||
function RetrStream(Value: Integer; Stream: TStream): Boolean;
|
||||
|
||||
{:Send DELE command for delete specified message. If all OK, result is @true.}
|
||||
function Dele(Value: Integer): Boolean;
|
||||
|
||||
{:Send TOP command. After successful operation dowloaded headers of message
|
||||
and maxlines count of message in @link(FullResult). If all OK, result is
|
||||
@true.}
|
||||
function Top(Value, Maxlines: Integer): Boolean;
|
||||
|
||||
{:Send UIDL command. If Value is 0, UIDL is for all messages. After
|
||||
successful operation is listing in FullResult. If all OK, result is @True.}
|
||||
function Uidl(Value: Integer): Boolean;
|
||||
|
||||
{:Call STLS command for upgrade connection to SSL/TLS mode.}
|
||||
function StartTLS: Boolean;
|
||||
|
||||
{:Try to find given capabily in capabilty string returned from POP3 server
|
||||
by CAPA command.}
|
||||
function FindCap(const Value: string): string;
|
||||
published
|
||||
{:Result code of last POP3 operation. 0 - error, 1 - OK.}
|
||||
property ResultCode: Integer read FResultCode;
|
||||
|
||||
{:Result string of last POP3 operation.}
|
||||
property ResultString: string read FResultString;
|
||||
|
||||
{:Stringlist with full lines returned as result of POP3 operation. I.e. if
|
||||
operation is LIST, this property is filled by list of messages. If
|
||||
operation is RETR, this property have downloaded message.}
|
||||
property FullResult: TStringList read FFullResult;
|
||||
|
||||
{:After STAT command is there count of messages in inbox.}
|
||||
property StatCount: Integer read FStatCount;
|
||||
|
||||
{:After STAT command is there size of all messages in inbox.}
|
||||
property StatSize: Integer read FStatSize;
|
||||
|
||||
{:After LIST 0 command size of all messages on server, After LIST x size of message x on server}
|
||||
property ListSize: Integer read FListSize;
|
||||
|
||||
{:If server support this, after comnnect is in this property timestamp of
|
||||
remote server.}
|
||||
property TimeStamp: string read FTimeStamp;
|
||||
|
||||
{:Type of authorisation for login to POP3 server. Dafault is autodetect one
|
||||
of possible authorisation. Autodetect do this:
|
||||
|
||||
If remote POP3 server support APOP, try login by APOP method. If APOP is
|
||||
not supported, or if APOP login failed, try classic USER+PASS login method.}
|
||||
property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
|
||||
|
||||
{:If is set to @true, then upgrade to SSL/TLS mode if remote server support it.}
|
||||
property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
|
||||
|
||||
{:SSL/TLS mode is used from first contact to server. Servers with full
|
||||
SSL/TLS mode usualy using non-standard TCP port!}
|
||||
property FullSSL: Boolean read FFullSSL Write FFullSSL;
|
||||
{:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
|
||||
property Sock: TTCPBlockSocket read FSock;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TPOP3Send.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FFullResult := TStringList.Create;
|
||||
FPOP3cap := TStringList.Create;
|
||||
FSock := TTCPBlockSocket.Create;
|
||||
FSock.Owner := self;
|
||||
FSock.ConvertLineEnd := true;
|
||||
FTimeout := 60000;
|
||||
FTargetPort := cPop3Protocol;
|
||||
FStatCount := 0;
|
||||
FStatSize := 0;
|
||||
FListSize := 0;
|
||||
FAuthType := POP3AuthAll;
|
||||
FAutoTLS := False;
|
||||
FFullSSL := False;
|
||||
end;
|
||||
|
||||
destructor TPOP3Send.Destroy;
|
||||
begin
|
||||
FSock.Free;
|
||||
FPOP3cap.Free;
|
||||
FullResult.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TPOP3Send.ReadResult(Full: Boolean): Integer;
|
||||
var
|
||||
s: AnsiString;
|
||||
begin
|
||||
Result := 0;
|
||||
FFullResult.Clear;
|
||||
s := FSock.RecvString(FTimeout);
|
||||
if Pos('+OK', s) = 1 then
|
||||
Result := 1;
|
||||
FResultString := s;
|
||||
if Full and (Result = 1) then
|
||||
repeat
|
||||
s := FSock.RecvString(FTimeout);
|
||||
if s = '.' then
|
||||
Break;
|
||||
if s <> '' then
|
||||
if s[1] = '.' then
|
||||
Delete(s, 1, 1);
|
||||
FFullResult.Add(s);
|
||||
until FSock.LastError <> 0;
|
||||
if not Full and (Result = 1) then
|
||||
FFullResult.Add(SeparateRight(FResultString, ' '));
|
||||
if FSock.LastError <> 0 then
|
||||
Result := 0;
|
||||
FResultCode := Result;
|
||||
end;
|
||||
|
||||
function TPOP3Send.CustomCommand(const Command: string; MultiLine: Boolean): boolean;
|
||||
begin
|
||||
FSock.SendString(Command + CRLF);
|
||||
Result := ReadResult(MultiLine) <> 0;
|
||||
end;
|
||||
|
||||
function TPOP3Send.AuthLogin: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if not CustomCommand('USER ' + FUserName, False) then
|
||||
exit;
|
||||
Result := CustomCommand('PASS ' + FPassword, False)
|
||||
end;
|
||||
|
||||
function TPOP3Send.AuthAPOP: Boolean;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
s := StrToHex(MD5(FTimeStamp + FPassWord));
|
||||
Result := CustomCommand('APOP ' + FUserName + ' ' + s, False);
|
||||
end;
|
||||
|
||||
function TPOP3Send.Connect: Boolean;
|
||||
begin
|
||||
// Do not call this function! It is calling by LOGIN method!
|
||||
FStatCount := 0;
|
||||
FStatSize := 0;
|
||||
FSock.CloseSocket;
|
||||
FSock.LineBuffer := '';
|
||||
FSock.Bind(FIPInterface, cAnyPort);
|
||||
if FSock.LastError = 0 then
|
||||
FSock.Connect(FTargetHost, FTargetPort);
|
||||
if FSock.LastError = 0 then
|
||||
if FFullSSL then
|
||||
FSock.SSLDoConnect;
|
||||
Result := FSock.LastError = 0;
|
||||
end;
|
||||
|
||||
function TPOP3Send.Capability: Boolean;
|
||||
begin
|
||||
FPOP3cap.Clear;
|
||||
Result := CustomCommand('CAPA', True);
|
||||
if Result then
|
||||
FPOP3cap.AddStrings(FFullResult);
|
||||
end;
|
||||
|
||||
function TPOP3Send.Login: Boolean;
|
||||
var
|
||||
s, s1: string;
|
||||
begin
|
||||
Result := False;
|
||||
FTimeStamp := '';
|
||||
if not Connect then
|
||||
Exit;
|
||||
if ReadResult(False) <> 1 then
|
||||
Exit;
|
||||
s := SeparateRight(FResultString, '<');
|
||||
if s <> FResultString then
|
||||
begin
|
||||
s1 := Trim(SeparateLeft(s, '>'));
|
||||
if s1 <> s then
|
||||
FTimeStamp := '<' + s1 + '>';
|
||||
end;
|
||||
Result := False;
|
||||
if Capability then
|
||||
if FAutoTLS and (Findcap('STLS') <> '') then
|
||||
if StartTLS then
|
||||
Capability
|
||||
else
|
||||
begin
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
|
||||
begin
|
||||
Result := AuthApop;
|
||||
if not Result then
|
||||
begin
|
||||
if not Connect then
|
||||
Exit;
|
||||
if ReadResult(False) <> 1 then
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
if not Result and not (FAuthType = POP3AuthAPOP) then
|
||||
Result := AuthLogin;
|
||||
end;
|
||||
|
||||
function TPOP3Send.Logout: Boolean;
|
||||
begin
|
||||
Result := CustomCommand('QUIT', False);
|
||||
FSock.CloseSocket;
|
||||
end;
|
||||
|
||||
function TPOP3Send.Reset: Boolean;
|
||||
begin
|
||||
Result := CustomCommand('RSET', False);
|
||||
end;
|
||||
|
||||
function TPOP3Send.NoOp: Boolean;
|
||||
begin
|
||||
Result := CustomCommand('NOOP', False);
|
||||
end;
|
||||
|
||||
function TPOP3Send.Stat: Boolean;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
Result := CustomCommand('STAT', False);
|
||||
if Result then
|
||||
begin
|
||||
s := SeparateRight(ResultString, '+OK ');
|
||||
FStatCount := StrToIntDef(Trim(SeparateLeft(s, ' ')), 0);
|
||||
FStatSize := StrToIntDef(Trim(SeparateRight(s, ' ')), 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPOP3Send.List(Value: Integer): Boolean;
|
||||
var
|
||||
s: string;
|
||||
n: integer;
|
||||
begin
|
||||
if Value = 0 then
|
||||
s := 'LIST'
|
||||
else
|
||||
s := 'LIST ' + IntToStr(Value);
|
||||
Result := CustomCommand(s, Value = 0);
|
||||
FListSize := 0;
|
||||
if Result then
|
||||
if Value <> 0 then
|
||||
begin
|
||||
s := SeparateRight(ResultString, '+OK ');
|
||||
FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
|
||||
end
|
||||
else
|
||||
for n := 0 to FFullResult.Count - 1 do
|
||||
FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
|
||||
end;
|
||||
|
||||
function TPOP3Send.Retr(Value: Integer): Boolean;
|
||||
begin
|
||||
Result := CustomCommand('RETR ' + IntToStr(Value), True);
|
||||
end;
|
||||
|
||||
//based on code by Miha Vrhovnik
|
||||
function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
Result := False;
|
||||
FFullResult.Clear;
|
||||
Stream.Size := 0;
|
||||
FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
|
||||
|
||||
s := FSock.RecvString(FTimeout);
|
||||
if Pos('+OK', s) = 1 then
|
||||
Result := True;
|
||||
FResultString := s;
|
||||
if Result then begin
|
||||
repeat
|
||||
s := FSock.RecvString(FTimeout);
|
||||
if s = '.' then
|
||||
Break;
|
||||
if s <> '' then begin
|
||||
if s[1] = '.' then
|
||||
Delete(s, 1, 1);
|
||||
end;
|
||||
WriteStrToStream(Stream, s);
|
||||
WriteStrToStream(Stream, CRLF);
|
||||
until FSock.LastError <> 0;
|
||||
end;
|
||||
|
||||
if Result then
|
||||
FResultCode := 1
|
||||
else
|
||||
FResultCode := 0;
|
||||
end;
|
||||
|
||||
function TPOP3Send.Dele(Value: Integer): Boolean;
|
||||
begin
|
||||
Result := CustomCommand('DELE ' + IntToStr(Value), False);
|
||||
end;
|
||||
|
||||
function TPOP3Send.Top(Value, Maxlines: Integer): Boolean;
|
||||
begin
|
||||
Result := CustomCommand('TOP ' + IntToStr(Value) + ' ' + IntToStr(Maxlines), True);
|
||||
end;
|
||||
|
||||
function TPOP3Send.Uidl(Value: Integer): Boolean;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
if Value = 0 then
|
||||
s := 'UIDL'
|
||||
else
|
||||
s := 'UIDL ' + IntToStr(Value);
|
||||
Result := CustomCommand(s, Value = 0);
|
||||
end;
|
||||
|
||||
function TPOP3Send.StartTLS: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if CustomCommand('STLS', False) then
|
||||
begin
|
||||
Fsock.SSLDoConnect;
|
||||
Result := FSock.LastError = 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPOP3Send.FindCap(const Value: string): string;
|
||||
var
|
||||
n: Integer;
|
||||
s: string;
|
||||
begin
|
||||
s := UpperCase(Value);
|
||||
Result := '';
|
||||
for n := 0 to FPOP3cap.Count - 1 do
|
||||
if Pos(s, UpperCase(FPOP3cap[n])) = 1 then
|
||||
begin
|
||||
Result := FPOP3cap[n];
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user