程序只运行一次并激活原来的程序

原创 2005年12月29日 01:26:00

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

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

主窗口在消息处理函数中激活不了自己,众所周知激活一个窗口最有效的方法当然就是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 <> 0and (TopWindow <> Handle) and
      IsWindowVisible(TopWindow) 
and IsWindowEnabled(TopWindow) then
      SetForegroundWindow(TopWindow);
  
end;
end;

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

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

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

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, 000);
    
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, 000);
    
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 <> 0and (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,并传入ApplicationHandle,你的程序就可以只运行一次了,工程大概如下:

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.

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

目前还没有发现什么问题,如果你发现了什么问题,可以在留言中说明,如果你要完整的Demo程序,当然可以,Email给我就行了,别告诉我你不知道我的Email,到我的Blog的首页去找吧。。

 

相关文章推荐

delphi 异形窗体可半透明

unit xDrawForm; interface uses Windows, Messages, SysUtils, Classes, Controls, Forms, Menus, Gr...
  • wc1000
  • wc1000
  • 2015年07月18日 16:05
  • 876

彻底解决delphi Indy10接收邮件汉字显示乱码的问题

使用indy组件接收邮件时,遇到汉字大多显示为乱码,网上很多询问同类型的问题。这几天做一个邮件客户端的小项目,研究了一下Indy10的代码,发现有办法根本解决这个问题,感觉牵涉的知识点挺多的,在这里讲...

C# 实现程序只启动一次(多次运行激活第一个实例,使其获得焦点,并在最前端显示)

防止程序运行多个实例的方法有多种,如:通过使用互斥量和进程名等.而我想要实现的是:在程序运行多个实例时激活的是第一个实例,使其获得焦点,并在前端显示. 主要用到两个API 函数: ShowW...

c# 程序只能运行一次(多次运行只能打开同一个程序) 并激活第一个实例,使其获得焦点,并在最前端显示.

防止程序运行多个实例的方法有多种,如:通过使用互斥量和进程名等.而我想要实现的是:在程序运行多个实例时激活的是第一个实例,使其获得焦点,并在前端显示. 主要用到两个API 函数: Show...
  • educast
  • educast
  • 2012年05月08日 12:37
  • 696

delphi_一次只运行一个程序原代码

  • 2010年10月28日 09:32
  • 160KB
  • 下载

控制MFC程序只能运行一次

  • 2015年11月10日 16:58
  • 3.54MB
  • 下载

解决:无法将“Add-Migration”项识别为 cmdlet、函数、脚本文件或可运行程序的名称。请检查名称的拼写,如果包括路径,请确保路径正确,然后再试一次

1、输入的中划线“-”格式不对,检查是否为全角状态下输入,误输入了下划线“_",或是前后有空格; 2、没有引用EntityFramework命令,请执行如下名称(Import-Module 项目路径...

程序只能运行一次

  • 2007年12月07日 20:37
  • 3KB
  • 下载

delphi程序只运行一次

  • 2011年12月20日 23:37
  • 32KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:程序只运行一次并激活原来的程序
举报原因:
原因补充:

(最多只允许输入30个字)