深圳全飞鸿

标题: delphi单开的实现标准pbjustone [打印本页]
作者: admin    时间: 2019-6-1 16:38
标题: delphi单开的实现标准pbjustone
单开的实现标准pbjustone

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

version 1: 收录于2019-03-20

  1. {$R *.res}

  3. var
  4.   MYHANDLE:Thandle;
  5.   MyAppName, MyClassName: array[0..255] of Char;
  6.   LastFound, MyPopup: HWND;

  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;

  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;

  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;
复制代码






欢迎光临 深圳全飞鸿 (http://www.nagomes.com/disc/) Powered by Discuz! X3.2