请问如何在防止程序两次运行的同时自动弹出已运行的程序？

Question

防止程序两次运行我会，请问如何在防止程序两次运行的同时自动弹出已运行的程序？就像WindowsMediaPlayer一样。
谢谢。

Answer 1

定义一个消息
const
  CM_RESTORE = WM_USER+$100;
...
...
public
  procedure RestoreWin(var message:TMessage);message CM_RESTORE;
...
...
procedure Tform1.RestoreWin(var message:TMessage);message CM_RESTORE;
begin
  if IsIconic(Application.Handle) then
    Application.Restore
  else
    Application.BringToFront;
  end;
end;

Answer 2

procedure Tform1.RestoreWin(var message:TMessage;   //这个后面不要再加message CM_RESTORE
begin
  if IsIconic(Application.Handle) then
    Application.Restore
  else
    Application.BringToFront;
  end;
end;

Answer 3

将下面的代码保存为一个NoMultInst.pas，加入到你的项目中。在你的主窗体的implementation下uses NoMultInst;可以实现防止程序的多次运行。如果发现没有该程序在运行，则运行自己。否则，将正在运行的该程序激活（即如果是最小化，则恢复；如果没有焦点，则使之获得焦点，显示在最前面）最好修改一下UniqueAppStr的值，以免和我的程序互斥^_^unit NoMultInst;interfaceconst
 MI_QUERYWINDOWHANDLE=1;
 MI_RESPONDWINDOWHANDLE=2; MI_ERROR_NONE=0;
 MI_ERROR_FAILSUBCLASS=1;
 MI_ERROR_CREATINGMUTEX=2;function GetMIError: Integer;implementation
uses Forms, Windows, SysUtils;const
 UniqueAppStr='I_am_oldfat';var
 MessageID: Integer;
 WProc: TFNWndProc;
 MutHandle: THandle;
 MIError: Integer;function GetMIError: Integer;
begin
 Result:=MIError;
end;function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
 Result:=0;
 //如果这是注册过的我的消息
 if Msg=MessageID then
 begin
  case wParam of
   MI_QUERYWINDOWHANDLE:
    //我已经运行，一个新的实例在向我请求句柄，
    //所以显示我自己，并送回句柄
   begin
    if IsIconic(Application.Handle) then Application.Restore;
    PostMessage(HWND(lParam),MessageID,MI_RESPONDWINDOWHANDLE,Application.MainForm.Handle);
   end;
   MI_RESPONDWINDOWHANDLE:
    //已经有一个程序在运行了，并且它已经返回了句柄
    //所以让它获得焦点，结束我自己
   begin
    SetForegroundWindow(HWND(lParam));
    Application.Terminate;
   end;
  end; //end of case
 end   //end of if
 //如果不是我的消息，将它传递出去，给老的window proc
 else Result:=CallWindowProc(WProc,Handle,Msg,wParam,lParam);
end;procedure SubClassApplication;
begin
 //我subclass Application这个window procedure
 //使得Application.OnMessage事件对用户依然有效
 WProc:=TFNWndProc(SetWindowLong(Application.Handle,GWL_WNDPROC,Longint(@NewWndProc)));
 //如果错误发生，设置相应的错误标志
 if WProc=nil then MIError:=MIError or MI_ERROR_FAILSUBCLASS;
end;procedure DoFirstInstance;
//这个过程只能被第一个创建的实例调用
begin
 //创建互斥
 MutHandle:=CreateMutex(nil,False,UniqueAppStr);
 if MutHandle=0 then
  MIError:=MIError or MI_ERROR_CREATINGMUTEX;
end;procedure BroadcastFocusMessage;
//当发现已经有一个实例在运行时调用
var
 BSMRecipients: DWORD;
begin
 //防止主窗体闪烁
 Application.ShowMainForm:=false;
 //发送消息，与前一个实例建立对话
 BSMRecipients:=BSM_APPLICATIONS;
 BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
  @BSMRecipients,MessageID,MI_QUERYWINDOWHANDLE,Application.Handle);
end;procedure InitInstance;
begin
 SubClassApplication;  //挂上Application的消息循环队列
 Muthandle:=OpenMutex(MUTEX_ALL_ACCESS,false,UniqueAppStr);
 if MutHandle=0 then DoFirstInstance //我是第一个
 else BroadCastFocusmessage;         //已经有了
end;initialization
 MessageID:=RegisterWindowMessage(UniqueAppStr);
 InitInstance;finalization
 //恢复老的Application window procedure
 if WProc<>nil then
  SetWindowLong(Application.Handle,GWL_WNDPROC,Longint(WProc));
 //关闭互斥句柄
 if MutHandle<>0 then CloseHandle(MutHandle);end.

Answer 4

把你的project的代码改写成下列形式就可以
var
  hMutex: HWND;
  Ret: Integer;
begin
  try
    Application.Initialize;
    hMutex := CreateMutex(nil, false, 'Caption');
    ret := GetLastError;
    if Ret <> ERROR_ALREADY_EXISTS then
      begin
        Frm_LogIn := TFrm_LogIn.Create(application);
        Frm_LogIn.ShowModal;
        Frm_LogIn.Free;
        Application.Run;
      end;
    ReleaseMutex(hMutex);
  except
    halt;
  end;
end.