如何实现同一个应用程序只能打开一次
- Delphi(Pascal) code
var aHandle: THandle;begin aHandle := CreateMutex(nil, TRUE, ' '); if (aHandle <> 0) and (GetLastError = ERROR_ALREADY_EXISTS) then begin Application.MessageBox('程序已经运行!', '提示!', MB_OK); CloseHandle(aHandle); end else begin Application.Initialize; Application.MainFormOnTaskbar := True; Application.CreateForm(TfrmSearchFormPath, frmSearchFormPath); end; Application.Run;end.这样虽然能找到该应用程序是否打开
但不能定位到该程序窗体
请各位帮忙修改实现(单窗体的)
[解决办法]
决定拿你的分,你的问题由我来解决
- Delphi(Pascal) code
program cpglt;uses windows, Forms;{$R *.res}varhAppMutex: THandle;begin Application.Initialize; hAppMutex := CreateMutex(nil, false, PChar(‘文件唯一的名称,可以随便你用’)); if (hAppMutex = 0) then begin exit; end; if ((hAppMutex <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS)) then begin //MessageBox(0,PChar('不是第一次运行这个程序!'),PChar('OK'),MB_OK + MB_ICONINFORMATION); CloseHandle(hAppMutex); exit; end; Application.Title := '彩票电脑规律'; Application.CreateForm(TForm1, Form1); Application.Run; //关闭互斥对象 CloseHandle(hAppMutex);end.
[解决办法]
我来接分,给你个单元
- Delphi(Pascal) code
unit UnicoughOneInst;interfaceuses SysUtils;type EUnicough_MultInstError = class(Exception);procedure SetMultInstState(const AllowMultInst: Boolean);function IsMultInstAllowed: Boolean;implementationuses Windows, Forms;const MI_GETMULTINSTSTATE = 0; MI_RESPONDMULTINSTSTATE = 1;var MultInstAllowed: Boolean = false; MutHandle: Integer; OldWProc: TFNWndProc; MI_ACTIVATE: Integer;procedure SetMultInstState(const AllowMultInst: Boolean);begin MultInstAllowed := AllowMultInst;end;function IsMultInstAllowed: Boolean;begin Result := MultInstAllowed;end;function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;begin Result := 0; if Msg = MI_ACTIVATE then case wParam of MI_GETMULTINSTSTATE: begin if not MultInstAllowed then begin Application.MainForm.WindowState := wsNormal; Application.Restore; PostMessage(HWND(lParam), MI_ACTIVATE, MI_RESPONDMULTINSTSTATE, Application.MainForm.Handle); end else PostMessage(HWND(lParam), MI_ACTIVATE, MI_RESPONDMULTINSTSTATE, 0); end; MI_RESPONDMULTINSTSTATE: if lParam <> 0 then begin SetForegroundWindow(HWND(lParam)); Application.Terminate; end else Application.MainForm.Visible := true; end else Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);end;procedure DoFirstInstance;begin MutHandle := CreateMutex(nil, False, PChar(Application.Title)); if MutHandle = 0 then raise EUnicough_MultInstError.Create('无法创建互斥!');end;procedure BroadcastFocusMessage;var BSMRecipients: DWORD;begin Application.ShowMainForm := False; BSMRecipients := BSM_APPLICATIONS; BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MI_ACTIVATE, MI_GETMULTINSTSTATE, Application.Handle);end;procedure InitInstance;begin OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc))); if OldWProc = nil then raise EUnicough_MultInstError.Create('无法获取消息循环!'); MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(Application.Title)); if MutHandle = 0 then DoFirstInstance else BroadcastFocusMessage;end;initialization MI_ACTIVATE := RegisterWindowMessage(PChar(Application.Title)); InitInstance;finalization if OldWProc <> nil then SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWProc)); if MutHandle <> 0 then CloseHandle(MutHandle);end.