dxsmtpservercore.pas

Well known and usefull component for delphi 7

unit DXSMTPServerCore;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXSMTPServerCore
//       Author: G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 1995-2003
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2003
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
//               Example is Internet Explorer - Help->About screen
//               shows the licensed code contained in the application.
// Code Version: (4th Generation Code)
// ========================================================================
//  Description: implements SMTP (Simple Mail Transport Protocol)
// ========================================================================
///////////////////////////////////////////////////////////////////////////////

uses
  Classes,
  DXServerCore;

{$I DXSock.def}

type
  SMTPTSimpleEvent = procedure(ClientThread: TDXClientThread) of object;
  SMTPTBasicEvent = procedure(ClientThread: TDXClientThread;Parm:String) of object;
  SMTPTComplexEvent = procedure(ClientThread: TDXClientThread;Parm1,OptionalParm2:String) of object;
  SMTPTOtherEvent = procedure(ClientThread: TDXClientThread;Command:String;Parm:String;Var Handled:Boolean) of object;

  TDXSMTPServerCore = class(TDXServerCore)
  private
    fOnCommandHELO:SMTPTBasicEvent;        {HELO || HELO modem1.myisp.com}
    fOnCommandEHLO:SMTPTBasicEvent;        {ELHO || ELHO modem1.myisp.com}
    fOnCommandRset:SMTPTSimpleEvent;       {RSET}
    fOnCommandMail:SMTPTComplexEvent;       {MAIL FROM: John Doe <[e-mail]> SIZE=xxx (optional)}
    fOnCommandRcpt:SMTPTComplexEvent;        {RCPT TO: John Doe <[e-mail]>}
    fOnCommandData:SMTPTSimpleEvent;       {DATA}
    fOnCommandQuit:SMTPTSimpleEvent;       {QUIT}
    fOnCommandHelp:SMTPTBasicEvent;        {HELP || HELP [command]}
    fOnCommandSend:SMTPTBasicEvent;        {SEND FROM: John Doe <[e-mail]>}
    fOnCommandSaml:SMTPTBasicEvent;        {SAML FROM: John Doe <[e-mail]>}
    fOnCommandSoml:SMTPTBasicEvent;        {SOML FROM: John Doe <[e-mail]>}
    fOnCommandNoop:SMTPTSimpleEvent;       {NOOP}
    fOnCommandExpn:SMTPTBasicEvent;        {EXPN [string]}
    fOnCommandVrfy:SMTPTBasicEvent;        {VRFY [string]}
    fOnCommandTurn:SMTPTSimpleEvent;       {TURN}
    fOnCommandEtrn:SMTPTBasicEvent;        {ETRN [zone]}
    fOnCommandOther:SMTPTOtherEvent;       {COMMAND parameters...}
  protected
    Procedure SetOnCommandHELO(value:SMTPTBasicEvent);
    Procedure SetOnCommandEHLO(value:SMTPTBasicEvent);
    Procedure SetOnCommandRSET(value:SMTPTSimpleEvent);
    Procedure SetOnCommandMAIL(value:SMTPTComplexEvent);
    Procedure SetOnCommandRCPT(value:SMTPTComplexEvent);
    Procedure SetOnCommandDATA(value:SMTPTSimpleEvent);
    Procedure SetOnCommandQUIT(value:SMTPTSimpleEvent);
    Procedure SetOnCommandHELP(value:SMTPTBasicEvent);
    Procedure SetOnCommandSEND(value:SMTPTBasicEvent);
    Procedure SetOnCommandSAML(value:SMTPTBasicEvent);
    Procedure SetOnCommandSOML(value:SMTPTBasicEvent);
    Procedure SetOnCommandNOOP(value:SMTPTSimpleEvent);
    Procedure SetOnCommandEXPN(value:SMTPTBasicEvent);
    Procedure SetOnCommandVRFY(value:SMTPTBasicEvent);
    Procedure SetOnCommandTURN(value:SMTPTSimpleEvent);
    Procedure SetOnCommandETRN(value:SMTPTBasicEvent);
  public
    constructor Create(AOwner:TComponent); {$IFNDEF OBJECTS_ONLY} override; {$ENDIF}
    destructor Destroy; override;
    procedure SayHello(ClientThread:TDXClientThread;Header:String);
    procedure SayGoodbye(ClientThread:TDXClientThread;Footer:String);
    procedure SayOK(ClientThread:TDXClientThread;OptionalNote:String);
    procedure SayNotImplemented(ClientThread:TDXClientThread);
    procedure SayRcptUnknown(ClientThread:TDXClientThread);
    procedure SayMailUnknown(ClientThread:TDXClientThread);
    procedure SayReadyForMessage(ClientThread:TDXClientThread);
    procedure SayReceivedMessage(ClientThread:TDXClientThread;OptionalSize:Integer);
{$IFDEF VER100}
    function GetMessage(ClientThread:TDXClientThread;Stream:TStream;MaxSize:Integer):Boolean;
{$ELSE}
    function GetMessage(ClientThread:TDXClientThread;Stream:TStream;MaxSize:Int64):Boolean;
{$ENDIF}
    procedure ProcessSession(ClientThread:TDXClientThread);
    Procedure AddBasicEvent(Command:String;EventProc:SMTPTBasicEvent);
    Procedure AddSimpleEvent(Command:String;EventProc:SMTPTSimpleEvent);
    Procedure AddComplexEvent(Command:String;EventProc:SMTPTComplexEvent);
  published
    property OnCommandHelo: SMTPTBasicEvent read fOnCommandHelo
                                        write SetOnCommandHelo;
    property OnCommandEhlo: SMTPTBasicEvent read fOnCommandEhlo
                                        write SetOnCommandEhlo;
    property OnCommandRset: SMTPTSimpleEvent read fOnCommandRset
                                         write SetOnCommandRset;
    property OnCommandMail: SMTPTComplexEvent read fOnCommandMail
                                        write SetOnCommandMail;
    property OnCommandRcpt: SMTPTComplexEvent read fOnCommandRcpt
                                        write SetOnCommandRcpt;
    property OnCommandData: SMTPTSimpleEvent read fOnCommandData
                                         write SetOnCommandData;
    property OnCommandQuit: SMTPTSimpleEvent read fOnCommandQuit
                                         write SetOnCommandQuit;
    property OnCommandHelp: SMTPTBasicEvent read fOnCommandHelp
                                        write SetOnCommandHelp;
    property OnCommandSend: SMTPTBasicEvent read fOnCommandSend
                                        write SetOnCommandSend;
    property OnCommandSaml: SMTPTBasicEvent read fOnCommandSaml
                                        write SetOnCommandSaml;
    property OnCommandSoml: SMTPTBasicEvent read fOnCommandSoml
                                        write SetOnCommandSoml;
    property OnCommandNoop: SMTPTSimpleEvent read fOnCommandNoop
                                         write SetOnCommandNoop;
    property OnCommandExpn: SMTPTBasicEvent read fOnCommandExpn
                                        write SetOnCommandExpn;
    property OnCommandVrfy: SMTPTBasicEvent read fOnCommandVrfy
                                        write SetOnCommandVrfy;
    property OnCommandTurn: SMTPTSimpleEvent read fOnCommandTurn
                                         write SetOnCommandTurn;
    property OnCommandEtrn: SMTPTBasicEvent read fOnCommandEtrn
                                         write SetOnCommandEtrn;
    property OnCommandOther: SMTPTOtherEvent read fOnCommandOther
                                         write fOnCommandOther;
  end;

