禁止程序两次执行

覆盖窗体的CREATEPARAMS过程,修改窗体的WINDOWCLASSNAME
在主工程中先用FINDWINDOW查找主窗口.若找到则发个消息给主窗体让其显示.

function CheckIsFirst:Boolean;
var fMutexHandle:thandle
begin
    fMutexHandle:=OpenMutex(mutex_all_access,False,'CheckFirst');      if fMutexHandle=0 then
      begin
         fMutexHandle:=CreateMutex(nil,false,'CheckFirst');
         result:=fMutexHandle<>0;
      end else
        begin
           Result:=False;
           TUtils.ShowMess('程序已经运行，不允许两个实例同时运行!');
        end;
end;

const iAtom='MyDpr';
begin
  GlobalDeleteAtom(GlobalFindAtom(iAtom));
  if GlobalFindAtom(iAtom)<>0 then
  showmessage('程序已运行');
end;在program文件中写。=0就创建窗体。

procedure TForm1.FormCreate(Sender: TObject);
var
  ZAppName: array[0..127] of char;
  Hold: String;
  Found: HWND;
begin
  Hold := Application.Title;
  Application.Title := 'OnlyOne'
     + IntToStr(HInstance); // 暂时修改窗口标题
  StrPCopy(ZAppName, Hold); // 原窗口标题
  Found := FindWindow(nil, ZAppName); // 查找窗口
  Application.Title := Hold; // 恢复窗口标题
  if Found<>0 then begin
    // 若找到则激活已运行的程序并结束自身
    ShowWindow(Found, SW_RESTORE);
    Application.Terminate;
  end;
end;

方法太多
最懒的方法是把下面的单元加入到你的工程，别的什么都不用管：
//==============================================================================
// Unit Name: OnlyOnce
// 工作流程
// 程序运行先取代原有向所有消息处理过程,然后广播一个消息.
// 如果有其它实例运行,收到广播消息会回发消息给发送程序,并传回它自己的句柄
// 发送程序接收到此消息,激活收到消息的程序,然后关闭自己
//==============================================================================
unit Once;interfaceuses
  Windows ,Messages, SysUtils, Classes, Forms;implementationconst
  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
            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;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.

procedure TForm1.FormCreate(Sender: TObject);
var
  ZAppName: array[0..127] of char;
  Hold: String;
  Found: HWND;
begin
  Hold := Application.Title;
  Application.Title := 'OnlyOne' + IntToStr(HInstance); // 暂时修改窗口标题
  StrPCopy(ZAppName, Hold); // 原窗口标题
  Found := FindWindow(nil, ZAppName); // 查找窗口
  Application.Title := Hold; // 恢复窗口标题
  if Found<>0 then begin
    // 若找到则激活已运行的程序并结束自身
    ShowWindow(Found, SW_RESTORE);
    Application.Terminate;
  end;
end;

我知道方法很多，你们有没注意看我的问题啊
findwindow的方法，如果主窗口最小化到系统托盘，findwindow就找不到了
互斥体的方法找不到主窗口的句柄hellolongbin(一个人[终不似少年游]) 兄的方法不知道主窗口隐藏的时候能不能收到消息，我去试试我只想知道能否通过查找进程的方法，找到句柄，可以的话，怎么做

调试易

禁止程序两次执行

解决方案 »