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

 

2007-07-16 18:33

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

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

主窗口在消息处理函数中激活不了自己，众所周知激活一个窗口最有效的方法当然就是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.

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