idsmtpserver.pas

Indy控件的使用源代码

end;

destructor TIdSMTPServer.Destroy;
begin
  FreeandNil(fMessages);
  inherited;
end;

procedure TIdSMTPServer.SetMessages(AValue: TIdSMTPMessages);
begin
  FMessages.Assign(AValue);
end;

constructor TIdSMTPServerThread.Create(ACreateSuspended: Boolean = True);
begin
  inherited;
  SMTPState := idSMTPNone;
end;

procedure TIdSMTPServerThread.BeforeRun;
begin
  SMTPState := idSMTPNone;
  From:='';
  HELO:=false;
  EHLO:=false;
  Username:='';
  Password:='';
  LoggedIn:=false;
  FreeAndNil(RCPTList);
  RCPTList := TIdEMailAddressList.Create(nil);
  inherited BeforeRun;
end;

destructor TIdSMTPServerThread.Destroy;
begin
  FreeAndNil(RCPTList);
  inherited;
end;

procedure TIdSMTPServer.InitializeCommandHandlers;
begin
  inherited;
  with CommandHandlers.Add do
  begin
    // AUTH
    Command := 'AUTH';    {Do not Localize}
    OnCommand := CommandAUTH;
  end;
  with CommandHandlers.Add do
  begin
    // HELP
    Command := 'HELP';    {Do not Localize}
    OnCommand := CommandHELP;
  end;
  with CommandHandlers.Add do
  begin
    // SOML
    Command := 'SOML';    {Do not Localize}
    OnCommand := CommandSOML;
  end;
  with CommandHandlers.Add do
  begin
    // SEND
    Command := 'SEND';    {Do not Localize}
    OnCommand := CommandSEND;
  end;
  with CommandHandlers.Add do
  begin
    // SAML
    Command := 'SAML';    {Do not Localize}
    OnCommand := CommandSAML;
  end;
  with CommandHandlers.Add do
  begin
    // VRFY
    Command := 'VRFY';    {Do not Localize}
    OnCommand := CommandVRFY;
  end;
  with CommandHandlers.Add do
  begin
    // EXPN
    Command := 'EXPN';    {Do not Localize}
    OnCommand := CommandEXPN;
  end;
  with CommandHandlers.Add do
  begin
    // TURN
    Command := 'TURN';    {Do not Localize}
    OnCommand := CommandTURN;
  end;
  with CommandHandlers.Add do
  begin
    // RSET <CRLF>
    Command := 'RSET';    {Do not Localize}
    ReplyNormal.NumericCode := 250;
    ReplyNormal.Text.Text := Messages.NoopReply;
    OnCommand := CommandRSET;
  end;
  with CommandHandlers.Add do
  begin
    // DATA <CRLF>
    Command := 'DATA';    {Do not Localize}
    //      Moved into the actual event, due to the response being sent AFTER the command completed!!!
    //      ReplyNormal.NumericCode := 354;
    //      ReplyNormal.Text.Text := Messages.DataReplies.StartDataReply;
    OnCommand := CommandData;
  end;
  with CommandHandlers.Add do
  begin
    // HELO <SP> <domain> <CRLF>
    Command := 'HELO';    {Do not Localize}
    CmdDelimiter := ' ';    {Do not Localize}
    OnCommand := CommandHELO;
  end;
  with CommandHandlers.Add do
  begin
    // EHLO <SP> <domain> <CRLF>
    Command := 'EHLO';    {Do not Localize}
    CmdDelimiter := ' ';    {Do not Localize}
    OnCommand := CommandEHLO;
  end;
  with CommandHandlers.Add do
  begin
    // MAIL <SP> FROM:<reverse-path> <CRLF>
    Command := 'MAIL';    {Do not Localize}
    CmdDelimiter := ' ';    {Do not Localize}
    OnCommand := CommandMail;
  end;
  with CommandHandlers.Add do
  begin
    // NOOP
    Command := 'NOOP';    {Do not Localize}
    ReplyNormal.NumericCode := 250;
    ReplyNormal.Text.Text := FMessages.NOOPReply;
  end;
  with CommandHandlers.Add do
  begin
    // QUIT
    Command := 'QUIT';    {Do not Localize}
    CmdDelimiter := ' ';    {Do not Localize}
    Disconnect := True;
    ReplyNormal.NumericCode := 221;
    ReplyNormal.Text.Text := FMessages.QuitReply;
  end;
  with CommandHandlers.Add do
  begin
    // RCPT <SP> TO:<forward-path> <CRLF>
    Command := 'RCPT';    {Do not Localize}
    CmdDelimiter := ' ';    {Do not Localize}
    OnCommand := CommandRcpt;
  end;
end;

procedure TIdSMTPServer.CommandData(ASender: TIdCommand);
var
  LMsg: TIdMessage;
  LMsgClient: TIdMessageClient;
  LStream: TMemoryStream;
  LFileStream : TFileStream;
  LFileName : String;
  x: integer;
  CustomError:string;
begin
  with TIdSMTPServerThread(ASender.Thread) do
  begin
    if SMTPState <> idSMTPRcpt then
    begin
      Connection.Writeln('503 '+ FMessages.SequenceError);    {Do not Localize}
      Exit;
    end;
  end;

  if TIdSMTPServerThread(ASender.Thread).HELO then
  begin
    ASender.Thread.Connection.Writeln('354 ' +    {Do not Localize}
      Messages.DataReplies.StartDataReply);
    case ReceiveMode of
      rmRaw:
        begin
          if not Assigned(OnReceiveRaw) then
            raise EIdTCPServerError.Create('No OnReceiveRaw defined.');    {Do not Localize}
          if FRawStreamType = stMemoryStream then begin
            LStream := TMemoryStream.Create;
            try
              ASender.Thread.Connection.Capture(LStream, '.', True);    {Do not Localize}
              OnReceiveRaw(ASender, TStream(LStream), TIdSMTPServerThread(ASender.Thread).RCPTList,CustomError);
            finally
              FreeAndNil(LStream);
            end;
            end
          else
          if FRawStreamType = stFileStream then begin
            LFileName := MakeTempFilename;
            LFileStream := TFileStream.Create(LFileName,fmCreate);
            try
              ASender.Thread.Connection.Capture(LFileStream, '.', True);    {Do not Localize}
              OnReceiveRaw(ASender, TStream(LFileStream), TIdSMTPServerThread(ASender.Thread).RCPTList,CustomError);
            finally
              FreeAndNil(LFileStream);
              if FileExists(LFileName) then
                DeleteFile(LFileName);
            end;
            end;
        end;
      rmMessage:
        begin
          if not Assigned(OnReceiveMessage) then
            raise EIdTCPServerError.Create('No OnReceiveMessage defined.');    {Do not Localize}
          LMsg := TIdMessage.Create(Nil);
          try
            ASender.Thread.Connection.Capture(LMsg.Headers, '');    {Do not Localize}
              // Was ' ' but this doesnt work right ;)    {Do not Localize}
            ASender.Thread.Connection.Capture(LMsg.Body, '.', True);    {Do not Localize}
            LMsg.Headers.Values['X-Server'] := FMessages.XServer;    {Do not Localize}
            OnReceiveMessage(ASender, LMsg, TIdSMTPServerThread(ASender.Thread).RCPTList, CustomError);
          finally
            FreeAndNil(LMsg);
          end;
        end;
      rmMessageParsed:
        begin
          if not Assigned(OnReceiveMessageParsed) then
            raise
              EIdTCPServerError.Create('No OnReceiveMessageParsed defined.');    {Do not Localize}
          try
            LMsg := TIdMessage.Create(Nil);
            LMsg.NoDecode := fNoDecode;
            LMsg.NoEncode := fNoEncode;
            LMsgClient := TIdMessageClient.Create(Nil);
            LMsgClient.IOHandler := ASender.Thread.Connection.IOHandler;

            LMsgClient.ProcessMessage(LMsg);
            LMsg.Headers.Values['X-Server'] := FMessages.XServer;    {Do not Localize}
            // Match RCTPList to the TO Field in msg. Difference is the BCCList.
            // Check the TO
            if TIdSMTPServerThread(ASender.Thread).RCPTList.Count > 0 then
              for x := 1 to TIdSMTPServerThread(ASender.Thread).RCPTList.Count do
              begin
                if IndyPos(TIdSMTPServerThread(ASender.Thread).RCPTList.Items[x
                  - 1].Address, LMsg.Recipients.EMailAddresses) = 0 then
                begin
                  if IndyPos(TIdSMTPServerThread(ASender.Thread).RCPTList.Items[x - 1].Address, LMsg.CCList.EMailAddresses) = 0 then
                    Lmsg.BCCList.Add.Text := TIdSMTPServerThread(ASender.Thread).RCPTList.Items[x - 1].Text;
                end;
              end;
            OnReceiveMessageParsed(ASender, LMsg, TIdSMTPServerThread(ASender.Thread).RCPTList, CustomError);
          finally
            LMsgClient.IOHandler := nil;
            FreeAndNil(LMsgClient);
            FreeAndNil(LMsg);
          end;
        end;
    end;
    CustomError := Trim(CustomError);
    if CustomError = '' then    {Do not Localize}
    begin
      ASender.Thread.Connection.WriteLn('250 ' + Messages.DataReplies.EndDataReply);    {Do not Localize}
      TIdSMTPServerThread(ASender.Thread).SMTPState := idSMTPData;
    end
    else
      ASender.Thread.Connection.Writeln(CustomError);
  end
  else // No EHLO / HELO was received
    ASender.Thread.Connection.Writeln('501 ' + FMessages.Greeting.NoHello);    {Do not Localize}
