如何防止同一个程序，被运行两次

Question

如何防止同一个程序，被运行两次？给我一个例子

Answer 1

createmutex(nil,false,pro_ONly');
  if getlasterror=error_already_exists then
   begin
    sendmessage(hwnd_broadcast,registerwindowmessage(pro_ONly'),0,0);
    halt(0);
   end;
放在  Application.Initialize;之前

Answer 2

新建一个unit文件：
unit UOneApp;interfaceconst
   MI_QUERYWINDOWHANDLE=1;
   MI_RESPONDWINDOWHANDLE=2;   MI_ERROR_NONE=0;
   MI_ERROR_FAILSUBCLASS=1;
   MI_ERROR_CREATINGMUTEX=2;   function GetMiError:Integer;implementationuses UMain,Forms,Windows,SysUtils;const UniqueAppStr='MyApplicationsss';
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
                begin
                    Application.MainForm.WindowState:=wsNormal;
                    Application.Restore;
                end;
                PostMessage(HWND(lParam),MessageID,MI_RESPONDWINDOWHANDLE,
                            Application.MainForm.Handle);
            end;
          MI_RESPONDWINDOWHANDLE:
            begin
                SetForeGroundWindow(HWND(lParam));
                Application.Terminate;
            end;
        end;
    end
    else
        Result:=CallWindowProc(WProc,Handle,Msg,wParam,lParam);
end;procedure SubClassApplication;
begin
    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;
    MutHandle:=OpenMutex(MUTEX_ALL_ACCESS,False,UniqueAppStr);
    if MutHandle=0 then
       DoFirstInstance
    else
       BroadCastFocusMessage;
end;initialization
   MessageID:=RegisterWindowMessage(UniqueAppStr);
   InitInstance;
finalization
   if WProc<>nil then
      SetWindowLong(Application.Handle,GWL_WNDPROC,LongInt(WProc));
   if MutHandle<>0 then
      CloseHandle(MutHandle);end.

Answer 3

将上述直接copy到你新建的unit中即可；

Answer 4

把以下代码代码加到工程文件里(选择Project-->view source)var
        WinHandle:THANDLE;
begin
        WinHandle:=FindWindow(nil,'某某系统');
if WinHandle=0 then
        Application.Initialize;
        Application.CreateForm(TForm1,Form1);
        Application.Run;
else
        begin
        showmessage('程序已经运行!')  //这句可去掉,直接切换到已运行的实例
        windows.setfocus(WinHandle)
        windows.setforeground(WinHandle)
        end;
end. 

Answer 5

为什么我总是来晚？为什么？
我知道，加入主窗体的创建事件中，代码如下：
procedure TForm1.FormCreate(Sender: TObject); 
var 
ZAppName: array[0..127] of char; 
Hold: String; 
Found: HWND; 
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; 

Answer 6

program EXE;uses
  Forms,windows;
  unit1 in 'unit1.pas' {f_menu},{$R *.RES}
 Var
    hMutex:HWND;
    Ret:Integer;
 begin
  Application.Initialize;
  Application.Title := 'EXE';
  hMutex:=CreateMutex(nil,False,'main');
  Ret:=GetLastError;
  If Ret<>ERROR_ALREADY_EXISTS Then
   Begin
     Application.CreateForm(Tform1, form1);
     Application.Run;
   End
  Else
   Application.MessageBox('本程序只可同时运行一个!','提示框',MB_OK+mb_iconwarning);
   ReleaseMutex(hMutex);
end.

Answer 7

var
  s1,s2 : string;begin
  //
  s1 := Application.ClassName;
  s2 := '粮情测控系统';
  if FindWindow(PChar(s1),PChar(s2)) <> 0 then
  begin
    ShowMessage('本程序的另一个实例已经在运行,请单击确定退出');
    Exit;
  end;
end;
  //以上用于防止重复进入本程序
(Lyhua)

Answer 8

如果忽然停电,或其它原因导致强行关机,那程序不永远运行不了了?方法很多,原理类似,在系统中设定一唯一标识!建议楼主多查查以前的贴,各种方法都有,也可以自己想新方法!不建议只使用FindWindow来实现,重复的可能性太大!

Answer 9

to ehom(？！) : 按照你的说法，任何方法都可能存在异常，没有万无一失的方法。

Answer 10

是,不可能万无一失!出现异常没来得及删除文件几乎时时刻刻都有可能发生,所以不可取!窗体使用同一Class,Title的概率的很大,所以虽然可以,但不好!但如上面用CreateMutex创建Mutex物件的方法重复概率就非常小,所以可以这么做!

Answer 11

用互斥量,这个好(用GUID),
NND!
Findwindows的人全是笨蛋!!