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