end;

procedure TIdSMTPServer.CommandAUTH(ASender: TIdCommand);
var
  Login: string;
begin
  if TIdSMTPServerThread(ASender.Thread).EHLO then
    if not Assigned(fOnCommandAUTH) then
    begin
      if Length(ASender.UnparsedParams) > 0 then
      begin
        Login := ASender.UnparsedParams;
        DoAuthLogin(ASender, Login)
      end
      else
        ASender.Thread.Connection.WriteLn('500 ' + FMessages.ErrorReply);    {Do not Localize}
    end // If Assigned (fOnCommandAUTH) Then
    else
    begin
      OnCommandAuth(Asender);
    end
  else // EHLO needs to be enabled for the AUTH command to work
    ASender.Thread.Connection.Writeln('500 ' + FMessages.ErrorReply);    {Do not Localize}
end;

function TIdSMTPServer.DoAuthLogin(ASender: TIdCommand; const Login:string): Boolean;
var
  S: string;
  Username, Password: string;
  AuthFailed: Boolean;
  Accepted: Boolean;
begin
  Result := False;
  AuthFailed := False;

  if UpperCase(Login) = 'LOGIN' then    {Do not Localize}
  begin // LOGIN USING THE LOGIN AUTH - BASE64 ENCODED
    s := 'Username:';    {Do not Localize}
    s := TIdEncoderMIME.EncodeString(s);
    //  s := SendRequest( '334 ' + s );    {Do not Localize}
    ASender.Thread.connection.Writeln('334 ' + s);    {Do not Localize}
    s := Trim(ASender.Thread.Connection.ReadLn);
    if s <> '' then    {Do not Localize}
    begin
      try
        s := TIdDecoderMIME.DecodeString(s);

        Username := s;
        // What? Endcode this string literal?
        s := 'Password:';    {Do not Localize}
        s := TIdEncoderMIME.EncodeString(s);
        //    s := SendRequest( '334 ' + s );    {Do not Localize}
        ASender.Thread.connection.Writeln('334 ' + s);    {Do not Localize}
        s := Trim(ASender.Thread.Connection.ReadLn);
        if Length(s) = 0 then
          AuthFailed := True
        else
        begin
          Password := TIdDecoderMIME.DecodeString(s);
        end;
      // when TIdDecoderMime.DecodeString(s) raise a exception,catch it and set AuthFailed as true
      except
        AuthFailed := true;
      end;
    end
    else
      AuthFailed := True;
  end;

  // Add other login units here

  if AuthFailed then
  begin
    Result := False;
    ASender.Thread.Connection.Writeln('535 ' + fMessages.FGreeting.fAuthFailed);    {Do not Localize}
  end
  else
  begin
    Accepted := False;
    if Assigned(fCheckUser) then
      CheckUser(ASender, Accepted, Username, Password)
    else
      Accepted := True;
    TIdSMTPServerThread(ASender.Thread).LoggedIn := Accepted;
    TIdSMTPServerThread(ASender.Thread).Username := Username;
    if not Accepted then
      ASender.Thread.Connection.Writeln('535 ' + fMessages.FGreeting.fAuthFailed)    {Do not Localize}
    else
      ASender.Thread.Connection.Writeln('235 welcome ' + Trim(Username));    {Do not Localize}
  end;
end;

procedure TIdSMTPServer.CommandMail(ASender: TIdCommand);
var
  Accept: Boolean;
  EMailAddress: TIdEMailAddressItem;
begin
  if TIdSMTPServerThread(ASender.Thread).HELO then
  begin
    if AuthMode AND (not TIdSMTPServerThread(ASender.Thread).LoggedIn) then
    begin
      ASender.Thread.Connection.Writeln('553 ' + FMessages.NotLoggedIn);    {Do not Localize}
      Exit;
    end;

    //reset all information
    TIdSMTPServerThread(ASender.Thread).From := '';    {Do not Localize}
    TIdSMTPServerThread(ASender.Thread).RCPTList.Clear;
    TIdSMTPServerThread(ASender.Thread).SMTPState := idSMTPHelo;

    if Uppercase(Copy(ASender.UnparsedParams, 1, 5)) = 'FROM:' then    {Do not Localize}
    begin
      EMailAddress := TIdEMailAddressItem.Create(nil);
      try
       EMailAddress.Text := Trim(Copy(ASender.UnparsedParams, 6, Length(ASender.UnparsedParams)));
       if Assigned(fOnCommandMail) then
       begin
        OnCommandMAIL(ASender, Accept, EMailAddress.Address);
        if Accept then
        begin
          ASender.Thread.Connection.Writeln('250 ' + Format(FMessages.RcpReplies.AddressOKReply, [EMailAddress.Text]));    {Do not Localize}