idsmtpserver.pas

Indy控件的使用源代码

          TIdSMTPServerThread(ASender.Thread).From := EMailAddress.Text;
          TIdSMTPServerThread(ASender.Thread).SMTPState := idSMTPMail;
        end
        else
          ASender.Thread.Connection.Writeln('500 ' + Format(FMessages.RcpReplies.AddressErrorReply, [EMailAddress.Text]));    {Do not Localize}
       end
       else
       begin
        TIdSMTPServerThread(ASender.Thread).From := EMailAddress.Text;
        ASender.Thread.Connection.Writeln('250 ' + Format(FMessages.RcpReplies.AddressOKReply, [EMailAddress.Text]));    {Do not Localize}
        TIdSMTPServerThread(ASender.Thread).SMTPState := idSMTPMail;
       end;
      Finally
       EMailAddress.Free;
      End;
    end
    else
      // JP: Also needs to be moved into a resource string
      ASender.Thread.Connection.Writeln('501 Parameter error! Example: mail from:<[e-mail]>');    {Do not Localize}
  end
  else // No EHLO / HELO was received
    ASender.Thread.Connection.Writeln('501 ' + FMessages.Greeting.NoHello);    {Do not Localize}
end;

procedure TIdSMTPServer.CommandRcpt(ASender: TIdCommand);
var
  Accept, ToForward: Boolean;
  EMailAddress: TIdEMailAddressItem;
  CustomError: string;
begin
  with TIdSMTPServerThread(ASender.Thread) do
  begin
    if (SMTPState <> idSMTPMail) AND (SMTPState <> idSMTPRcpt) then
    begin
      Connection.Writeln('503 '+ FMessages.SequenceError);    {Do not Localize}
      Exit;
    end;
  end;

  if TIdSMTPServerThread(ASender.Thread).HELO then
  begin
    if (Uppercase(Copy(ASender.UnparsedParams, 1, 3)) = 'TO:') then    {Do not Localize}
    begin
      EMailAddress := TIdEMailAddressItem.Create(nil);
      EMailAddress.Text := Trim(Copy(ASender.UnparsedParams, 4,
        Length(ASender.UnparsedParams)));
      if Assigned(fONCommandRCPT) then
      begin
        Accept := False;
        ToForward := False;
        OnCommandRCPT(ASender, Accept, ToForward, EMailAddress.Address,
          CustomError);
        if Trim(CustomError) = '' then    {Do not Localize}
        begin
          if Accept and ToForward then
            ASender.Thread.Connection.Writeln('251 ' +    {Do not Localize}
              Format(FMessages.RcpReplies.AddressWillForwardReply,
              [EMailAddress.Text]));
          if Accept and not ToForward then
            ASender.Thread.Connection.Writeln('250 ' +    {Do not Localize}
              Format(FMessages.RcpReplies.AddressOkReply, [EMailAddress.Text]));
          if not Accept and (Trim(CustomError) = '') then    {Do not Localize}
            ASender.Thread.Connection.Writeln('500 ' +    {Do not Localize}
              Format(FMessages.RcpReplies.AddressErrorReply,
              [EMailAddress.Text]));
          if Accept then
          begin
            TIdSMTPServerThread(ASender.Thread).RcptList.Add.Text :=
              EMailAddress.Text;
            TIdSMTPServerThread(ASender.Thread).SMTPState := idSMTPRcpt;
          end
        end
        else
          ASender.Thread.Connection.Writeln(Format(CustomError,
            [EMailAddress.Text]));
      end
      else
      begin
        TIdSMTPServerThread(ASender.Thread).RcptList.Add.Text := EMailAddress.Text;
        ASender.Thread.Connection.Writeln('250 ' + Format(FMessages.RcpReplies.AddressOkReply, [EMailAddress.Text]));    {Do not Localize}
        TIdSMTPServerThread(ASender.Thread).SMTPState := idSMTPRcpt;
      end;
      EMailAddress.Free;
    end
    else
      // JP: Also needs to be moved into a resource string
      ASender.Thread.Connection.Writeln('501 Command parameter error! Example: rcpt to:<a@b.c>');    {Do not Localize}
  end
  else // No EHLO / HELO was received
    ASender.Thread.Connection.Writeln('501 ' + FMessages.Greeting.NoHello);    {Do not Localize}
end;

procedure TIdSMTPServer.CommandRSET(ASender: TIdCommand);
begin
  TIdSMTPServerThread(ASender.Thread).RCPTList.Clear;
  TIdSMTPServerThread(ASender.Thread).From := '';    {Do not Localize}
  with TIdSMTPServerThread(ASender.Thread) do
  begin
    if Ehlo or Helo then
      SMTPState := idSMTPHelo
    else
      SMTPState := idSMTPNone;
  end;
end;

