防止多个实例公用程序

将以下代码保存为MultInst.pas, 然后在任何Project的
源代码网推荐 Main Form中Uses MultInst, 就可以完善防止程序的多个
源代码网推荐 实例同时运行, 特与大家共享.
源代码网推荐
源代码网推荐 unit MultInst;
源代码网推荐
源代码网推荐 interface
源代码网推荐
源代码网推荐 const
源代码网推荐 MI_QUERYWINDOWHANDLE = 1;
源代码网推荐 MI_RESPONDWINDOWHANDLE = 2;
源代码网推荐
源代码网推荐 MI_ERROR_NONE = 0;
源代码网推荐 MI_ERROR_FAILSUBCLASS = 1;
源代码网推荐 MI_ERROR_CREATINGMUTEX = 2;
源代码网推荐
源代码网推荐 function GetMIError: Integer;
源代码网推荐
源代码网推荐 implementation
源代码网推荐
源代码网推荐 uses Forms, Windows, SysUtils;
源代码网推荐
源代码网推荐 const
源代码网推荐 UniqueAppStr = "DDG.I_Am_Winger!";
源代码网推荐
源代码网推荐 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 Msg = MessageId then
源代码网推荐 case wParam of
源代码网推荐 MI_QUERYWINDOWHANDLE:
源代码网推荐 begin
源代码网推荐 if IsIconic(Application.Handle) then
源代码网推荐 begin
源代码网推荐 Application.MainForm.WindowState := wsNormal;
源代码网推荐 Application.Restore;
源代码网推荐 end;
源代码网推荐 PostMessage(HWND(lParam), MessageId, MI_RESPONDWINDOWHANDLE, Application.MainForm.Handle);
源代码网推荐 end;
源代码网推荐 MI_RESPONDWINDOWHANDLE:
源代码网推荐 begin
源代码网推荐 SetForegroundWindow(HWND(lParam));
源代码网推荐 Application.Terminate;
源代码网推荐 end;
源代码网推荐 end
源代码网推荐 else
源代码网推荐 Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
源代码网推荐 end;
源代码网推荐
源代码网推荐 procedure SubClassApplication;
源代码网推荐 begin
源代码网推荐 WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@NewWndProc)));
源代码网推荐 if WProc = nil then MIError := MIError or MI_ERROR_FAILSUBCLASS;
源代码网推荐 end;
源代码网推荐
源代码网推荐 procedure DoFirstInstance;
源代码网推荐 begin
源代码网推荐 MutHandle := CreateMutex(nil, False, UniqueAppStr);
源代码网推荐 if MutHandle = 0 then MIError := MI_ERROR_CREATINGMUTEX;
源代码网推荐 end;
源代码网推荐
源代码网推荐 procedure BroadcastFocusMessage;
源代码网推荐 var
源代码网推荐 BSMRecipients: DWORD;
源代码网推荐 begin
源代码网推荐 Application.ShowMainForm := False;
源代码网推荐 BSMRecipients := BSM_APPLICATIONS;
源代码网推荐 BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
源代码网推荐 @BSMRecipients, MessageId, MI_QUERYWINDOWHANDLE, Application.Handle);
源代码网推荐 end;
源代码网推荐
源代码网推荐 procedure InitInstance;
源代码网推荐 begin
源代码网推荐 SubClassApplication;
源代码网推荐 MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
源代码网推荐 if MutHandle = 0 then DoFirstInstance
源代码网推荐 else BroadcastFocusMessage;
源代码网推荐 end;
源代码网推荐
源代码网推荐 Initialization
源代码网推荐 MessageId := RegisterWindowMessage(UniqueAppStr);
源代码网推荐 InitInstance;
源代码网推荐 finalization
源代码网推荐 if WProc <> nil then SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
源代码网推荐 if MutHandle <> 0 then CloseHandle(MutHandle);
源代码网推荐 end.