Delphi避免程序重复运行

全局量子和查找窗体的方法都用过，不太好，用下面这个

unit once;

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

{收到消息的激活前一个实例}

{为什么要在另一个程序中激活?}

{因为在同一个进程中SetForegroundWindow并不能把窗体提到最前}

if IsIconic(lParam) then

OpenIcon(lParam)

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 orBSF_POSTMESSAGE,

@BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle);

end;

end;

initialization

{注册消息}

iMessageID :=RegisterWindowMessage(STR_UNIQUE);

InitInstance;

finalization

{还原消息处理过程}

if OldWProc <> Nilthen

SetWindowLong(Application.Handle, GWL_WNDPROC,LongInt(OldWProc));

{关闭互斥对象}

if MutHandle <> 0then CloseHandle(MutHandle);

end.

将这个unit加入项目，主窗体引用即可！BDS2006+win7下测试通过