procedure TIdSMTPServer.CommandHELO(ASender: TIdCommand);
begin
  with TIdSMTPServerThread(ASender.Thread) do
  begin
    if SMTPState <> idSMTPNone then
    begin
      Connection.Writeln('503 '+ FMessages.SequenceError);    {Do not Localize}
      Exit;
    end;
  end;

  if Length(ASender.UnparsedParams) > 0 then
  begin
    ASender.Thread.Connection.Writeln('250 ' + Format(FMessages.Greeting.HelloReply, [ASender.UnparsedParams]));    {Do not Localize}
    TIdSMTPServerThread(ASender.Thread).HELO := True;
    TIdSMTPServerThread(ASender.Thread).SMTPState := idSMTPHelo;
  end
  else
    // JP: Also needs to be moved into a resource string
    ASender.Thread.Connection.Writeln('501 Syntax Error in parameters or arguments');    {Do not Localize}
end;

procedure TIdSMTPServer.CommandEHLO(ASender: TIdCommand);
begin
  if fAllowEHLO then
  begin
    with TIdSMTPServerThread(ASender.Thread) do
    begin
      if SMTPState <> idSMTPNone then
      begin
        Connection.Writeln('503 ' + FMessages.SequenceError);    {Do not Localize}
        Exit;
      end;
    end;

    if Length(ASender.UnparsedParams) > 0 then
    begin
      ASender.Thread.Connection.WriteStrings(FMessages.Greeting.EHLOReply);
      TIdSMTPServerThread(ASender.Thread).HELO := True;
      TIdSMTPServerThread(ASender.Thread).EHLO := True;
      TIdSMTPServerThread(ASender.Thread).SMTPState := idSMTPHelo;
    end
    else
      // JP: Also needs to be moved into a resource string
      ASender.Thread.Connection.Writeln('501 Syntax Error in parameters or arguments');    {Do not Localize}
  end
  else
    ASender.Thread.Connection.Writeln('500 ' +    {Do not Localize}
      FMessages.Greeting.EHLONotSupported);
end;

// Simple events, simply exposed with minimal processing

procedure TIdSMTPServer.CommandHELP(ASender: TIdCommand);
begin
  if Assigned(fOnCommandHELP) then
    OnCommandHelp(ASender)
  else
    ASender.Thread.Connection.Writeln('500 ' + Format(FMessages.FErrorReply, [ASender.UnparsedParams]));    {Do not Localize}
end;

procedure TIdSMTPServer.CommandSOML(ASender: TIdCommand);
begin
  if Assigned(fOnCommandSOML) then
    OnCommandSOML(ASender)
  else
    ASender.Thread.Connection.Writeln('500 ' + Format(FMessages.FErrorReply, [ASender.UnparsedParams]));    {Do not Localize}
end;

procedure TIdSMTPServer.CommandSEND(ASender: TIdCommand);
begin
  if Assigned(fOnCommandSEND) then
    OnCommandSEND(ASender)
  else
    ASender.Thread.Connection.Writeln('500 ' + Format(FMessages.FErrorReply, [ASender.UnparsedParams]));    {Do not Localize}
end;

procedure TIdSMTPServer.CommandSAML(ASender: TIdCommand);
begin
  if Assigned(fOnCommandSAML) then
    OnCommandSAML(ASender)
  else
    ASender.Thread.Connection.Writeln('500 ' + Format(FMessages.FErrorReply, [ASender.UnparsedParams]));    {Do not Localize}
end;

procedure TIdSMTPServer.CommandVRFY(ASender: TIdCommand);
begin
  if Assigned(fOnCommandVRFY) then
    OnCommandVRFY(ASender)
  else
    ASender.Thread.Connection.Writeln('500 ' + Format(FMessages.FErrorReply, [ASender.UnparsedParams]));    {Do not Localize}
end;

procedure TIdSMTPServer.CommandEXPN(ASender: TIdCommand);
begin
  if Assigned(fOnCommandEXPN) then
    OnCommandEXPN(ASender)
  else
    ASender.Thread.Connection.Writeln('500 ' + Format(FMessages.FErrorReply, [ASender.UnparsedParams]));    {Do not Localize}
end;

procedure TIdSMTPServer.CommandTURN(ASender: TIdCommand);
begin
  if Assigned(fOnCommandTURN) then
    OnCommandTURN(ASender)
  else
    ASender.Thread.Connection.Writeln('500 ' + Format(FMessages.FErrorReply, [ASender.UnparsedParams]));    {Do not Localize}
end;

{ TIdSMTPMessages }

procedure TIdSMTPMessages.Assign(Source: TPersistent);
var
  o: TIdSMTPMessages;
begin
  inherited;
  if ClassType <> Source.ClassType then
    inherited
  else
  begin
    o := TIdSMTPMessages(Source);
    FNoopReply := o.NoopReply;
    FRSetReply := o.RSetReply;
    FQuitReply := o.QuitReply;
    FErrorReply := o.ErrorReply;
    ReceivedHeader := o.ReceivedHeader;
    FXserver := o.XServer;
    FSyntaxErrorReply := o.SyntaxErrorReply;
    FGreeting.Assign(o.Greeting);
    FRcpReplies.Assign(o.RcpReplies);
    FDataReplies.Assign(o.DataReplies);
  end;
