Delphi实现程序只运行一次并激活已打开的程序

我们的程序有时候只允许运行一次，并且最好的情况是，如果程序第二次运行，就激活原来的程序。网上有很多的方法实现程序只运行一次，但对于激活原来的窗口却都不怎么好。

关键就在于激活原来的程序，一般的做法是在工程开始时，打开互斥量对象，如果打不开表示程序还没有运行，创建一个互斥量对象；如果打得开表示程序已经运行了，查找程序中一个特定的窗口，一般是主窗口，然后发送一个自定义消息，主窗口在这个消息处理中激活自己。我原来就是这么做的，却发现有很多问题。

主窗口在消息处理函数中激活不了自己，众所周知激活一个窗口最有效的方法当然就是 SetForegroundWindow ，但在主窗口中调用这个函数激活自己的效果却是只在标题栏闪了一闪，如果在其他进程调用该函数则不会有问题；另外，如果程序是最小化的，它连闪都不闪了。

对于这些问题，我想了下面的办法，在知道原程序已经运行后，用 FindWindow 找原程序主窗口的句柄，找到了，就发送一个自定义消息过去，而在原程序主窗口的消息处理函数中，只是调用 Application.Restore 方法，这样如果原程序是最小化的就会还原过来。在发送消息之后，紧接着我调用 SetForegroundWindow 并传入原程序主窗口的句柄，由于上面的处理，原程序肯定不是最小化了，且调用 SetForegroundWindow 的地方已经不是原程序了（是第二次运行的程序，也可以说是另一个进程），所以原程序可以很好的被激活。

看来一切都很好，当然不是，不然就不会有下面的代码了，我又发现了一些问题，首先当主窗体不是活动窗口时，比如主窗体被隐藏了，而目前活动的窗体是其他窗体，则上面的代码无效。另一个，如果主窗体前面有一个 ShowModal 的窗体，则上面的代码后，主窗体跑到 ShowModal 窗体的前面了。

只有继续探索了，看来问题出在 SetForegroundWindow 上，激活那个窗体都不好，因为那个窗体都有可能不在，有没有办法激活工程呢，我在 Application 中找方法，我找到 Application.BringToFront ，也许这个有点用，于是新建一个工程，加一个 Timer 控件，然后每隔 3 秒调用一次 Application.BringToFront ，运行看结果。可惜窗体仍然只是闪一下，并没有激活，这和我上面说的在自己进程中激活自己的结果一样，可能 BringToFront 方法里面也调用了 SetForegroundWindow 了吧，但它激活哪个窗口呢，这让我好奇，打开源码来看，看到了如下有代码：

procedure  TApplication.BringToFront;
var
  TopWindow: HWnd;
begin
   if  Handle <>  0  then
   begin
    TopWindow := GetLastActivePopup(Handle);
     if  (TopWindow <>  0 )  and  (TopWindow <> Handle)  and
      IsWindowVisible(TopWindow)  and  IsWindowEnabled(TopWindow)  then
      SetForegroundWindow(TopWindow);
   end ;
end ;

原来是用 GetLastActivePopup 这个 API 找到程序拥有的窗体中最近激活的窗体，然后再激活它。

哈，我有了一个技术方案，首先我要在第二次运行的程序中找到第一次运行的程序的 Application 的 Handle ，然后调用 SendMessage(APPHandle, WM_SYSCOMMAND, SC_RESTORE, 0) ， Application 类有处理这个消息的，最终它会调用 Application.Restore 方法， 让自己变为显示的状态，即最大化或正常。接着，就执行上面方法中的代码，让第一次运行的程序激活。现在关键是怎么找到第一次运行的 Application 的 Handle ，自然而然就想到了共享内存的技术，程序第一次运行时，先打开一个内存映射文件，如果打不开，则表示程序第一次运行，建一个内存映射文件对象，开辟一块共享的内存，这块内存保存 Application 的 Handle 。程序第二次运行，打开内存映射文件，可以打开了，得到一块共享内存，并取得了第一次运行程序的 Application 的 Handle ，然后，用我上面说的方法，即可大功告成。

花了一个小时的试验，最终有了下面的代码，结果非常成功：

unit  wdRunOnce;

{*******************************************
 * brief:  让程序只运行一次
 * autor: linzhenqun
 * date: 2005-12-28
 * email: linzhengqun@163.com
 * blog: http://blog.csdn.net/linzhengqun
********************************************}

interface

(*  程序是否已经运行，如果运行则激活它  *)
function  AppHasRun(AppHandle: THandle): Boolean;


implementation
uses
  Windows, Messages;

const
  MapFileName =  '{CAF49BBB-AF40-4FDE-8757-51D5AEB5BBBF}' ;

type
   // 共享内存
  PShareMem = ^TShareMem;
  TShareMem =  record
    AppHandle: THandle;   // 保存程序的句柄
   end ;

var
  hMapFile: THandle;
  PSMem: PShareMem;

procedure  CreateMapFile;
begin
  hMapFile := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MapFileName));
   if  hMapFile =  0  then
   begin
    hMapFile := CreateFileMapping($FFFFFFFF,  nil , PAGE_READWRITE,  0 ,
      SizeOf(TShareMem), MapFileName);
    PSMem := MapViewOfFile(hMapFile, FILE_MAP_WRITE  or  FILE_MAP_READ,  0 ,  0 ,  0 );
     if  PSMem =  nil  then
     begin
      CloseHandle(hMapFile);
      Exit;
     end ;
    PSMem^.AppHandle :=  0 ;
   end
   else  begin
    PSMem := MapViewOfFile(hMapFile, FILE_MAP_WRITE  or  FILE_MAP_READ,  0 ,  0 ,  0 );
     if  PSMem =  nil  then
     begin
      CloseHandle(hMapFile);
     end
   end ;
end ;

procedure  FreeMapFile;
begin
  UnMapViewOfFile(PSMem);
  CloseHandle(hMapFile);
end ;

function  AppHasRun(AppHandle: THandle): Boolean;
var
  TopWindow: HWnd;
begin
  Result := False;
   if  PSMem <>  nil  then
   begin
     if  PSMem^.AppHandle <>  0  then
     begin
      SendMessage(PSMem^.AppHandle, WM_SYSCOMMAND, SC_RESTORE,  0 );
      TopWindow := GetLastActivePopup(PSMem^.AppHandle);
       if  (TopWindow <>  0 )  and  (TopWindow <> PSMem^.AppHandle)  and
        IsWindowVisible(TopWindow)  and  IsWindowEnabled(TopWindow)  then
        SetForegroundWindow(TopWindow);
      Result := True;
     end
     else
      PSMem^.AppHandle := AppHandle;
   end ;
end ;

initialization
  CreateMapFile;

finalization
  FreeMapFile;

end .

 

你所要做的，就是将这个单元加进你的程序中，然后在你的工程文件中调用 AppHasRun ，并传入 Application 的 Handle ，你的程序就可以只运行一次了，工程大概如下：

program  Project1;

uses
  Forms,
  Unit1  in  'Unit1.pas'  {Form1}
  wdRunOnce  in  'wdRunOnce.pas' ,
  Unit2  in  'Unit2.pas'  {Form2}

{$R *.res}

begin
  Application.Initialize;
   if  not  AppHasRun(Application.Handle)  then
    Application.CreateForm(TForm1, Form1);
  Application.Run;
end .

多新建一些窗口测试一下吧，不过要注意新建的窗口得不能是自动创建的。