Email服务器

开发平台：
Delphi

Main.pas：源码内容
							unit Main;
(******************************************************************************)
(*                                                                            *)
(* Hermes Main Application Window                                             *)
(* Part of Hermes SMTP/POP3 Server.                                           *)
(* Copyright(C) 2000 by Alexander J. Fanti, All Rights Reserver Worldwide.    *)
(*                                                                            *)
(* Created January 10, 2000 by Alexander J. Fanti.  See License.txt           *)
(*                                                                            *)
(* Used by: Hermes                                                            *)
(* Uses: DataU1, Pop3Server, SmtpServer, Pop3Agent                            *)
(*       About, ManageUsers, ManageMailLists, ManageAliases,                  *)
(*       Settings_General, Settings_SmtpServer,                               *)
(*       Settings_SmtpAgent, Settings_Pop3Server                              *)
(*                                                                            *)
(* Description: This is the Hermes Main Application Window.  It is the        *)
(*              central point of the program.  All settings are controlled    *)
(*              from here.  Also, all log information is displayed here.      *)
(*                                                                            *)
(* Revisions: 1/17/2000  AJF  Unified event handlers                          *)
(*            1/21/2000  AJF  Commented                                       *)
(*            2/12/2000  AJF  Added Tray Icon, minimize to tray, and          *)
(*                            Mutex to prevent multiple instances             *)
(*            2/13/2000  AJF  Added Startup options                           *)
(*            7/08/2001  AJF  Added Domain qualified Aliases                  *)
(*                                                                            *)
(******************************************************************************)
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ComCtrls, ExtCtrls, ShellAPI,
  DataU1, Pop3Server, SmtpServer, SmtpAgent;
const
  WM_SERVER_SERVICEQUEUE = WM_USER + 100;
  WM_TRAYICON_NOTIFICATION = WM_USER + 101;
