程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi實現程序只運行一次並激活已打開的程序

Delphi實現程序只運行一次並激活已打開的程序

編輯:Delphi
我們的程序有時候只允許運行一次,並且最好的情況是,如果程序第二次運行,就激活原來的程序。網上有很多的方法實現程序只運行一次,但對於激活原來的窗口卻都不怎麼好。

  關鍵就在於激活原來的程序,一般的做法是在工程開始時,打開互斥量對象,如果打不開表示程序還沒有運行,創建一個互斥量對象;如果打得開表示程序已經運行了,查找程序中一個特定的窗口,一般是主窗口,然後發送一個自定義消息,主窗口在這個消息處理中激活自己。我原來就是這麼做的,卻發現有很多問題。

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

  原來是用GetLastActivePopup這個API找到程序擁有的窗體中最近激活的窗體,然後再激活它。

  哈,我有了一個技術方案,首先我要在第二次運行的程序中找到第一次運行的程序的Application的Handle,然後調用SendMessage(APPHandle, WM_SYSCOMMAND, SC_RESTORE, 0),Application類有處理這個消息的,最終它會調用Application.Restore方法,讓自己變為顯示的狀態,即最大化或正常。接著,就執行上面方法中的代碼,讓第一次運行的程序激活。現在關鍵是怎麼找到第一次運行的Application的Handle,自然而然就想到了共享內存的技術,程序第一次運行時,先打開一個內存映射文件,如果打不開,則表示程序第一次運行,建一個內存映射文件對象,開辟一塊共享的內存,這塊內存保存Application的Handle。程序第二次運行,打開內存映射文件,可以打開了,得到一塊共享內存,並取得了第一次運行程序的Application的Handle,然後,用我上面說的方法,即可大功告成。


 花了一個小時的試驗,最終有了下面的代碼,結果非常成功:

unit wdRunOnce;

{*******************************************
* brIEf: 讓程序只運行一次
* autor: linzhenqun
* date: 2005-12-28
* email: [email protected]
* 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, 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, WM_SYSCOMMAND, SC_RESTORE, 0);
        TopWindow := GetLastActivePopup(PSMem^.AppHandle);
      if (TopWindow <> 0) and (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,並傳入Application的Handle,你的程序就可以只運行一次了,工程大概如下:

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.

  多新建一些窗口測試一下吧,不過要注意新建的窗口不能是自動創建的


  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved