如何实现一个程序同时只能有一个实例呢？

Question

就是所谓的单实例，以前的文章也有介绍。如果大家有ultraedit，可以试一下。你可能发现通常ultraedit不能有一个以上的实例，不过如果你进入windows后没有使用过ultraedit，你找到ultraedit.exe狂点，你可以运行多个实例。我运行了5个ultraedit，这通常是前一个实例正在初始化，未运行防止多实例代码的时候，第二个或者第三个实例已经开始加载了。有没有更安全的方法，确保只有一个实例在运行？

Answer 1

function  IsPrognotRunning(ID: string): boolean;
begin
//通过建立互斥量来判断是否已经有同一个进程在运行
  CreateMutex(nil, true, pchar(ID));
  Result := not(GetLastError = ERROR_ALREADY_EXISTS);
end;在程序最开始（dpr文件中，Application.Initialize）之前调用进行判断。

Answer 2

比如把dpr文件修改成program Project1;uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};{$R *.res}begin
  if IsPrognotRunning('MyProgram ABCDE') then //这里的ID要尽量复杂一点，防止与别的程序重复。
  begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;
end.

Answer 3

网文：
   Windows 下一个典型的特征就是多任务，我们可以同时打开多个窗口进行操作，也可以同时运行程序的多个实例，比如可以打开许多个资源管理器进行文件的移动复制操作。但有时出于某种考虑（比如安全性），我们要做出一些限制，让程序只能够运行一个实例。在Delphi编程中，笔者总结出了以下几种方法： 
　　一、 查找窗口法 
　　这是最为简单的一种方法。在程序运行前用FindWindow函数查找具有相同窗口类名和标题的窗口，如果找到了，就说明已经存在一个实例。在项目源文件的初始化部分添加以下代码： 
　　Program OneApp 
　　Uses 
　　Forms,Windows;（这里介绍的几种方法均需在项目源文件中添加Windows单元，以后不再重复了） 
　　Var Hwnd:Thandle; 
　　Begin 
　　 Hwnd:=FindWindow(‘TForm1’，‘SingleApp’); 
　　 If Hwnd=0 then 
　　 Begin 
　　 Application.Initialize; 
　　 Application.CreateForm(Tform1, Form1); 
　　 Application.Run; 
　　 End; 
　　End; 
　　FindWindow()函数带两个参数，其中的一个参数可以忽略，但笔者强烈建议将两个参数都用上，免得凑巧别的程序也在使用相同的类名，就得不到正确的结果了。另外，如果是在Delphi IDE窗口中运行该程序，将一次都不能运行，因为已经存在相同类名和标题的窗口：设计时的窗体。 
　　二、使用互斥对象 
　　如果觉得查找窗口的方法效率不太高的话，可以使用创建互斥对象的方法。尽管互斥对象通常用于同步连接，但用在这个地方也是非常方便的。仅用了4句代码就轻松搞定。 
　　VAR Mutex:THandle; 
　　begin 
　　 Mutex:=CreateMutex(NIL,True,‘SingleApp’); 
　　 IF GetLastError<>ERROR_ALREADY_EXISTS THEN//如果不存在另一实例 
　　 BEGIN 
　　 Application.CreateHandle; 
　　 Application.CreateForm (TExpNoteForm, ExpNoteForm); 
　　 Application.Run; 
　　 END; 
　　 ReleaseMutex(Mutex); 
　　end. 
　　三、全局原子法 
　　我们也可以利用向系统添加全局原子的方法，来防止多个程序实例的运行。全局原子由Windows 系统负责维持，它能保证其中的每个原子都是唯一的，管理其引用计数，并且当该全局原子的引用计数为0时，从内存中清除。我们用GlobalAddAtom 函数向全局原子添加一个255个字节以内的字符串，用GlobalFindAtom来检查是否已经存在该全局原子，最后在程序结束时用GlobalDeleteAtom函数删除添加的全局原子。示例如下： 
　　Uses Windows 
　　const iAtom=‘SingleApp’; 
　　begin 
　　 if GlobalFindAtom(iAtom)=0 then 
　　 begin 
　　 GlobalAddAtom(iAtom); 
　　 Application.Initialize; 
　　 Application.CreateForm(TForm1,Form1); 
　　 Application.Run; 
　　 GlobalDeleteAtom(GlobalFindAtom(iAtom)); 
　　 end 
　　 else 
　　 MessageBox(0,‘You can not run a second copy of this App’,‘’,mb_OK); 
　　end. 
　　利用全局原子的引用计数规则，我们还可以判断当前共运行了该程序的多少个实例： 
　　var i:Integer; 
　　begin 
　　 I:=0; 
　　while GlobalFindAtom(iAtom)<>0 do 
　　 begin 
　　 GlobalDeleteAtom(GlobalFindAtom(iAtom)); 
　　 i:=i＋1; 
　　 end; 
　　 ShowMessage(IntToStr(I)); 
　　end; 
　　以上几种方法在笔者的Delphi 4.0，中文Windows95下通过。