type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    mnuFile: TMenuItem;
    mnuSettings: TMenuItem;
    mnuSSMTPServer: TMenuItem;
    mnuSSMTPAgent: TMenuItem;
    mnuSPOP3Server: TMenuItem;
    mnuAccounts: TMenuItem;
    mnuAManageUsers: TMenuItem;
    mnuFExit: TMenuItem;
    mnuAManageMailLists: TMenuItem;
    reLog: TRichEdit;
    pnlStatus: TPanel;
    mnuActive: TMenuItem;
    mnuASMTPServer: TMenuItem;
    mnuASMTPAgent: TMenuItem;
    mnuAPOP3Server: TMenuItem;
    shapeStatusPop3Server: TShape;
    shapeStatusSmtpServer: TShape;
    shapeStatusSmtpAgent: TShape;
    mnuSGeneral: TMenuItem;
    mnuAManageAliases: TMenuItem;
    lblPop3Conn: TLabel;
    lblSmtpConn: TLabel;
    lblAgentConn: TLabel;
    N1: TMenuItem;
    mnuAServiceQueueNow: TMenuItem;
    PopupMenu1: TPopupMenu;
    puClear: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHManual: TMenuItem;
    mnuHWebSite: TMenuItem;
    mnuHLicense: TMenuItem;
    N3: TMenuItem;
    mnuHAbout: TMenuItem;
    mnuHFirstTime: TMenuItem;
    puSave: TMenuItem;
    SaveDialog1: TSaveDialog;
    mnuHEMailtheAuthor: TMenuItem;
    popupTray: TPopupMenu;
    puTrayRestore: TMenuItem;
    puTrayTerminate: TMenuItem;
    TimerTray: TTimer;
    TimerInactivity: TTimer;
    mnuHHelpFile: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure mnuFExitClick(Sender: TObject);
    procedure mnuSSMTPServerClick(Sender: TObject);
    procedure mnuSSMTPAgentClick(Sender: TObject);
    procedure mnuSPOP3ServerClick(Sender: TObject);
    procedure mnuAManageUsersClick(Sender: TObject);
    procedure mnuAManageMailListsClick(Sender: TObject);
    procedure mnuAPOP3ServerClick(Sender: TObject);
    procedure mnuASMTPServerClick(Sender: TObject);
    procedure mnuASMTPAgentClick(Sender: TObject);
    procedure mnuSGeneralClick(Sender: TObject);
    procedure mnuAManageAliasesClick(Sender: TObject);
    procedure mnuAServiceQueueNowClick(Sender: TObject);
    procedure puClearClick(Sender: TObject);
    procedure mnuHManualClick(Sender: TObject);
    procedure mnuHelpClick(Sender: TObject);
    procedure mnuHWebSiteClick(Sender: TObject);
    procedure mnuHLicenseClick(Sender: TObject);
    procedure mnuHAboutClick(Sender: TObject);
    procedure mnuHFirstTimeClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure puSaveClick(Sender: TObject);
    procedure mnuHEMailtheAuthorClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure puTrayRestoreClick(Sender: TObject);
    procedure TimerTrayTimer(Sender: TObject);
    procedure TimerInactivityTimer(Sender: TObject);
    procedure mnuHHelpFileClick(Sender: TObject);
  private
    { Private declarations }
    ShowFirstTimer : Boolean;
    WindowsIsTerminating : Boolean;
    TrayActive : Boolean;           // True when we've inserted an icon in the
                                    // windows tray (task bar)
    TrayInfoID : TNOTIFYICONDATA;   // Task Bar structure for display
    Pop3Server : TPop3Server;  // The Pop3 Server Object
    SmtpServer : TSmtpServer;  // The Smtp Server Object
    SmtpAgent : TSmtpAgent;    // The Smtp Agent Object
    procedure Minimize(Sender: TObject);
    procedure Restore;
    procedure WMQUERYENDSESSION(var Msg: TWMQUERYENDSESSION);
      message WM_QUERYENDSESSION;
    procedure TrayIconNotification(var Msg: TMessage);
      message WM_TRAYICON_NOTIFICATION;
    function TrayIcon_Add : Boolean;
    procedure TrayIcon_Remove;
    // Event handler for Status Updates from the Servers and Agent
    procedure AnyStatusUpdate(Sender : TObject; Status : String;
                              Level : Integer);
    // Event handler for State Change notices from the Servers and Agent
    procedure AnyStateChange(Sender : TObject; Active : Boolean;
                             OpenConnections : Longint);
    procedure ServiceQueue(var Msg: TMSG); message WM_SERVER_SERVICEQUEUE;
    // Event handler for notification of queue requiring service.
    // Notification comes from a TSMTPMessageInformation Object through
    // the ServerInformation Object
    // Event handlers for errors from specific objects
    procedure Pop3_Error(Sender : TObject; ErrorCode : TPop3Server_ErrorCode);
    procedure Smtp_Error(Sender : TObject; ErrorCode : TSmtpServer_ErrorCode);
  public
    { Public declarations }
  end;
var
  frmMain: TfrmMain;
procedure Trigger_ServiceSMTPQueue;
implementation
uses UtilU1,
     About,
     ManageUsers,
     ManageMailLists,
     ManageAliases,
     Settings_General,
     Settings_SmtpServer,
     Settings_SmtpAgent,
     Settings_Pop3Server, License, FirstTime, CloseQuery;
{$R *.DFM}
(******************************************************************************)
(*                                                                            *)
(* This code is from a Borland TI/FAQ to prevent multiple instances           *)
(* FAQ1355D.txt   Preventing multiple application instances                   *)
(* Category   :Windows API                                                    *)
(* Platform    :All                                                           *)
(* Product    :All 32 bit                                                     *)
(*                                                                            *)
(* Other code related to this is marked with "MUTEX"                          *)
(*                                                                            *)
(******************************************************************************)
var
  OldWindowProc : Pointer; {Variable for the old windows proc}
  WM_TASKBARCREATED : DWord; {custom systemwide message}
  WM_HERMESRESTORE,         WM_HERMESREFRESHFROMINIFILE,
  WM_HERMESSENDSTATUS,      WM_HERMESSTATUS,
  WM_HERMESSMTPSERVERSTART, WM_HERMESSMTPSERVERSTOP,
  WM_HERMESPOP3SERVERSTART, WM_HERMESPOP3SERVERSTOP,
  WM_HERMESSMTPAGENTSTART,  WM_HERMESSMTPAGENTSTOP,
  WM_HERMESSHUTDOWN,        WM_HERMESFORCESHUTDOWN  : DWord; {custom systemwide message}
