var MutexHandle: THandle; begin MutexHandle := CreateMutex(nil, TRUE, 'Application程序的标题,不是Form的标题'); if MutexHandle <> 0 then begin if GetLastError = ERROR_ALREADY_EXISTS then begin MessageBox(0, '对不起,程序已经运行........','警告:', mb_IconHand); CloseHandle(MutexHandle); Halt; end; end;
----------------------------------------------
-奔着小康前去,所以要更加努力
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 or BSF_POSTMESSAGE, @BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle); end; end;