smtpsend.pas

delphi写的mib browser 源码,界面友好!

{==============================================================================|
| Project : Delphree - Synapse                                   | 002.001.001 |
|==============================================================================|
| Content: SMTP client                                                         |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
| (the "License"); you may not use this file except in compliance with the     |
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
|                                                                              |
| Software distributed under the License is distributed on an "AS IS" basis,   |
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
| the specific language governing rights and limitations under the License.    |
|==============================================================================|
| The Original Code is Synapse Delphi Library.                                 |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 1999,2000,2001.          |
| All Rights Reserved.                                                         |
|==============================================================================|
| Contributor(s):                                                              |
|==============================================================================|
| History: see HISTORY.HTM from distribution package                           |
|          (Found at URL: http://www.ararat.cz/synapse/)                       |
|==============================================================================}

unit SMTPsend;

interface
uses
  Blcksock, sysutils, classes, windows, SynaUtil, SynaCode;

const
  CRLF=#13+#10;

type
  TSMTPSend = class
  private
    Sock:TTCPBlockSocket;
    procedure EnhancedCode(value:string);
    function ReadResult:integer;
  public
    timeout:integer;
    SMTPHost:string;
    SMTPPort:string;
    ResultCode:integer;
    ResultString:string;
    FullResult:TStringList;
    ESMTPcap:TStringList;
    ESMTP:boolean;
    Username:string;
    Password:string;
    AuthDone:boolean;
    ESMTPSize:boolean;
    MaxSize:integer;
    EnhCode1:integer;
    EnhCode2:integer;
    EnhCode3:integer;
    SystemName:string;
    Constructor Create;
    Destructor Destroy; override;
    function AuthLogin:Boolean;
    function AuthCram:Boolean;
    function Connect:Boolean;
    function Helo:Boolean;
    function Ehlo:Boolean;
    function login:Boolean;
    procedure logout;
    function reset:Boolean;
    function noop:Boolean;
    function mailfrom(Value:string; size:integer):Boolean;
    function mailto(Value:string):Boolean;
    function maildata(Value:Tstrings):Boolean;
    function etrn(Value:string):Boolean;
    function verify(Value:string):Boolean;
    function EnhCodeString:string;
    function FindCap(value:string):string;
  end;

function SendtoRaw
(mailfrom,mailto,SMTPHost:string;maildata:TStrings;Username,Password:string):Boolean;
function Sendto
(mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
function SendtoEx
(mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings;Username,Password:string):Boolean;

implementation

{TSMTPSend.Create}
Constructor TSMTPSend.Create;
begin
  inherited Create;
  FullResult:=TStringList.create;
  ESMTPcap:=TStringList.create;
  sock:=TTCPBlockSocket.create;
  sock.CreateSocket;
  timeout:=300000;
  SMTPhost:='localhost';
  SMTPPort:='smtp';
  Username:='';
  Password:='';
  SystemName:=sock.localname;
end;

{TSMTPSend.Destroy}
Destructor TSMTPSend.Destroy;
begin
  Sock.free;
  ESMTPcap.free;
  FullResult.free;
  inherited destroy;
end;

{TSMTPSend.EnhancedCode}
procedure TSMTPSend.EnhancedCode (value:string);
var
  s,t:string;
  e1,e2,e3:integer;
begin
  EnhCode1:=0;
  EnhCode2:=0;
  EnhCode3:=0;
  s:=copy(value,5,length(value)-4);
  t:=separateleft(s,'.');
  s:=separateright(s,'.');
  if t='' then exit;
  if length(t)>1 then exit;
  e1:=strtointdef(t,0);
  if e1=0 then exit;
  t:=separateleft(s,'.');
  s:=separateright(s,'.');
  if t='' then exit;
  if length(t)>3 then exit;
  e2:=strtointdef(t,0);
  t:=separateleft(s,' ');
  if t='' then exit;
  if length(t)>3 then exit;
  e3:=strtointdef(t,0);
  EnhCode1:=e1;
  EnhCode2:=e2;
  EnhCode3:=e3;
end;

{TSMTPSend.ReadResult}
function TSMTPSend.ReadResult:integer;
var
  s:string;
begin
  Result:=0;
  FullResult.Clear;
  repeat
    s:=sock.recvstring(timeout);
    ResultString:=s;
    FullResult.add(s);
    if sock.LastError<>0 then
      break;
  until pos('-',s)<>4;
  s:=FullResult[0];
  if Length(s)>=3 then Result:=Strtointdef(Copy(s,1,3),0);
  ResultCode:=Result;
  EnhancedCode(s);
end;

{TSMTPSend.AuthLogin}
function TSMTPSend.AuthLogin:Boolean;
begin
  Result:=false;
  Sock.SendString('AUTH LOGIN'+CRLF);
  if readresult<>334 then Exit;
  Sock.SendString(Encodebase64(username)+CRLF);
  if readresult<>334 then Exit;
  Sock.SendString(Encodebase64(password)+CRLF);
  if readresult<>235 then Exit;
  Result:=True;
end;

{TSMTPSend.AuthCram}
function TSMTPSend.AuthCram:Boolean;
var
  s:string;
begin
  Result:=false;
  Sock.SendString('AUTH CRAM-MD5'+CRLF);
  if readresult<>334 then Exit;
  s:=copy(ResultString,5,length(ResultString)-4);
  s:=DecodeBase64(s);
  s:=HMAC_MD5(s,password);
  s:=Username+' '+strtohex(s);
  Sock.SendString(Encodebase64(s)+CRLF);
  if readresult<>235 then Exit;
  Result:=True;
end;

{TSMTPSend.Connect}
function TSMTPSend.Connect:Boolean;
begin
  Result:=false;
  sock.CloseSocket;
  sock.CreateSocket;
  sock.Connect(SMTPHost,SMTPPort);
  if sock.lasterror<>0 then Exit;
  Result:=True;
end;

{TSMTPSend.Helo}
function TSMTPSend.Helo:Boolean;
var
  x:integer;
begin
  Result:=false;
  Sock.SendString('HELO '+SystemName+CRLF);
  x:=ReadResult;
  if (x<250) or (x>259) then Exit;
  Result:=True;
end;

{TSMTPSend.Ehlo}
function TSMTPSend.Ehlo:Boolean;
var
  x:integer;
begin
  Result:=false;
  Sock.SendString('EHLO '+SystemName+CRLF);
  x:=ReadResult;
  if (x<250) or (x>259) then Exit;
  Result:=True;
end;

{TSMTPSend.login}
function TSMTPSend.login:Boolean;
var
  n:integer;
  auths:string;
  s:string;
begin
  Result:=False;
  ESMTP:=true;
  AuthDone:=false;
  ESMTPcap.clear;
  ESMTPSize:=false;
  MaxSize:=0;
  if not Connect then Exit;
  if readresult<>220 then Exit;
  if not Ehlo then
    begin
      ESMTP:=false;
      if not Helo then exit;
    end;
  Result:=True;
  if ESMTP then
    begin
      for n:=1 to FullResult.count-1 do
        ESMTPcap.add(Copy(FullResult[n],5,length(Fullresult[n])-4));
      if not ((Username='') and (Password='')) then
        begin
          s:=FindCap('AUTH ');
          if s=''
            then s:=FindCap('AUTH=');
          auths:=uppercase(s);
          if s<>'' then
            begin
              if pos('CRAM-MD5',auths)>0
                then AuthDone:=AuthCram;
              if (pos('LOGIN',auths)>0) and (not authDone)
                then AuthDone:=AuthLogin;
            end;
          if AuthDone
            then Ehlo;
        end;
      s:=FindCap('SIZE');
      if s<>'' then
        begin
          ESMTPsize:=true;
          MaxSize:=StrToIntDef(copy(s,6,length(s)-5),0);
        end;
    end;
end;

{TSMTPSend.logout}
procedure TSMTPSend.logout;
begin
  Sock.SendString('QUIT'+CRLF);
  readresult;
  Sock.CloseSocket;
end;

{TSMTPSend.reset}
function TSMTPSend.reset:Boolean;
begin
  Result:=false;
  Sock.SendString('RSET'+CRLF);
  if readresult<>250 then Exit;
  Result:=True;
end;

{TSMTPSend.noop}
function TSMTPSend.noop:Boolean;
begin
  Result:=false;
  Sock.SendString('NOOP'+CRLF);
  if readresult<>250 then Exit;
  Result:=True;
end;


{TSMTPSend.mailfrom}
function TSMTPSend.mailfrom(Value:string; size:integer):Boolean;
var
  s:string;
begin
  Result:=false;
  s:='MAIL FROM:<'+Value+'>';
  if ESMTPsize and (size>0)
    then s:=s+' SIZE='+IntToStr(size);
  Sock.SendString(s+CRLF);
  if readresult<>250 then Exit;
  Result:=True;
end;

{TSMTPSend.mailto}
function TSMTPSend.mailto(Value:string):Boolean;
begin
  Result:=false;
  Sock.SendString('RCPT TO:<'+Value+'>'+CRLF);
  if readresult<>250 then Exit;
  Result:=True;
end;

{TSMTPSend.maildata}
function TSMTPSend.maildata(Value:Tstrings):Boolean;
var
  n:integer;
  s:string;
begin
  Result:=false;
  Sock.SendString('DATA'+CRLF);
  if readresult<>354 then Exit;
  for n:=0 to Value.Count-1 do
    begin
      s:=value[n];
      if Length(s)>=1 then
        if s[1]='.' then s:='.'+s;
      Sock.SendString(s+CRLF);
    end;
  Sock.SendString('.'+CRLF);
  if readresult<>250 then Exit;
  Result:=True;
end;

{TSMTPSend.etrn}
function TSMTPSend.etrn(Value:string):Boolean;
var
  x:integer;
begin
  Result:=false;
  Sock.SendString('ETRN '+Value+CRLF);
  x:=ReadResult;
  if (x<250) or (x>259) then Exit;
  Result:=True;
end;

{TSMTPSend.verify}
function TSMTPSend.verify(Value:string):Boolean;
var
  x:integer;
begin
  Result:=false;
  Sock.SendString('VRFY '+Value+CRLF);
  x:=ReadResult;
  if (x<250) or (x>259) then Exit;
  Result:=True;
end;

{TSMTPSend.EnhCodeString}
function TSMTPSend.EnhCodeString:string;
var
  s,t:string;
begin
  s:=inttostr(EnhCode2)+'.'+inttostr(EnhCode3);
  t:='';
  if s='0.0' then t:='Other undefined Status';
  if s='1.0' then t:='Other address status';
  if s='1.1' then t:='Bad destination mailbox address';
  if s='1.2' then t:='Bad destination system address';
  if s='1.3' then t:='Bad destination mailbox address syntax';
  if s='1.4' then t:='Destination mailbox address ambiguous';
  if s='1.5' then t:='Destination mailbox address valid';
  if s='1.6' then t:='Mailbox has moved';
  if s='1.7' then t:='Bad sender''s mailbox address syntax';
  if s='1.8' then t:='Bad sender''s system address';
  if s='2.0' then t:='Other or undefined mailbox status';
  if s='2.1' then t:='Mailbox disabled, not accepting messages';
  if s='2.2' then t:='Mailbox full';
  if s='2.3' then t:='Message length exceeds administrative limit';
  if s='2.4' then t:='Mailing list expansion problem';
  if s='3.0' then t:='Other or undefined mail system status';
  if s='3.1' then t:='Mail system full';
  if s='3.2' then t:='System not accepting network messages';
  if s='3.3' then t:='System not capable of selected features';
  if s='3.4' then t:='Message too big for system';
  if s='3.5' then t:='System incorrectly configured';
  if s='4.0' then t:='Other or undefined network or routing status';
  if s='4.1' then t:='No answer from host';
  if s='4.2' then t:='Bad connection';
  if s='4.3' then t:='Routing server failure';
  if s='4.4' then t:='Unable to route';
  if s='4.5' then t:='Network congestion';
  if s='4.6' then t:='Routing loop detected';
  if s='4.7' then t:='Delivery time expired';
  if s='5.0' then t:='Other or undefined protocol status';
  if s='5.1' then t:='Invalid command';
  if s='5.2' then t:='Syntax error';
  if s='5.3' then t:='Too many recipients';
  if s='5.4' then t:='Invalid command arguments';
  if s='5.5' then t:='Wrong protocol version';
  if s='6.0' then t:='Other or undefined media error';
  if s='6.1' then t:='Media not supported';
  if s='6.2' then t:='Conversion required and prohibited';
  if s='6.3' then t:='Conversion required but not supported';
  if s='6.4' then t:='Conversion with loss performed';
  if s='6.5' then t:='Conversion failed';
  if s='7.0' then t:='Other or undefined security status';
  if s='7.1' then t:='Delivery not authorized, message refused';
  if s='7.2' then t:='Mailing list expansion prohibited';
  if s='7.3' then t:='Security conversion required but not possible';
  if s='7.4' then t:='Security features not supported';
  if s='7.5' then t:='Cryptographic failure';
  if s='7.6' then t:='Cryptographic algorithm not supported';
  if s='7.7' then t:='Message integrity failure';
  s:='???-';
  if EnhCode1=2 then s:='Success-';
  if EnhCode1=4 then s:='Persistent Transient Failure-';
  if EnhCode1=5 then s:='Permanent Failure-';
  result:=s+t;
end;

{TSMTPSend.FindCap}
function TSMTPSend.FindCap(value:string):string;
var
  n:integer;
  s:string;
begin
  s:=uppercase(value);
  result:='';
  for n:=0 to ESMTPcap.count-1 do
    if pos(s,uppercase(ESMTPcap[n]))=1 then
      begin
        result:=ESMTPcap[n];
        break;
      end;
end;

{==============================================================================}

function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings;
  Username,Password:string):Boolean;
var
  SMTP:TSMTPSend;
  size:integer;
begin
  Result:=False;
  SMTP:=TSMTPSend.Create;
  try
    SMTP.SMTPHost:=SMTPHost;
    SMTP.Username:=Username;
    SMTP.Password:=Password;
    if not SMTP.login then Exit;
    size:=length(maildata.text);
    if not SMTP.mailfrom(mailfrom,size) then Exit;
    if not SMTP.mailto(mailto) then Exit;
    if not SMTP.maildata(Maildata) then Exit;
    SMTP.logout;
    Result:=True;
  finally
    SMTP.Free;
  end;
end;

function SendtoEx (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings;
  Username,Password:string):Boolean;
var
  t:TStrings;
begin
//  Result:=False;
  t:=TStringList.Create;
  try
    t.assign(Maildata);
    t.Insert(0,'');
    t.Insert(0,'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
    t.Insert(0,'subject: '+subject);
    t.Insert(0,'date: '+Rfc822DateTime(now));
    t.Insert(0,'to: '+mailto);
    t.Insert(0,'from: '+mailfrom);
    Result:=SendToRaw(mailfrom,mailto,SMTPHost,t,Username,Password);
  finally
    t.Free;
  end;
end;

function Sendto 
(mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
begin
  result:=SendToEx(mailfrom,mailto,subject,SMTPHost,maildata,'','');
end;

end.