delphi单开的实现标准pbjustone

admin

单开的实现标准pbjustone

该功能在terminal.exe pack_ctn.exe中实现 该部分在terminal.exe上有十多年的验证是可行的，无需再单独做功能测试！
以下内容放在dpr中！ 可能需要头windows, SysUtils,

version 1: 收录于2019-03-20

1. {$R *.res}
   
2. 
   
3. var
   
4.   MYHANDLE:Thandle;
   
5.   MyAppName, MyClassName: array[0..255] of Char;
   
6.   LastFound, MyPopup: HWND;
   
7. 
   
8.   function LookAtAllWindows(Handle: HWND; Temp: LongInt): BOOL; stdcall;
   
9.   var
   
10.     WindowName, ClassName: Array[0..255] of Char;
    
11.   begin
    
12.     if GetClassName(Handle, ClassName, SizeOf(ClassName)) > 0 then
    
13.       if StrComp(ClassName, MyClassName) = 0 then
    
14.         if GetWindowText(Handle, WindowName, SizeOf(WindowName)) > 0 then
    
15.           if StrComp(WindowName, MyAppName) = 0 then
    
16.           begin
    
17.               if Handle <> Application.Handle then
    
18.                  LastFound := Handle;
    
19.           end;
    
20.     IF LASTFOUND=0 THEN
    
21.         result := true
    
22.     ELSE
    
23.         RESULT :=FALSE;
    
24.   end;
    
25. 
    
26. begin
    
27.   LastFound := 0;
    
28.   GetWindowText(Application.Handle, MyAppName, SizeOf(MyAppName));
    
29.   GetClassName(Application.Handle, MyClassName, SizeOf(MyClassName));
    
30.   EnumWindows(@LookAtAllWindows, 0);
    
31.   if LastFound <> 0 then
    
32.   begin
    
33.       MyPopup := GetLastActivePopup(LastFound);
    
34.       BringWindowToTop(LastFound);
    
35.       if IsIconic(MyPopup) then
    
36.         ShowWindow(MyPopup, SW_RESTORE)
    
37.       else
    
38.         SetForegroundWindow(MyPopup);
    
39.       Halt;
    
40.   end ELSE
    
41.   begin
    
42.         //
    
43.      Application.Initialize;
    
44.          Application.CreateForm(TForm1, Form1);
    
45.          Application.CreateForm(Txx, XX);
    
46.      Application.Run;
    
47.         //
    
48.   end;
    
49. end.

复制代码

注意：如是用户将程序改一个名字，这种方法就卡不住了。如果要卡得更严一点，则用mutex来：

1. 加两个变量：
   
2.   hmutex : HWND;
   
3.   gt : Integer;
   
4. 
   
5.   begin
   
6.     hmutex:=CreateMutex(nil,True,'KB_TD@2008'); //注意改名
   
7.     gt := GetLastError;
   
8.     if gt = Error_ALREADY_EXISTS then {如果发现互斥体对象}
   
9.     begin
   
10.       Application.MessageBox('程序已经运行','提示',MB_OK);
    
11.       Application.Terminate;
    
12.       ReleaseMutex(hmutex);{释放互斥体}
    
13.       Halt;
    
14.     end;
    
15.     //
    
16.     Application.Initialize;
    
17.     Application.CreateForm(TForm1, Form1);
    
18.     Application.CreateForm(TDataModule2, DataModule2);
    
19.     //Form1.ScaleBy(200,100);
    
20.     Application.Run;
    
21.     //
    
22.     CloseHandle(hmutex);
    
23.     //CloseHandle(OpenMutex(MUTEX_ALL_ACCESS,True,'KB_TD@2008'));
    
24.   end;

复制代码