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

bestlong

資料來源
http://blog.sina.com.cn/s/blog_703f7fe801012m1h.html

Delphi实现程序只运行一次并激活已打开的程序 我们的程序有时候只允许运行一次，并且最好的情况是，如果程序第二次运行，就激活原来的程序。网上有很多的方法实现程序只运行一次，但对于激活原来的窗口却都不怎么好。
关键就在于激活原来的程序，一般的做法是在工程开始时，打开互斥量对象，如果打不开表示程序还没有运行，创建一个互斥量对象；如果打得开表示程序已经运行了，查找程序中一个特定的窗口，一般是主窗口，然后发送一个自定义消息，主窗口在这个消息处理中激活自己。我原来就是这么做的，却发现有很多问题。
主窗口在消息处理函数中激活不了自己，众所周知激活一个窗口最有效的方法当然就是SetForegroundWindow，但在主窗口中调用这个函数激活自己的效果却是只在标题栏闪了一闪，如果在其他进程调用该函数则不会有问题；另外，如果程序是最小化的，它连闪都不闪了。

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

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

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

1. procedure TApplication.BringToFront;
   
2. var
   
3.   TopWindow: HWnd;
   
4. begin
   
5.   if Handle <> 0 then
   
6.   begin
   
7.     TopWindow := GetLastActivePopup(Handle);
   
8.     if (TopWindow <> 0) and (TopWindow <> Handle) and
   
9.       IsWindowVisible(TopWindow) and IsWindowEnabled(TopWindow) then
   
10.       SetForegroundWindow(TopWindow);
    
11.   end;
    
12. end;

複製代碼

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

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

1. unit wdRunOnce;
   
2. {*******************************************
   
3. * brief: 让程序只运行一次
   
4. * autor: linzhenqun
   
5. * date: 2005-12-28
   
6. * email: linzhengqun@163.com
   
7. * blog: http://blog.csdn.net/linzhengqun
   
8. ********************************************}
   
9. interface
   
10. (* 程序是否已经运行，如果运行则激活它 *)
    
11. function AppHasRun(AppHandle: THandle): Boolean;
    
12. 
    
13. implementation
    
14. uses
    
15.   Windows, Messages;
    
16. const
    
17.   MapFileName = '{CAF49BBB-AF40-4FDE-8757-51D5AEB5BBBF}';
    
18. type
    
19.   //共享内存
    
20.   PShareMem = ^TShareMem;
    
21.   TShareMem = record
    
22.     AppHandle: THandle;  //保存程序的句柄
    
23.   end;
    
24. var
    
25.   hMapFile: THandle;
    
26.   PSMem: PShareMem;
    
27. procedure CreateMapFile;
    
28. begin
    
29.   hMapFile := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MapFileName));
    
30.   if hMapFile = 0 then
    
31.   begin
    
32.     hMapFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
    
33.       SizeOf(TShareMem), MapFileName);
    
34.     PSMem := MapViewOfFile(hMapFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
    
35.     if PSMem = nil then
    
36.     begin
    
37.       CloseHandle(hMapFile);
    
38.       Exit;
    
39.     end;
    
40.     PSMem^.AppHandle := 0;
    
41.   end
    
42.   else begin
    
43.     PSMem := MapViewOfFile(hMapFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
    
44.     if PSMem = nil then
    
45.     begin
    
46.       CloseHandle(hMapFile);
    
47.     end
    
48.   end;
    
49. end;
    
50. procedure FreeMapFile;
    
51. begin
    
52.   UnMapViewOfFile(PSMem);
    
53.   CloseHandle(hMapFile);
    
54. end;
    
55. function AppHasRun(AppHandle: THandle): Boolean;
    
56. var
    
57.   TopWindow: HWnd;
    
58. begin
    
59.   Result := False;
    
60.   if PSMem <> nil then
    
61.   begin
    
62.     if PSMem^.AppHandle <> 0 then
    
63.     begin
    
64.       SendMessage(PSMem^.AppHandle, WM_SYSCOMMAND, SC_RESTORE, 0);
    
65.       TopWindow := GetLastActivePopup(PSMem^.AppHandle);
    
66.       if (TopWindow <> 0) and (TopWindow <> PSMem^.AppHandle) and
    
67.         IsWindowVisible(TopWindow) and IsWindowEnabled(TopWindow) then
    
68.         SetForegroundWindow(TopWindow);
    
69.       Result := True;
    
70.     end
    
71.     else
    
72.       PSMem^.AppHandle := AppHandle;
    
73.   end;
    
74. end;
    
75. initialization
    
76.   CreateMapFile;
    
77. finalization
    
78.   FreeMapFile;
    
79. end.

複製代碼

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

1. program Project1;
   
2. uses
   
3.   Forms,
   
4.   Unit1 in 'Unit1.pas' {Form1}
   
5.   wdRunOnce in 'wdRunOnce.pas',
   
6.   Unit2 in 'Unit2.pas' {Form2}
   
7. {$R *.res}
   
8. begin
   
9.   Application.Initialize;
   
10.   if not AppHasRun(Application.Handle) then
    
11.     Application.CreateForm(TForm1, Form1);
    
12.   Application.Run;
    
13. end.

複製代碼