//防止多次打开unit MultInst;
interface
uses Windows ,Messages, SysUtils, Classes, Forms;
implementation
constSTR_UNIQUE    = '{2BE6D96E-827F-4BF9-B33E-8740412CDE96}';MI_ACTIVEAPP  = 1;  {激活应用程序}MI_GETHANDLE  = 2;  {取得句柄}
variMessageID    : Integer;OldWProc      : TFNWndProc;MutHandle     : THandle;BSMRecipients : DWORD;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;
beginResult := 0;if Msg = iMessageID thenbegincase wParam ofMI_ACTIVEAPP: {激活应用程序}if lParam<>0 thenbegin{收到消息的激活前一个实例}{为什么要在另一个程序中激活?}{因为在同一个进程中SetForegroundWindow并不能把窗体提到最前}if IsIconic(lParam) thenOpenIcon(lParam)elseSetForegroundWindow(lParam);Application.Terminate; {终止本实例}end;MI_GETHANDLE: {取得程序句柄}beginPostMessage(HWND(lParam), iMessageID, MI_ACTIVEAPP, Application.Handle);end;end;endelseResult := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end;
procedure InitInstance;
begin{取代应用程序的消息处理}OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));{打开互斥对象}MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, STR_UNIQUE);if MutHandle = 0 thenbegin{建立互斥对象}MutHandle := CreateMutex(nil, False, STR_UNIQUE);endelsebeginApplication.ShowMainForm  :=  False;{已经有程序实例,广播消息取得实例句柄}BSMRecipients := BSM_APPLICATIONS;BroadcastSystemMessage(BSF_POSTMESSAGE or BSF_POSTMESSAGE,@BSMRecipients,iMessageID,MI_GETHANDLE,Application.Handle);//BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle);end;
end;
initialization{注册消息}iMessageID  := RegisterWindowMessage(STR_UNIQUE);InitInstance;
finalization{还原消息处理过程}if OldWProc <> Nil thenSetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));{关闭互斥对象}if MutHandle <> 0 thenCloseHandle(MutHandle);
end.