implementation

Uses
   DXSock,
   DXString;

Type
  PSMTPBasicEvent=^TSMTPBasicEvent;
  TSMTPBasicEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:SMTPTBasicEvent;
  End;
  PSMTPSimpleEvent=^TSMTPSimpleEvent;
  TSMTPSimpleEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:SMTPTSimpleEvent;
  End;
  PSMTPComplexEvent=^TSMTPComplexEvent;
  TSMTPComplexEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:SMTPTComplexEvent;
  End;

(* from RFC821...
       'HELO', {1}
       'EHLO', {2}
       'RSET', {3}
       'MAIL', {4}
       'RCPT', {5}
       'DATA', {6}
       'QUIT', {7}
       'HELP', {8}
       'SEND', {9}
       'SAML', {10}
       'SOML', {11}
       'NOOP', {12}
       'EXPN', {13}
       'VRFY', {14}
       'TURN', {15}
       'ETRN'  {16}
*)

constructor TDXSMTPServerCore.Create(AOwner:TComponent);
begin
   inherited Create(AOwner);
   ServerPort:=25;
end;

destructor TDXSMTPServerCore.Destroy;
Var
   PBasicEvent:PSMTPBasicEvent;
   PSimpleEvent:PSMTPSimpleEvent;
   PComplexEvent:PSMTPComplexEvent;

begin
   If Assigned(fEventArray) then Begin
      While fEventArray.Count>0 do Begin
         Case PSMTPBasicEvent(fEventArray[0]).Tag of
            1:Begin
              PBasicEvent:=fEventArray[0];
              Dispose(PBasicEvent);
            End;
            2:Begin
              PSimpleEvent:=fEventArray[0];
              Dispose(PSimpleEvent);
            End;
            3:Begin
              PComplexEvent:=fEventArray[0];
              Dispose(PComplexEvent);
            End;
         End;
         fEventArray.Delete(0);
      End;
   End;
   inherited Destroy;
end;

Procedure TDXSMTPServerCore.AddBasicEvent(Command:String;EventProc:SMTPTBasicEvent);
Var
   PBasicEvent:PSMTPBasicEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PSMTPBasicEvent(fEventArray[Loop]).Command=Command then Begin
         PSMTPBasicEvent(fEventArray[Loop]).EventProcedure:=EventProc;
         Exit;
      End
      Else Inc(Loop);
   End;
   New(PBasicEvent);
   PBasicEvent.Tag:=1;      // Denotes Event in fEventArray is a TBasicEvent!
   PBasicEvent.Command:=Command;
   PBasicEvent.EventProcedure:=EventProc;
   fEventArray.Add(PBasicEvent);
End;

Procedure TDXSMTPServerCore.AddSimpleEvent(Command:String;EventProc:SMTPTSimpleEvent);
Var
   PSimpleEvent:PSMTPSimpleEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PSMTPSimpleEvent(fEventArray[Loop]).Command=Command then Begin
         PSMTPSimpleEvent(fEventArray[Loop]).EventProcedure:=EventProc;
         Exit;
      End
      Else Inc(Loop);
   End;
   New(PSimpleEvent);
   PSimpleEvent.Tag:=2;      // Denotes Event in fEventArray is a TSimpleEvent!
   PSimpleEvent.Command:=Command;
   PSimpleEvent.EventProcedure:=EventProc;
   fEventArray.Add(PSimpleEvent);
End;

Procedure TDXSMTPServerCore.AddComplexEvent(Command:String;EventProc:SMTPTComplexEvent);
Var
   PComplexEvent:PSMTPComplexEvent;
   Loop:Integer;