function NewWindowProc(WindowHandle : hWnd;
                       TheMessage   : LongInt;
                       ParamW       : LongInt;
                       ParamL       : LongInt) : LongInt stdcall;
var
  Status : LongInt;
begin
  if TheMessage = WM_HERMESRESTORE  then begin
    {Tell the application to restore, let it restore the form}
    SendMessage(Application.handle, WM_SYSCOMMAND, SC_RESTORE, 0);
    SetForegroundWindow(Application.Handle);
    {We handled the message - we are done}
    Result := 0;    exit;
  end else
  if TheMessage = WM_TASKBARCREATED  then begin
    frmMain.TrayIcon_Remove;  {remove tray icon if still there}
    frmMain.TrayIcon_Add;     {add tray icon...}
    {We handled the message - we are done}
    Result := 0;    exit;
  end else
  if TheMessage = WM_HERMESREFRESHFROMINIFILE then begin
    INI.LoadFromFile;
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESSMTPSERVERSTART then begin
    frmMain.SmtpServer.Listen;
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESSMTPSERVERSTOP  then begin
    frmMain.SmtpServer.Stop;
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESPOP3SERVERSTART then begin
    frmMain.Pop3Server.Listen;
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESPOP3SERVERSTOP  then begin
    frmMain.Pop3Server.Stop;
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESSMTPAGENTSTART  then begin
    frmMain.SmtpAgent.Start;
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESSMTPAGENTSTOP   then begin
    frmMain.SmtpAgent.Stop;
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESSENDSTATUS  then begin
    Status := 0;
    if frmMain.SmtpServer.Active then Status := Status + 1;
    if frmMain.SmtpAgent.Active  then Status := Status + 2;
    if frmMain.Pop3Server.Active then Status := Status + 4;
    // Send Message Back!
    SendMessage(HWND_BROADCAST, WM_HERMESSTATUS, Integer(Application.Handle), Status);
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESSHUTDOWN  then begin
    frmMain.Close;
    Result := 0;    exit;    {We handled the message - we are done}
  end else
  if TheMessage = WM_HERMESFORCESHUTDOWN  then begin
    frmMain.WindowsIsTerminating := True;
    frmMain.Close;
    Result := 0;    exit;    {We handled the message - we are done}
  end;
  {Call the original winproc}
  Result := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  (*** Start MUTEX and MESSAGE CAPTURE ***)
  {Register a custom windows message}
  {Register the TrayBar Create windows message}
  WM_TASKBARCREATED           := RegisterWindowMessage('TaskbarCreated');
  {Register Hermes control messages}
  WM_HERMESRESTORE            := RegisterWindowMessage('HermesRestore');
  WM_HERMESREFRESHFROMINIFILE := RegisterWindowMessage('HermesRefreshFromINIFile');
  WM_HERMESSENDSTATUS         := RegisterWindowMessage('HermesSendStatus');
  WM_HERMESSTATUS             := RegisterWindowMessage('HermesStatus');
  WM_HERMESSMTPSERVERSTART    := RegisterWindowMessage('HermesStartSMTPServer');
  WM_HERMESSMTPSERVERSTOP     := RegisterWindowMessage('HermesStopSMTPServer');
  WM_HERMESPOP3SERVERSTART    := RegisterWindowMessage('HermesStartPOP3Server');
  WM_HERMESPOP3SERVERSTOP     := RegisterWindowMessage('HermesStopPOP3Server');
  WM_HERMESSMTPAGENTSTART     := RegisterWindowMessage('HermesStartSMTPAgent');
  WM_HERMESSMTPAGENTSTOP      := RegisterWindowMessage('HermesStopSMTPAgent');
  WM_HERMESSHUTDOWN           := RegisterWindowMessage('HermesShutdown');
  WM_HERMESFORCESHUTDOWN      := RegisterWindowMessage('HermesForceShutdown');
  {Set form1's windows proc to ours and remember the old window proc}
  OldWindowProc := Pointer(SetWindowLong(Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));
  (*** Stop MUTEX and MESSAGE CAPTURE ***)
  WindowsIsTerminating := False;
  TrayActive := False;
  Application.OnMinimize := Minimize;  // call my app on minimize
  // Create and load the Server's Information Object
  INI := TServerInformation.Create;
  ShowFirstTimer := not INI.Exists;
  INI.LoadFromFile;
  if not INI.StartMinimized then Restore;
  // Create the Pop3 Server Object and start it up
  Pop3Server := TPop3Server.Create(Self);
  Pop3Server.OnStateChange  := AnyStateChange;
  Pop3Server.OnStatusUpdate := AnyStatusUpdate;
  Pop3Server.OnError        := Pop3_Error;
  if INI.AutoStart_Pop3Server then Pop3Server.Listen;
  // Create the Smtp Server Object and start it up
  SmtpServer := TSmtpServer.Create(Self);
  SmtpServer.OnStateChange  := AnyStateChange;
  SmtpServer.OnStatusUpdate := AnyStatusUpdate;
  SmtpServer.OnError        := Smtp_Error;
  if INI.AutoStart_SmtpServer then SmtpServer.Listen;
  // Create the Smtp Agent Object and start it up
  SmtpAgent := TSmtpAgent.Create(Self);
  SmtpAgent.OnStateChange  := AnyStateChange;
  SmtpAgent.OnStatusUpdate := AnyStatusUpdate;
  if INI.AutoStart_SmtpAgent then SmtpAgent.Start;
  if INI.ProcessQueueOnStartup then SmtpAgent.ServiceQueue; 
end;
procedure TfrmMain.FormShow(Sender: TObject);
var
  frmFirstTime: TfrmFirstTime;
begin
  if ShowFirstTimer then begin
    frmFirstTime := TfrmFirstTime.Create(Self);
    frmFirstTime.ShowModal;
  end;
end;
procedure TfrmMain.Minimize(Sender: TObject);
begin
  if TrayActive then begin
    frmMain.Hide;
    ShowWindow(Application.Handle, SW_HIDE);
  end else begin
    frmMain.Hide;
  end;
end;
procedure TfrmMain.Restore;
begin
  ShowWindow(Application.Handle, SW_SHOW);
  Show;
  Application.Restore;
  Application.BringToFront;
end;
procedure TfrmMain.WMQUERYENDSESSION(var Msg: TWMQUERYENDSESSION);
// Windows CanShutdown
begin
  WindowsIsTerminating := True;
//  Msg.Result := 0;  // CanClose := False;
  Msg.Result := 1;  // CanClose := True;
  Close;  // note, If I agree to shutdown, I must close my self!
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  x : Integer;
begin
  if not WindowsIsTerminating then begin
    x := frmCloseQuery.ShowModal;
    CanClose := x = mrYes;
    if x = mrIgnore then Application.Minimize;
  end else begin
    Canclose := True;
  end;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // Shutdown all server components
  Pop3Server.Shutdown;
  SmtpServer.Shutdown;
  SmtpAgent.Shutdown;
  // Save Server INI File ?  No real need. we save after setting changes
  // INI.SaveToFile;
  Action := caFree;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  (*** Start MUTEX ***)
  {Set form1's window proc back to it's original procedure}
  SetWindowLong(Handle, GWL_WNDPROC, LongInt(OldWindowProc));
  (*** Stop  MUTEX ***)
  // Free the Server Objects
  Pop3Server.Free;
  SmtpServer.Free;
  SmtpAgent.Free;
  INI.Free;
  // Remove Icon from Tray
  if TrayActive then Shell_NotifyIcon(NIM_DELETE, @TrayInfoID);
end;
// Handle Menu choices
procedure TfrmMain.mnuFExitClick(Sender: TObject);
begin  Close;                             end;
procedure TfrmMain.mnuASMTPServerClick(Sender: TObject);
begin
  if SmtpServer.Active then SmtpServer.Stop else SmtpServer.Listen;
end;
procedure TfrmMain.mnuASMTPAgentClick(Sender: TObject);
begin
  if SmtpAgent.Active then SmtpAgent.Stop else SmtpAgent.Start;
end;
procedure TfrmMain.mnuAPOP3ServerClick(Sender: TObject);
begin
  if Pop3Server.Active then Pop3Server.Stop else Pop3Server.Listen;
end;
procedure TfrmMain.mnuAServiceQueueNowClick(Sender: TObject);
begin
  SmtpAgent.ServiceQueue;
end;
procedure TfrmMain.mnuSGeneralClick(Sender: TObject);
begin
  if frmSettings_General.ShowModal = mrOK then INI.SaveToFile;
end;
procedure TfrmMain.mnuSSMTPServerClick(Sender: TObject);
begin
  if frmSettings_SmtpServer.ShowModal = mrOK then INI.SaveToFile;
end;
procedure TfrmMain.mnuSSMTPAgentClick(Sender: TObject);
begin
  if frmSettings_SmtpAgent.ShowModal = mrOK then INI.SaveToFile;
end;
procedure TfrmMain.mnuSPOP3ServerClick(Sender: TObject);
begin
  if frmSettings_Pop3Server.ShowModal = mrOK then INI.SaveToFile;
end;
procedure TfrmMain.mnuAManageUsersClick(Sender: TObject);
begin
  frmManageUsers.ShowModal;
  INI.SaveToFile;
end;
procedure TfrmMain.mnuAManageMailListsClick(Sender: TObject);
begin
  frmManageMailLists.ShowModal;
  INI.SaveToFile;
end;
procedure TfrmMain.mnuAManageAliasesClick(Sender: TObject);
begin
  frmManageAliases.ShowModal;
  INI.SaveToFile;
end;
procedure TfrmMain.mnuHelpClick(Sender: TObject);
begin
  mnuHManual.Enabled := FileExists(INI.AppPath + 'hermes.doc');
  mnuHHelpFile.Enabled := FileExists(INI.AppPath + 'hermes.hlp');
end;
procedure TfrmMain.mnuHFirstTimeClick(Sender: TObject);
var
  frmFirstTime: TfrmFirstTime;
begin
  frmFirstTime := TfrmFirstTime.Create(Self);
  frmFirstTime.Show;
end;
procedure TfrmMain.mnuHManualClick(Sender: TObject);
begin
  if not LaunchShellApp(INI.AppPath + 'hermes.doc') then
    ShowMessage('Can''t open "Hermes.doc"');
end;
procedure TfrmMain.mnuHHelpFileClick(Sender: TObject);
begin
  if not LaunchShellApp(INI.AppPath + 'hermes.hlp') then
    ShowMessage('Can''t open "Hermes.hlp"');
end;
procedure TfrmMain.mnuHWebSiteClick(Sender: TObject);
begin
  if not LaunchShellApp(AppWebSite) then
    ShowMessage('Can''t open web browser to ' + AppWebSite);
end;
procedure TfrmMain.mnuHLicenseClick(Sender: TObject);
begin  frmLicense.ShowModal;                end;
procedure TfrmMain.mnuHAboutClick(Sender: TObject);
begin  frmAbout.ShowModal;                end;
procedure TfrmMain.mnuHEMailtheAuthorClick(Sender: TObject);
begin
  // Open the user's mailer to the Author's EMail Address
  if not LaunchShellApp(AuthorEMail) then
    ShowMessage('Can''t open EMailer to ' + AuthorEMail);
end;
procedure TfrmMain.puClearClick(Sender: TObject);
begin
  reLog.Clear;
end;
procedure TfrmMain.puSaveClick(Sender: TObject);
begin
  if SaveDialog1.Execute then begin
    reLog.PlainText := UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.RTF';
    reLog.Lines.SaveToFile(SaveDialog1.Filename);
    reLog.PlainText := False;
  end;
end;
procedure TfrmMain.puTrayRestoreClick(Sender: TObject);
begin
  Restore;
end;
procedure TfrmMain.AnyStatusUpdate(Sender : TObject; Status : String;
                                   Level : Integer);
var
  Entry : String;
  F : TextFile;
begin
  if Level <= INI.LogLevel then begin
    Entry := '[' + DateToStr(Now) + ' - ' + TimeToStr(Now) + ']  ' + Status;
    if reLog.Lines.Count > 500 then reLog.Clear;
    reLog.Lines.Add(Entry);
    if INI.LogFile <> '' then begin
      // I need to add to the log file here...
      AssignFile(F, INI.LogFile);
      try
        Append(F);
        Writeln(F, Entry);
      except
        on E: Exception do try
          ReWrite(F);
          Writeln(F, Entry);
        except
          on E: Exception do begin end;
        end;
      end;
      CloseFile(F);
    end;
  end;
end;
procedure TfrmMain.AnyStateChange(Sender : TObject; Active : Boolean;
                                  OpenConnections : Longint);
begin
  // Perform different actions based on which object sent the "StateChange"
  // But it's all basically the same...
  // check a menu, color a shape, set a caption
  if Sender is TSmtpServer then begin
    mnuASMTPServer.Checked := Active;
    if Active then shapeStatusSmtpServer.Brush.Color := clLime
      else shapeStatusSmtpServer.Brush.Color := clRed;
    shapeStatusSmtpServer.Hint := 'SMTP Server, ' + IntToStr(OpenConnections) +
                                  ' open connections.';
    lblSmtpConn.Caption := 'Smtp:' + IntToStr(OpenConnections);
  end;
  if Sender is TSmtpAgent then begin
    mnuASMTPAgent.Checked := Active;
    if Active then shapeStatusSmtpAgent.Brush.Color := clLime
      else shapeStatusSmtpAgent.Brush.Color := clRed;
    shapeStatusSmtpAgent.Hint := 'SMTP Agent, ' + IntToStr(OpenConnections) +
                                 ' open messages.';
    lblAgentConn.Caption := 'Agent:' + IntToStr(OpenConnections);
  end;
  if Sender is TPop3Server then begin
    mnuAPOP3Server.Checked := Active;
    if Active then shapeStatusPop3Server.Brush.Color := clLime
      else shapeStatusPop3Server.Brush.Color := clRed;
    shapeStatusPop3Server.Hint := 'POP3 Server, ' + IntToStr(OpenConnections) +
                                  ' open connections.';
    lblPop3Conn.Caption := 'Pop3:' + IntToStr(OpenConnections);
  end;
end;
procedure TfrmMain.ServiceQueue(var Msg: TMSG);
begin
  // Queue Requires Service
  // This is a Windows Message Posted from the MailRouting Unit's DeliverMail
  // Object.  This allows us to process the queue immediately, rather than
  // wait for the Queue Service Timer.  I like instant mail...!
  SmtpAgent.ServiceQueue;
end;
procedure TfrmMain.Pop3_Error(Sender : TObject;
                              ErrorCode : TPop3Server_ErrorCode);
begin
end;
procedure TfrmMain.Smtp_Error(Sender : TObject;
                              ErrorCode : TSmtpServer_ErrorCode);
begin
end;
{
  This timer will try to insert a tray icon into the Windows task bar.
  it will try until it succeeds.  This is because sometimes it can't do it
  on the first time...  After that, it won't try anymore.
  We then get click notifications at the TrayIconNotification procedure
}
function TfrmMain.TrayIcon_Add : Boolean;
begin
  // Try to place an Icon in the Tray... until we're successful!
  Result := False;
  if not TrayActive then begin
    TrayInfoID.cbSize := SizeOf(TNOTIFYICONDATA);
    TrayInfoID.uID := 0;
    TrayInfoID.Wnd := Handle;
    TrayInfoID.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    TrayInfoID.uCallbackMessage := WM_TRAYICON_NOTIFICATION;
    TrayInfoID.hIcon := 0;
    if Application.Icon <> nil then TrayInfoID.hIcon := Application.Icon.Handle;
    StrLCopy(TrayInfoID.szTip, 'Hermes SMTP/POP3 Server',
             SizeOf(TrayInfoID.szTip));
    if Shell_NotifyIcon(NIM_ADD, @TrayInfoID) then begin
      TrayActive := True;
      Result := True;
    end;
  end;
end;
procedure TfrmMain.TrayIcon_Remove;
begin
  // Remove Icon from Tray
  if TrayActive then begin
    Shell_NotifyIcon(NIM_DELETE, @TrayInfoID);
    TrayActive := False;
  end;
end;
procedure TfrmMain.TimerTrayTimer(Sender: TObject);
begin
  if TrayIcon_Add then TimerTray.Enabled := False;
(*
  // Try to place an Icon in the Tray... until we're successful!
  if not TrayActive then begin
    TrayInfoID.cbSize := SizeOf(TNOTIFYICONDATA);
    TrayInfoID.uID := 0;
    TrayInfoID.Wnd := Handle;
    TrayInfoID.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    TrayInfoID.uCallbackMessage := WM_TRAYICON_NOTIFICATION;
    TrayInfoID.hIcon := 0;
    if Application.Icon <> nil then TrayInfoID.hIcon := Application.Icon.Handle;
    StrLCopy(TrayInfoID.szTip, 'Hermes SMTP/POP3 Server',
             SizeOf(TrayInfoID.szTip));
    if Shell_NotifyIcon(NIM_ADD, @TrayInfoID) then begin
      TrayActive := True;
//      TimerTray.Enabled := False;
      TimerTray.Interval := 300000;
      if INI.StartMinimized then Application.Minimize;
    end;
  end;
*)
end;
// We get tray click notifications here.  Wr restore or offer a popup menu.
procedure TfrmMain.TrayIconNotification(var Msg: TMessage);
var
  MouseMsg: longint;
  Pt: TPoint;
begin
  MouseMsg := Msg.LParam;
  case MouseMsg of
    wm_LButtonDown : Restore;
    wm_RButtonUp   : begin
                       GetCursorPos(Pt);
                       popupTray.PopUp(Pt.X,Pt.Y);
                     end;
  end;
end;
procedure TfrmMain.TimerInactivityTimer(Sender: TObject);
begin
  if Assigned(INI) then begin
    if Assigned(Pop3Server) then
      Pop3Server.ConnectionInactivityTimeout(INI.Pop3_InactivityTimeout);
    if Assigned(SmtpServer) then
      SmtpServer.ConnectionInactivityTimeout(INI.Smtp_InactivityTimeout);
    if Assigned(SmtpAgent) then
      SmtpAgent.ConnectionInactivityTimeout(INI.Agent_InactivityTimeout);
  end;
end;
procedure Trigger_ServiceSMTPQueue;
begin
  // This is to post a message to ourselves to cause the SMTP Agent to service
  // its Queue of outbound messages.
  PostMessage(frmMain.Handle, WM_SERVER_SERVICEQUEUE, 0, 0);
end;
end.

						