end;

constructor TIdSMTPMessages.Create;
begin
  inherited Create;
  FNoopReply := RSSMTPSvrOk;
  FRSetReply := RSSMTPSvrOk;
  FQuitReply := RSSMTPSvrQuit;
  FErrorReply := RSSMTPSvrCmdGeneralError;
//  FSequenceError := RSSMTPSvrBadSequence;  // TO DO:   need to put back in place later
  FSyntaxErrorReply := RSSMTPSvrCmdGeneralError;
//  FNotLoggedIn := RSSMTPNotLoggedIn;       // TO DO:  need to put back in place later
  FGreeting := TIdSMTPGreeting.Create;

  FRcpReplies := TIdSMTPRcpReplies.Create;
  FDataReplies := TIdSMTPDataReplies.Create;
  ReceivedHeader := RSSMTPSvrReceivedHeader;
  fXServer := RSSMTPSvrXServer;

end;

destructor TIdSMTPMessages.Destroy;
begin
  FreeAndNil(FGreeting);
  FreeAndNil(FRcpReplies);
  FreeAndNil(FDataReplies);
  inherited;
end;

procedure TIdSMTPMessages.SetDataReplies(const AValue: TIdSMTPDataReplies);
begin
  FDataReplies.Assign(AValue);
end;

procedure TIdSMTPMessages.SetGreeting(const AValue: TIdSMTPGreeting);
begin
  FGreeting.Assign(AValue);
end;

procedure TIdSMTPMessages.SetRcpReplies(const AValue: TIdSMTPRcpReplies);
begin
  FRcpReplies.Assign(AValue);
end;

{ TIdSMTPDataReplies }

procedure TIdSMTPDataReplies.Assign(Source: TPersistent);
var
  o: TIdSMTPDataReplies;
begin
  inherited;
  if ClassType <> Source.ClassType then
    inherited
  else
  begin
    o := TIdSMTPDataReplies(Source);
    fStartDataReply := o.StartDataReply;
    fEndDataReply := o.EndDataReply;
  end;
end;

constructor TIdSMTPDataReplies.Create;
begin
  inherited Create;
  fStartDataReply := RSSMTPSvrStartData;
  fEndDataReply := RSSMTPSvrOk;
end;

{ TIdSMTPRcpReplies }

procedure TIdSMTPRcpReplies.Assign(Source: TPersistent);
var
  o: TIdSMTPRcpReplies;
begin
  if ClassType <> Source.ClassType then
  begin
    inherited;
  end
  else
  begin
    o := TIdSMTPRcpReplies(Source);
    fAddressOkReply := o.AddressOkReply;
    FAddressErrorReply := o.AddressErrorReply;
    FAddressWillForwardReply := o.AddressWillForwardReply;
  end;
end;

constructor TIdSMTPRcpReplies.Create;
begin
  inherited Create;
  fAddressOkReply := RSSMTPSvrAddressOk;
  FAddressErrorReply := RSSMTPSvrAddressError;
  FAddressWillForwardReply := RSSMTPSvrAddressWillForward;
end;

{ TIdSMTPGreeting }

procedure TIdSMTPGreeting.Assign(Source: TPersistent);
var
  o: TIdSMTPGreeting;
begin
  inherited;
  if ClassType <> Source.ClassType then
  begin
    inherited;
  end
  else
  begin
    o := TIdSMTPGreeting(Source);
    FEHLONotSupported := o.EHLONotSupported;
    FHelloReply := o.HelloReply;
    fNoHello := o.NoHello;
    fEHLOReply.Assign(o.EHLOReply);
  end;
end;

constructor TIdSMTPGreeting.Create;
begin
  inherited Create;
  fEHLOReply := TStringList.Create;
  fEHLOReply.Add('250-'+GStack.WSGetHostName);    {Do not Localize}
  fEHLOReply.Add('250-AUTH LOGIN');    {Do not Localize}
  fEHLOReply.Add('250 HELP');    {Do not Localize}
  fHelloReply := RSSMTPSvrHello;
  fNoHello := RSSMTPSvrNoHello;
  fEHLONotSupported := RSSMTPSvrCmdNotRecognized;
  fAuthFailed := RSSMTPSvrAuthFailed;
end;

destructor TIdSMTPGreeting.Destroy;
begin
  FreeAndNil(FEHLOReply);
  inherited;
end;

procedure TIdSMTPGreeting.SetEHLOReply(const AValue: TStrings);
begin
  FEHLOReply := AValue;
end;

procedure TIdSMTPServer.SetRawStreamType(const Value: TIdStreamType);
begin
  FRawStreamType := Value;
end;

end.