Unit RunOne;
Interface
Const
Mi_querymediawhandle = 1;
Mi_respond=whandle = 2;
MI_ERROR_NONE = 0;
MI_ERROR_FAILSUBCLASS = 1;
MI_ERROR_CREATINGMUTEX = 2;
// Call this function to determine if error occurred in startup.
// Value will be one or more of the MI_ERROR _ * error flags.
Function GetMIError: Integer;
Implementation
Uses Forms, Windows, SysUtils;
Const
UniqueAppStr = 'newcq ';
Var
MessageId: Integer;
WProc: TFNWndProc;
MutHandle: THandle;
MIError: Integer;
Function GetMIError: Integer;
Begin
Result: = MIError;
End;
Function NewWndProc (Handle: HWND; Msg: Integer; wParam, lParam: Longint ):
Longint; stdcall;
Begin
Result: = 0;
// If this is the registered message...
If Msg = MessageID then
Begin
Case wParam
Mi_querymediawhandle:
// A new instance is asking for main window handle in order
// To focus the main window, so normalize app and send back
// Message with main window handle.
Begin
If IsIconic (Application. Handle) then
Begin
Application. MainForm. WindowState: = wsNormal;
Application. Restore;
End;
PostMessage (HWND (lParam), MessageID, mi_respond=whandle,
Application. MainForm. Handle );
End;
Mi_respond=whandle:
// The running instance has returned its main window handle,
// So we need to focus it and go away.
Begin
SetForegroundWindow (HWND (lParam ));
Application. Terminate;
End;
End;
End
// Otherwise, pass message on to old window proc
Else
Result: = CallWindowProc (WProc, Handle, Msg, wParam, lParam );
End;
Procedure SubClassApplication;
Begin
// We subclass Application window procedure so that
// Application. OnMessage remains available for user.
WProc: = TFNWndProc (SetWindowLong (Application. Handle, GWL_WNDPROC,
Longint (@ NewWndProc )));
// Set appropriate error flag if error condition occurred
If WProc = nil then
MIError: = MIError or MI_ERROR_FAILSUBCLASS;
End;
Procedure DoFirstInstance;
// This is called only for the first instance of the application
Begin
// Create the mutex with the (hopefully) unique string
MutHandle: = CreateMutex (nil, False, UniqueAppStr );
If MutHandle = 0 then
MIError: = MIError or MI_ERROR_CREATINGMUTEX;
End;
Procedure BroadcastFocusMessage;
// This is called when there is already an instance running.
Var
BSMRecipients: DWORD;
Begin
// Prevent main form from flashing
Application. ShowMainForm: = False;
// Post message to try to establish a dialogue with previous instance
BSMRecipients: = BSM_APPLICATIONS;
BroadCastSystemMessage (BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@ BSMRecipients, MessageID, mi_query?whandle,
Application. Handle );
End;
Procedure InitInstance;
Begin
SubClassApplication; // hook application message loop
MutHandle: = OpenMutex (MUTEX_ALL_ACCESS, False, UniqueAppStr );
If MutHandle = 0 then
// Mutex object has not yet been created, meaning that no previous
// Instance has been created.
DoFirstInstance
Else
BroadcastFocusMessage;
End;
Initialization
MessageID: = RegisterWindowMessage (UniqueAppStr );
InitInstance;
Finalization
// Restore old application window procedure
If WProc <> nil then
SetWindowLong (Application. Handle, GWL_WNDPROC, LongInt (WProc ));
If MutHandle <> 0 then CloseHandle (MutHandle); // Free mutex
End.