main.pas

这是一套全面的网络组件

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, clTcpServer, clUserMgr, SyncObjs, clUtils,
  clSmtpFileHandler, clSmtpServer, IniFiles;

type
  TMainForm = class(TForm)
    btnStart: TButton;
    btnStop: TButton;
    memLog: TMemo;
    edtPort: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edtMailboxDir: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    clSmtpServer1: TclSmtpServer;
    clSmtpFileHandler1: TclSmtpFileHandler;
    Label6: TLabel;
    edtRelayDir: TEdit;
    GroupBox1: TGroupBox;
    cbUseLogin: TCheckBox;
    cbUseSPA: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure clSmtpServer1Start(Sender: TObject);
    procedure clSmtpServer1Stop(Sender: TObject);
    procedure clSmtpServer1CramMD5Authenticate(Sender: TObject;
      AConnection: TclSmtpCommandConnection;
      Account: TclSmtpUserAccountItem; const AKey, AHash: String;
      var IsAuthorized, Handled: Boolean);
    procedure clSmtpServer1LoginAuthenticate(Sender: TObject;
      AConnection: TclSmtpCommandConnection;
      Account: TclSmtpUserAccountItem; const APassword: String;
      var IsAuthorized, Handled: Boolean);
    procedure clSmtpServer1CloseConnection(Sender: TObject;
      AConnection: TclCommandConnection);
    procedure clSmtpServer1AcceptConnection(Sender: TObject;
      AConnection: TclCommandConnection);
    procedure clSmtpServer1ReceiveCommand(Sender: TObject;
      AConnection: TclCommandConnection; const ACommand, AText: String);
    procedure clSmtpServer1SendResponse(Sender: TObject;
      AConnection: TclCommandConnection; const ACommand, AText: String);
  private
    FSynchronizer: TCriticalSection;
    procedure PutLogMessage(const ALogMessage: string);
    function GetSettingsFile: string;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function TMainForm.GetSettingsFile: string;
begin
  Result := AddTrailingBackSlash(edtMailboxDir.Text) + 'smtp.dat';
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  ini: TIniFile;
begin
  FSynchronizer := TCriticalSection.Create();
  ini := TIniFile.Create(GetSettingsFile());
  try
    clSmtpFileHandler1.Counter := ini.ReadInteger('SMTP', 'Counter', 1);
  finally
    ini.Free();
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
var
  ini: TIniFile;
begin
  FSynchronizer.Free();
  ini := TIniFile.Create(GetSettingsFile());
  try
    ini.WriteInteger('SMTP', 'Counter', clSmtpFileHandler1.Counter);
  finally
    ini.Free();
  end;
end;

procedure TMainForm.PutLogMessage(const ALogMessage: string);
begin
  if not (csDestroying in ComponentState) then
  begin
    FSynchronizer.Enter();
    try
      memLog.Lines.Add(ALogMessage);
    finally
      FSynchronizer.Leave();
    end;
  end;
end;

procedure TMainForm.btnStartClick(Sender: TObject);
begin
  clSmtpServer1.Port := StrToInt(edtPort.Text);
  clSmtpServer1.UseLogin := cbUseLogin.Checked;
  clSmtpServer1.UseSPA := cbUseSPA.Checked;

  clSmtpFileHandler1.MailBoxDir := edtMailboxDir.Text;
  clSmtpFileHandler1.RelayDir := edtRelayDir.Text;

  ForceFileDirectories(AddTrailingBackSlash(clSmtpFileHandler1.MailBoxDir));
  ForceFileDirectories(AddTrailingBackSlash(clSmtpFileHandler1.MailBoxDir) + 'CleverTester\');
  ForceFileDirectories(AddTrailingBackSlash(clSmtpFileHandler1.RelayDir));

  clSmtpServer1.Start();
end;

procedure TMainForm.btnStopClick(Sender: TObject);
begin
  clSmtpServer1.Stop();
end;

procedure TMainForm.clSmtpServer1Start(Sender: TObject);
begin
  PutLogMessage('=================='#13#10'Start Server');
end;

procedure TMainForm.clSmtpServer1Stop(Sender: TObject);
begin
  PutLogMessage('Stop Server');
end;

procedure TMainForm.clSmtpServer1CramMD5Authenticate(Sender: TObject;
  AConnection: TclSmtpCommandConnection; Account: TclSmtpUserAccountItem;
  const AKey, AHash: String; var IsAuthorized, Handled: Boolean);
begin
  PutLogMessage('Authenticate user: ' + Account.UserName);
end;

procedure TMainForm.clSmtpServer1LoginAuthenticate(Sender: TObject;
  AConnection: TclSmtpCommandConnection; Account: TclSmtpUserAccountItem;
  const APassword: String; var IsAuthorized, Handled: Boolean);
begin
  PutLogMessage('Authenticate user: ' + Account.UserName);
end;

procedure TMainForm.clSmtpServer1CloseConnection(Sender: TObject;
  AConnection: TclCommandConnection);
begin
  PutLogMessage('Close Connection. Host: ' + AConnection.PeerName);
end;

procedure TMainForm.clSmtpServer1AcceptConnection(Sender: TObject;
  AConnection: TclCommandConnection);
begin
  PutLogMessage('Accept Connection. Host: ' + AConnection.PeerName);
end;

procedure TMainForm.clSmtpServer1ReceiveCommand(Sender: TObject;
  AConnection: TclCommandConnection; const ACommand, AText: String);
begin
  PutLogMessage('Command: ' + ACommand + ' ' + AText);
end;

procedure TMainForm.clSmtpServer1SendResponse(Sender: TObject;
  AConnection: TclCommandConnection; const ACommand, AText: String);
begin
  PutLogMessage('Reply: ' + AText);
end;

end.