您的位置:首页 > 编程语言 > Delphi

两种Delphi防止多实例运行的方法

2017-08-15 00:00 211 查看
两种Delphi防止多实例运行的方法
  在学习Delphi时,遇到需要程序单实例运行的时候,经过查阅,暂时发现以下两种比较简单的方法,可以防止程序多实例运行,各有优劣,据需选择。

方法一,添加以下unit即可,优点是可激活已存在的程序窗口,即使已最小化(包括最小化到托盘),缺点是可能存在与其他程序的互斥(可自行修改STR_UNIQUE的值以尽量减少该可能性)。代码如下:

//工程引用此单元就能防止同时出现多个实例
unit MultInst;

interface

uses
Windows ,Messages, SysUtils, Classes, Forms;

implementation

const
STR_UNIQUE    = '{2BE6D96E-827F-4BF9-B33E-8740412CDE96}';//建议修改
MI_ACTIVEAPP  = 1;  {激活应用程序}
MI_GETHANDLE  = 2;  {取得句柄}
var
iMessageID    : Integer;
OldWProc      : TFNWndProc;
MutHandle     : THandle;
BSMRecipients : DWORD;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
Longint; stdcall;
begin
Result := 0;
if Msg = iMessageID then
begin
case wParam of
MI_ACTIVEAPP: {激活应用程序}
if lParam<>0 then
begin
{激活前一个实例}
if IsIconic(lParam) then
begin
OpenIcon(lParam);
SendMessage(lParam,WM_SYSCOMMAND,SC_DEFAULT ,SC_SCREENSAVE);{激活窗口}
end
else
SetForegroundWindow(lParam);
Application.Terminate; {终止本实例}
end;
MI_GETHANDLE: {取得程序句柄}
begin
PostMessage(HWND(lParam), iMessageID, MI_ACTIVEAPP,
Application.Handle);
end;
end;
end
else
Result := 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 then
begin
{建立互斥对象}
MutHandle := CreateMutex(nil, False, STR_UNIQUE);
end
else begin
Application.ShowMainForm  :=  False;
{已经有程序实例,广播消息取得实例句柄}
BSMRecipients := BSM_APPLICATIONS;
BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle);
end;
end;

initialization
{注册消息}
iMessageID  := RegisterWindowMessage(STR_UNIQUE);
InitInstance;

finalization
{还原消息处理过程}
if OldWProc <> Nil then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));

{关闭互斥对象}
if MutHandle <> 0 then CloseHandle(MutHandle);

end.
方法二,修改工程文件源代码,程序初始化时创建互斥对象,并检查是否互斥以保证单实例运行。优点是代码少且简单,缺点是无法将已运行的窗口激活。实例代码如下:

program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Windows,Messages,ShellApi;
{$R *.res}
var
HMutex:Hwnd;
Ret:Integer;
Reg :integer;
begin
Application.Initialize;
Application.Title :='这是一个防止多个实例运行的程序';
HMutex  :=CreateMutex(nil,False,Pchar('这是一个防止多个实例运行的程序'));
Reg :=GetLastError;
if Reg<>ERROR_ALREADY_EXISTS then
begin
Application.CreateForm(TForm1, Form1);
end
else
begin
MessageBox(0,'实例已经运行了!','错误', MB_OK + MB_ICONERROR);
ReleaseMutex(hMutex);
end;
Application.Run;
end
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: