admin 管理员组文章数量: 887021
2023年12月17日发(作者：mysql存大文本)
Delphi实现程序只运行一次并激活已打开的程序
Delphi实现程序只运行一次并激活已打开的程序
我们的程序有时候只允许运行一次，并且最好的情况是，如果程序第二次运行，就激活原来的程序。网上有很多的方法实现程序只运行一次，但对于激活原来的窗口却都不怎么好。关键就在于激活原来的程序，一般的做法是在工程开始时，打开互斥量对象，如果打不开表示程序还没有运行，创建一个互斥量对象；如果打得开表示程序已经运行了，查找程序中一个特定的窗口，一般是主窗口，然后发送一个自定义消息，主窗口在这个消息处理中激活自己。我原来就是这么做的，却发现有很多问题。主窗口在消息处理函数中激活不了自己，众所周知激活一个窗口最有效的方法当然就是SetForegroundWindow，但在主窗口中调用这个函数激活自己的效果却是只在标题栏闪了一闪，如果在其他进程调用该函数则不会有问题；另外，如果程序是最小化的，它连闪都不闪了。对于这些问题，我想了下面的办法，在知道原程序已经运行后，用FindWindow找原程序主窗口的句柄，找到了，就发送一个自定义消息过去，而在原程序主窗口的消息处理函数中，只是调用e方法，这样如果原程序是最小化的就会还原过来。在发送消息之后，紧接着我调用SetForegroundWindow并传入原程序主窗口的句柄，由于上面的处理，原程序肯定不是最小化了，且调用SetForegroundWindow的地方已经不是原程序了（是第二次运行的程序，也可以说是另一个进程），所以原程序可以很好的被激活。看来一切都很好，当然不是，不然就不会有下面的代码了，我又发现了一些问题，首先当主窗体不是活动窗口时，比如主窗体被隐藏了，而目前活动的窗体是其他窗体，则上面的代码无效。另一个，如果主窗体前面有一个ShowModal的窗体，则上面的代码后，主窗体跑到ShowModal窗体的前面了。只有继续探索了，看来问题出在SetForegroundWindow上，激活那个
窗体都不好，因为那个窗体都有可能不在，有没有办法激活工程呢，我在Application中找方法，我找到oFront，也许这个有点用，于是新建一个工程，加一个Timer控件，然后每隔3秒调用一次oFront，运行看结果。可惜窗体仍然只是闪一下，并没有激活，这和我上面说的在自己进程中激活自己的结果一样，可能BringToFront方法里面也调用了SetForegroundWindow了吧，但它激活哪个窗口呢，这让我好奇，打开源码来看，看到了如下有代码：procedure
oFront;
var
TopWindow: HWnd;
begin
if Handle <> 0 then
begin
TopWindow := GetLastActivePopup(Handle);
if (TopWindow <> 0) and (TopWindow <> Handle) and
IsWindowVisible(TopWindow)
IsWindowEnabled(TopWindow) then
SetForegroundWindow(TopWindow);
end;
end;原来是用GetLastActivePopup这个API找到程序拥有的窗体中最近激活的窗体，然后再激活它。哈，我有了一个技术方案，首先我要在第二次运行的程序中找到第一次运行的程序的Application的Handle，然后调用SendMessage(APPHandle,
WM_SYSCOMMAND, SC_RESTORE, 0)，Application类有处理这个消息的，最终它会调用e方法，让自己变为显示的状态，即最大化或正常。接着，就执行上面方法中的代码，让第一次运行的程序激活。现在关键是怎么找到第一次运行的Application的Handle，自然而然就想到了共享内存的技术，程序第一次运行时，先打开一个内存映射文件，如果打不开，则表示程序第一次运行，建一and
个内存映射文件对象，开辟一块共享的内存，这块内存保存Application的Handle。程序第二次运行，打开内存映射文件，可以打开了，得到一块共享内存，并取得了第一次运行程序的Application的Handle，然后，用我上面说的方法，即可大功告成。花了一个小时的试验，最终有了下面的代码，结果非常成功：unit wdRunOnce;
{*******************************************
* brief: 让程序只运行一次
* autor: linzhenqun
* date: 2005-12-28
*email:******************** blog: /linzhengqun
********************************************}
interface
(* 程序是否已经运行，如果运行则激活它 *)
function AppHasRun(AppHandle: THandle): Boolean;
implementation
uses
Windows, Messages;
const
MapFileName
51D5AEB5BBBF}';
type
//共享内存
= '{CAF49BBB-AF40-4FDE-8757-
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,
SC_RESTORE, 0);
TopWindow := GetLastActivePopup(PSMem^.AppHandle);
if (TopWindow <> 0) and (TopWindow <>
and
PSMem^.AppHandle) and
IsWindowVisible(TopWindow)
IsWindowEnabled(TopWindow) then
SetForegroundWindow(TopWindow);
WM_SYSCOMMAND,
Result := True;
end
else
PSMem^.AppHandle := AppHandle;
end;
end;
initialization
CreateMapFile;
finalization
FreeMapFile;
end.你所要做的，就是将这个单元加进你的程序中，然后在你的工程文件中调用AppHasRun，并传入Application的Handle，你的程序就可以只运行一次了，工程大概如下：program Project1;
uses
Forms,
Unit1 in '' {Form1}
wdRunOnce in '',
Unit2 in '' {Form2}
{$R *.res}
begin
lize;
if not AppHasRun() then
Form(TForm1, Form1);
;
end.
公司开发的软件需要对串口进行操作，每次打开软件后程序自动去打开串口寻找连接到串口上的设备，但是如果用户不知道打开了两次，那么第二次打开的程序是不能正常使用的，因为对串口的操作时独占的，第一个程序独占了串口的使用权，其他程序无法再使用那一个串口，当然如果PC机器上有两个串口，那第二个程序也是可以用的。为了解决这个问题，必须限制对串口操作的软件只能打开一个。打开软件后用户如果误操作再次想打开该软件，需要提示用户软件已经打开，并让已打开的软件显示在窗口最顶层。 下面是Delphi版的解决方法。(方法一)利用互斥对象开发过多线程软件的可能都使用过互斥对象，它常被用做线程间同步的技术手段。简要的提一下互斥对象：互斥对象把第一次建立它的程序作为主程序，这样只用检测互斥对象是否已经有主程序就判断程序是否已经运行过，这里需要涉及到一个api函数：WaitForSingleObject，该函数的第一个参数为用以检测的互斥对象，第2个参数的表示函数返回结果前的滞留时间，如果改函数返回wait_TimeOut就表明互斥对象已经有了一个主程序。注意：以下的代码都出现在工程文件中，而不是单元文件中。var
myMutex:HWND;
begin
//CreateMutex建立互斥对象，并且给互斥对象起一个唯一的名字。
myMutex:=CreateMutex(nil,false,'hkOneCopy');
//程序没有被运行过
if WaitForSingleObject(myMutex,0)<>wait_TimeOut then
begin
lize;
Form(TForm1, Form1);
;
End;
End;
[注释]： 当应用程序第一次运行的时候，在应用程序中会建立一个互斥对象，名称为'hkOneCopy'，然后判断系统中有没有这个互斥对象，如果没有则初始化应用程序。下面再完善一下这个程序。我们不希望程序被多次运行，而是希望如果程序运行过后，再运行这个程序的时候，将已运行的程序做出一些响应，比如说让它变为最上层的活动窗口来提示用户该程序正在运行。为达到这个目的，必须要获得正在运行程序的句柄，然后用一个APISetForeGroundWindow(handle)，来使程序的窗口最前并激活。为了得到程序的句柄，要使用windows枚举函数EnumWindows来遍历windows窗口列表，该函数需要一个回调函数作参数，用这个回调函数来对每一个系统中的窗口进行调用直到最后一个窗口或回调函数返回false为止[注：关于EnumWindows函数的介绍在篇尾]。只要编写这个回调函数并在其中不断的比较当前遍历到的窗口类名和我们的程序的主窗口类名，以及比较窗口可执行文件的名称和我们程序的名称直到找到相同的为止，将这时的窗口句柄保存下来就行了。为获得窗口的类名和句柄，需要一个APIGetClassName，为获得可执行文件的名称，需要APIGetModuleFileName。下面是详细代码。[注意：
下面代码在delphi7下运行通过。但是如果窗口最小化后，再次运行程序时，原先已经运行的程序能够被置前并激活但是标题栏的最小化按钮却不能用了。当尝试了N中方法后估计是delphi自身TForm类的问题，下面给出一个解决方案：在窗口上放一个ApplicationEvents控件，它管理着应用程序所有的消息。我们在它的OnMessage事件里写上下面的代码： if = then
begin//161 是在标题栏按下鼠标//8 是在标题栏的最小化按钮上按下鼠标
if (e= 161) and (= 8) then
begin
State:= wsMinimized;
end;
end;//在网上我也找到了一个关于这个问题的解决方法，air_supply1118的专栏(/air_supply1118/archive/2006/08/30/)不过我没有测试。]program MyThreadTest;uses
Windows,
Forms,
SysUtils,
Messages,
Dialogs,
Unit1 in '' {Form1},
{$R *.res}var
myMutex,
FindHid: HWND;
MoudleName: string;function EnumWndProc(hwnd: Thandle;
param: Cardinal): bool; stdcall;
//由于用于api回调函数，请使用windows传统的参数传递方式stdcall
var
ClassName, WinMoudleName: string;
WinInstance: THandle;
begin
result := true;
SetLength(ClassName, 100);
GetClassName(hwnd, pchar(ClassName),
length(ClassName)); //获得当前遍历窗口的类名
ClassName := pchar(ClassName); //在字符串后加结束符，确定字符串结束
if UpperCase(ClassName) = UpperCase(ame)
then //比较类名
begin
WinInstance := GetWindowLong(hwnd, GWL_HINSTANCE);
//获得当前遍历窗口的实例
setlength(WinMoudleName, 100);
//获得当前遍历窗口的程序文件名
GetModuleFileName(WinInstance, pchar(WinMoudleName),
length(WinMoudleName));
WinMoudleName := pchar(WinMoudleName);
WinMoudleName :=ExtractFileName(WinMoudleName);
//MoudleName为工程全局变量，自身程序的文件名
if UpperCase(WinMoudleName) = UpperCase(MoudleName)
then
begin
FindHid := hwnd;//FindHid为工程全局变量保存找到的句炳
result := false; //找到以后就结束遍历
end;
end;
end;begin
// CreateMutex建立互斥对象，并且给互斥对象起一个唯一的名
字
myMutex := CreateMutex(nil, false, 'hkOneCopy');
if WaitForSingleObject(myMutex, 0) <> wait_TimeOut then
//程序没有被运行过
begin
lize;
Form(TForm1, Form1);
;
end else
begin
SetLength(MoudleName, 100);
//获得自己程序文件名
GetModuleFileName(HInstance,
length(MoudleName));
MoudleName := pchar(MoudleName);
MoudleName := ExtractFileName(MoudleName);
EnumWindows(@EnumWndProc, 0); //调用枚举函数
if FindHid <> 0 then
begin
ShowWindow(FindHid,SW_RESTORE);
SetForegroundWindow(FindHid);
end;
end;
end.
[EnumWindows函数使用]：EnumWindows 用来列举屏幕上所有顶层窗口。MSDN：
The EnumWindows function enumerates all top-level
windows on the screen by passing the handle to each window。函数形式：BOOL EnumWindows(WNDENUMPROC lpEnumFunc,
//callback function
pchar(MoudleName),
LPARAM lParam); //application-defined value用EnumWindows的
其中
WNDENUMPROC 是回调函数，回调函数中写自己想做的操作，当调时候，每次遇到一个窗口，系统就调用一次你的WNDENUMPROC ，然后把窗口句柄传给你。
EnumWindows
函数成功则返回非0值；
函数失败则返回0值；
EnumWindowsProc 返回0值，同样导致函数EnumWindows
返回0值。另外，该函数不列举子窗口，除了几种拥有WS_CHILD 风格的系统所属窗口。MSDN：
The EnumWindows function does not enumerate child
windows,with the exception of a few top-level windows owned
by the system that have the WS_CHILD style. 使用举例：
先声明一个EnumWindowsProc ，比如：
BOOL CALLBACK EnumWindowsProc_1(HWND
hwnd,LPARAM lparam) ;
然后实现此函数，写入自己想做的事情，比如：
BOOL CALLBACK EnumWindowsProc_1(HWND
hwnd,LPARAM lparam)
{ char lpWinTitle[256];
::GetWindowText(hwnd,lpWinTitle,256-1);
CString m_strTitle;
m_("%s",lpWinTitle);
if(m_("Internet Explorer")!=-1)
{ AfxMessageBox("这是一个IE窗口！") ; }
return TRUE ;
}
然后就可以在其他地方调用EnumWindows的时候使用回调函数，比如：
::EnumWindows(EnumWindowsProc_1,0) ;
这样每当遇到IE窗口时，就会进行 提示“这是一个IE窗口！”
的操作。----资料转自[hairi的专栏/hairi/]方法二：不用互斥对象。 我们可以利用向系统添加全局原子的方法，来防止多个程序实例的运行。全局原子由Windows 系统负责维持，它能保证其中的每个原子都是唯一的，管理其引用计数，并且当该全局原子的引用计数为0时，从内存中清除。我们用GlobalAddAtom
函数向全局原子添加一个255个字节以内的字符串，用GlobalFindAtom来检查是否已经存在该全局原子，最后在程序结束时用GlobalDeleteAtom函数删除添加的全局原子。示例如下：
Uses Windows
const iAtom=‘SingleApp’;
begin
if GlobalFindAtom(iAtom)=0 then
begin
GlobalAddAtom(iAtom);
lize;
Form(TForm1,Form1);
;
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实现程序只运行一次并激活已打开的程序 内容由网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：http://www.freenas.com.cn/jishu/1702804864h431551.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论