Answer 4

这些Google上N多答案的http://lysoft.7u7.net

Answer 5

one:
procedure LookForPreviousInstance;
var
  PreviousInstanceWindow : hWnd;
  AppName : array[0..30] of char;
  FoundAtom : TAtom;
begin
  AtomText:='OnlyOne'+Application.title;
  FoundAtom := GlobalFindAtom(PChar(AtomText));
  if FoundAtom <> 0 then
  begin
    ShowMessage('该程序已经远行了！');
    StrFmt(AppName,'%s', [Application.Title]);
    Application.ShowMainForm := false;
    Application.Title := 'destroy me';
    PreviousInstanceWindow := FindWindow(nil,AppName);
    Application.Terminate;    if PreviousInstanceWindow <> 0 then
      if IsIconic(PreviousInstanceWindow) then
           ShowWindow(PreviousInstanceWindow,SW_RESTORE)
      else SetForegroundWindow(PreviousInstanceWindow);
  end;
  FoundAtom := GlobalAddAtom(PChar(AtomText));
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  inherited;
  LookForPreviousInstance;
end;procedure TForm1.FormDestroy(Sender: TObject);
var
  FoundAtom : TAtom;
  ValueReturned : word;
begin
  FoundAtom := GlobalFindAtom(Pchar(AtomText));
  if FoundAtom <> 0 then ValueReturned := GlobalDeleteAtom(FoundAtom);
//  inherited Destroy;
end;Two:
initialization
  Project:='RunOnlyOnce_MyProject';
  mHandle:=CreateMutex(nil,True,PChar(Project));
  if GetLastError=ERROR_ALREADY_EXISTS then
    begin
      ShowMessage('该程序已经运行了！');
      AppName:=Application.Title;
      Application.ShowMainForm:=False;
      Application.Title:='destroy me';
      PreviousInstanceWindow:=FindWindow(nil,PChar(AppName));
      if PreviousInstanceWindow<>0 then
        if IsIconic(PreviousInstanceWindow) then
          ShowWindow(PreviousInstanceWindow,SW_RESTORE)
        else
          SetForegroundWindow(PreviousInstanceWindow);
        Application.Terminate;
    end;
finalization
  if mHandle<>0 then
    CloseHandle(mHandle);
end.three:
procedure TForm1.FormCreate(Sender: TObject);
begin
  if GlobalFindAtom('PROGRAM_RUNNING') = 0 then 
    fAtom := GlobalAddAtom('PROGRAM_RUNNING')
  else
    begin
      ShowMessage('该程序已经运行了！');
      Halt; 
    end; 
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
 GlobalDeleteAtom(fAtom); 
end;我这里已经有三个已经编译好的源码。你可以去下载：
http://www.ksaiy.com/ynen/code.asp

Answer 6

利用全局原子法:
procedure TForm1.FormShow(Sender: TObject);
var
  atom: Integer;
begin
  if GlobalFindAtom('a random string here') = 0 then
    atom := GlobalAddAtom('a random string here')
  else
  begin
    ShowMessage('This application will run once a windows-session' + #13 +
      'Restart Your computer to use this app');
    Close;
  end;
end;

Answer 7

function  IsPrognotRunning(ID: string): boolean;
begin
//通过建立互斥量来判断是否已经有同一个进程在运行
  CreateMutex(nil, true, pchar(ID));
  Result := not(GetLastError = ERROR_ALREADY_EXISTS);
end;

Answer 8

全局原子法果然不错，但是有没有可能在执行GlobalFindAtom(iAtom)函数的时候，又启动了另外一个实例呢？研究一下如何给分，我是新手，第一次问问题。

Answer 9

虽然结贴了，但是情况和ultraedit 一样。重新启动windows，找到该文件，按着回车键不放，依然启动了多个实例。但是关闭所有实例之后，无论怎么样都不会出多个实例了。看来如果真的要做到最好，可能要用汇编语言编程来设置全局原子，然后再导入程序了。