www.pudn.com > EmailServer.zip > 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.