dxsmtpservercore.pas

Well known and usefull component for delphi 7

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

Procedure TDXSMTPServerCore.SetOnCommandHELO(value:SMTPTBasicEvent);
Begin
   fOnCommandHELO:=Value;
   AddBasicEvent('HELO',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandEHLO(value:SMTPTBasicEvent);
Begin
   fOnCommandEHLO:=Value;
   AddBasicEvent('EHLO',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandRSET(value:SMTPTSimpleEvent);
Begin
   fOnCommandRSET:=Value;
   AddSimpleEvent('RSET',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandMAIL(value:SMTPTComplexEvent);
Begin
   fOnCommandMAIL:=Value;
   AddComplexEvent('MAIL',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandRCPT(value:SMTPTComplexEvent);
Begin
   fOnCommandRCPT:=Value;
   AddComplexEvent('RCPT',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandDATA(value:SMTPTSimpleEvent);
Begin
   fOnCommandDATA:=Value;
   AddSimpleEvent('DATA',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandQUIT(value:SMTPTSimpleEvent);
Begin
   fOnCommandQUIT:=Value;
   AddSimpleEvent('QUIT',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandHELP(value:SMTPTBasicEvent);
Begin
   fOnCommandHELP:=Value;
   AddBasicEvent('HELP',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandSEND(value:SMTPTBasicEvent);
Begin
   fOnCommandSEND:=Value;
   AddBasicEvent('SEND',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandSAML(value:SMTPTBasicEvent);
Begin
   fOnCommandSAML:=Value;
   AddBasicEvent('SAML',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandSOML(value:SMTPTBasicEvent);
Begin
   fOnCommandSOML:=Value;
   AddBasicEvent('SOML',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandNOOP(value:SMTPTSimpleEvent);
Begin
   fOnCommandNOOP:=Value;
   AddSimpleEvent('NOOP',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandEXPN(value:SMTPTBasicEvent);
Begin
   fOnCommandEXPN:=Value;
   AddBasicEvent('EXPN',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandVRFY(value:SMTPTBasicEvent);
Begin
   fOnCommandVRFY:=Value;
   AddBasicEvent('VRFY',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandTURN(value:SMTPTSimpleEvent);
Begin
   fOnCommandTURN:=Value;
   AddSimpleEvent('TURN',Value);
End;

Procedure TDXSMTPServerCore.SetOnCommandETRN(value:SMTPTBasicEvent);
Begin
   fOnCommandETRN:=Value;
   AddBasicEvent('ETRN',Value);
End;

procedure TDXSMTPServerCore.SayHello(ClientThread:TDXClientThread;Header:String);
Var
   Ws:String;

Begin
   If Header<>'' then WS:=Header
   Else Ws:='SMTP Server (ready).';
   ClientThread.Socket.WriteResultCode(220,Ws);
End;

procedure TDXSMTPServerCore.SayGoodbye(ClientThread:TDXClientThread;Footer:String);
Var
   Ws:String;

Begin
   If Footer<>'' then Ws:=Footer
   Else Ws:='Goodbye.';
   ClientThread.Socket.WriteResultCode(221,Ws);
   ClientThread.Socket.CloseGracefully;
End;

procedure TDXSMTPServerCore.SayOK(ClientThread:TDXClientThread;OptionalNote:String);
Var
   Ws:String;

Begin
   If OptionalNote<>'' then Ws:='OK - '+OptionalNote
   Else Ws:='OK';
   ClientThread.Socket.WriteResultCode(250,Ws);
End;

procedure TDXSMTPServerCore.SayNotImplemented(ClientThread:TDXClientThread);
Begin
   ClientThread.Socket.WriteResultCode(502,'command not implemented');
End;

procedure TDXSMTPServerCore.SayRcptUnknown(ClientThread:TDXClientThread);
Begin
   ClientThread.Socket.WriteResultCode(503,'No recipients: need RCPT');
End;

procedure TDXSMTPServerCore.SayMailUnknown(ClientThread:TDXClientThread);
Begin
   ClientThread.Socket.WriteResultCode(503,'No originator: need MAIL');
End;

procedure TDXSMTPServerCore.SayReadyForMessage(ClientThread:TDXClientThread);
Begin
   ClientThread.Socket.WriteResultCode(354,'Send Data. End with CRLF.CRLF');
End;

procedure TDXSMTPServerCore.SayReceivedMessage(ClientThread:TDXClientThread;OptionalSize:Integer);
Begin
   If OptionalSize>0 then SayOk(ClientThread,'')
   Else SayOk(ClientThread,'stored '+IntToCommaStr(OptionalSize)+' octets');
End;

{$IFDEF VER100}
function TDXSMTPServerCore.GetMessage(ClientThread:TDXClientThread;Stream:TStream;MaxSize:Integer):Boolean;
{$ELSE}
function TDXSMTPServerCore.GetMessage(ClientThread:TDXClientThread;Stream:TStream;MaxSize:Int64):Boolean;
{$ENDIF}
Var
   Done:Boolean;

Begin
   SayReadyForMessage(ClientThread);
   With ClientThread.Socket do Begin
      Done:=False;
      While Connected and Not Done do Begin
{$IFDEF VER100}
         Done:=SaveToStream(Stream,Timeout);
{$ELSE}
         Done:=SaveTo(Stream,Timeout);
{$ENDIF}
      End;
   End;
   Result:=Stream.Size>0;
// after 3.0 add - If Result then OnFilter Stream!!
   SayReceivedMessage(ClientThread,Stream.Size);
End;

procedure TDXSMTPServerCore.ProcessSession(ClientThread:TDXClientThread);
var
  s, sCmd: string;
  Loop:Integer;
  WasHandled:Boolean;
  OutData:Pointer;

  procedure NotHandled(CMD: string);
  Var
     Ws:String;

  begin
    if (CMD<>'') then Begin
       Ws:='500 command not recognized ('+CMD+')';
       ClientThread.Socket.Writeln(Ws);
    End;
  end;

begin
   fbForceAbort:=False;
   with ClientThread.Socket do begin
      while Connected do begin
         if fbForceAbort then Exit;
         s:=ReadLn(Timeout);
         If LastReadTimeout or Not Connected then Exit;
         If LastCommandStatus=10060 then continue
         else if LastCommandStatus<>0 then Exit;
         if s='' then continue;
         if assigned({$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}) then begin
            Loop:=FilterRead(@S[1],OutData,Length(S),ClientThread);
            SetLength(S,Loop);
            If Assigned(OutData) then Begin
               FastMove(TDXBSArray(OutData^),S[1],Loop);
{$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}(ddFreePointer,nil,OutData,Loop,Loop,WasHandled,ClientThread) ;
            End;
         End;
         sCmd:=UpperCase(Fetch(s,#32,False));
         Loop:=0;
         WasHandled:=False;
         While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
            If PSMTPBasicEvent(fEventArray[Loop]).Command=sCMD then Begin
               Case PSMTPBasicEvent(fEventArray[Loop]).Tag of
                  1:if Assigned(PSMTPBasicEvent(fEventArray[Loop]).EventProcedure) then
                       SMTPTBasicEvent(PSMTPBasicEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S);
                  2:if Assigned(PSMTPSimpleEvent(fEventArray[Loop]).EventProcedure) then
                       SMTPTSimpleEvent(PSMTPSimpleEvent(fEventArray[Loop]).EventProcedure)(ClientThread);
                  3:if Assigned(PSMTPComplexEvent(fEventArray[Loop]).EventProcedure) then begin
                       FetchByChar(S,':',False);
                       sCMD:=FetchByChar(S,#32,False);
                       SMTPTComplexEvent(PSMTPComplexEvent(fEventArray[Loop]).EventProcedure)(ClientThread,sCMD,S);
                  End;
               End;
               WasHandled:=True;
            End
            Else Inc(Loop);
         End; {while}
         If sCMD='QUIT' then Exit; {Terminate}
         If Not WasHandled then Begin
            if assigned(OnCommandOther) then
               OnCommandOther(ClientThread,sCmd,s,WasHandled);
         end;
         if not WasHandled then NotHandled(sCmd);
      end; {while}
   end; {with}
end; {doExecute}

end.