防止多个实例公用程序_Delphi

将以下代码保存为MultInst.pas, 然后在任何Project的
Main Form中Uses MultInst, 就可以完善防止程序的多个
实例同时运行, 特与大家共享.

unit MultInst;

interface

const
MI_QUERYWINDOWHANDLE   = 1;

http://www.gaodaima.com/65644.html防止多个实例公用程序_Delphi

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.

欢迎大家阅读《防止多个实例公用程序_Delphi》,跪求各位点评,若觉得好的话请收藏本文，by 搞代码

喜欢 (0)赏

[搞代码]

分享 (0)