Delphi程序实现单实例运行

分类：Delphi, System 阅读 (3,155) Add comments

7月 092014

转载请注明原文地址：http://bcoder.com/delphi/implement-single-process-instance-for-delphi-application

　　对于一些非多文档类的程序，我们只想让用户打开一个程序的实例，当用户再次点击图标的时候只需将原来运行的程序界面打开即可。那么如何实现这种功能呢？首先，要实现进程的单实例运行，我们可以用互斥对象实现，互斥对象即在系统层上只能创建一个这样标识的对象，当第二个此标识的互斥对象创建时将会返回一个已存在的标志。

　　单实例运行实现后，我们还要通过消息实现打开前面已经打开的窗口，我们可以用EnumWindows函数来遍例所有窗口以找到已打开窗口的句柄，并通过ShowWindow函数或者自定义消息来激活那个窗口。具体的代码如下：

program SingleProc;

uses
  Forms,
  TlHelp32,
  Windows,
  SysUtils,
  uFmSingleProc in 'uFmSingleProc.pas' {FmSingleProc};

{$R *.res}

var
  HMutex: Hwnd;
  Ret: Integer;
  I: integer;

// 根据进程ID获取进程名称
function GetProcessNameById(const AID: Integer): String;
var
  h:thandle;
  f:boolean;
  lppe:tprocessentry32;
begin
  Result := '';
  h := CreateToolhelp32Snapshot(TH32cs_SnapProcess, 0);
  lppe.dwSize := sizeof(lppe);
  f := Process32First(h, lppe);
  while integer(f) <> 0 do
  begin
    if Integer(lppe.th32ProcessID) = AID then
    begin
      Result:= StrPas(lppe.szExeFile);
      break;
    end;
    f := Process32Next(h, lppe);
  end;
end;

function EnumWindowsOpen1stApp(hwnd: HWND; lParam: LPARAM): Boolean ;stdcall;
var
  WindowText   : string  ;       // 窗体标题
  procId: Cardinal;
  wText: array[0..255] of char;
begin
  // 获取进程ID
  GetWindowThreadProcessId(HWND, procId);

  if GetProcessNameById(procId) = ExtractFileName(Application.ExeName) then begin
    GetWindowText(HWND, @wText, 255);
    if wText = 'Form Title' then begin
      //ShowWindow有的时候会导致其他的问题，如果ShowWindow有问题可以用下面的发送消息的方法解决
      //ShowWindow(hwnd, SW_SHOW);

      //通过发送消息方式来激活前面的窗口
      SendMessage(hwnd, WM_SHOWTHEFORM, 0, 0);
    end;
  end;
  Result := True;
end;

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  hMutex := CreateMutex(nil, False, PChar('SingleProcTest'));
  Ret := GetLastError ;
  if Ret <> ERROR_ALREADY_EXISTS Then
  begin
    Application.CreateForm(TFmSingleProc, FmSingleProc);
  end else begin
    // 互斥对象已存在，则遍历查找已打开的程序
    EnumWindows(@EnumWindowsOpen1stApp, 0);
    ReleaseMutex(hMutex);
  end;
  Application.Run;
end.

program SingleProc;

uses

Forms,

TlHelp32,

Windows,

SysUtils,

uFmSingleProc in 'uFmSingleProc.pas' {FmSingleProc};

{$R *.res}

var

HMutex: Hwnd;

Ret: Integer;

I: integer;

// 根据进程ID获取进程名称

function GetProcessNameById(const AID: Integer): String;

var

h:thandle;

f:boolean;

lppe:tprocessentry32;

begin

Result := '';

h := CreateToolhelp32Snapshot(TH32cs_SnapProcess, 0);

lppe.dwSize := sizeof(lppe);

f := Process32First(h, lppe);

while integer(f) <> 0 do

begin

if Integer(lppe.th32ProcessID) = AID then

begin

Result:= StrPas(lppe.szExeFile);

break;

end;

f := Process32Next(h, lppe);

end;

function EnumWindowsOpen1stApp(hwnd: HWND; lParam: LPARAM): Boolean ;stdcall;

var

WindowText : string ; // 窗体标题

procId: Cardinal;

wText: array[0..255] of char;

begin

// 获取进程ID

GetWindowThreadProcessId(HWND, procId);

if GetProcessNameById(procId) = ExtractFileName(Application.ExeName) then begin

GetWindowText(HWND, @wText, 255);

if wText = 'Form Title' then begin

//ShowWindow有的时候会导致其他的问题，如果ShowWindow有问题可以用下面的发送消息的方法解决

//ShowWindow(hwnd, SW_SHOW);

//通过发送消息方式来激活前面的窗口

SendMessage(hwnd, WM_SHOWTHEFORM, 0, 0);

end;

Result := True;

end;

begin

Application.Initialize;

Application.MainFormOnTaskbar := True;

hMutex := CreateMutex(nil, False, PChar('SingleProcTest'));

Ret := GetLastError ;

if Ret <> ERROR_ALREADY_EXISTS Then

begin

Application.CreateForm(TFmSingleProc, FmSingleProc);

end else begin

// 互斥对象已存在，则遍历查找已打开的程序

EnumWindows(@EnumWindowsOpen1stApp, 0);

ReleaseMutex(hMutex);

end;

Application.Run;

end.

unit uFmSingleProc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

const
  WM_SHOWTHEFORM = WM_USER + 1;

type
  TFmSingleProc = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    // 如果通过ShowWindow函数显示窗口，则不用此消息
    procedure WMShowTheForm(Var msg: TMessage); message WM_SHOWTHEFORM;
  end;

var
  FmSingleProc: TFmSingleProc;

implementation

{$R *.dfm}

{ TFmSingleProc }

procedure TFmSingleProc.FormCreate(Sender: TObject);
begin
  Self.Caption := 'Form Title';
end;

procedure TFmSingleProc.WMShowTheForm(var msg: TMessage);
begin
  Self.WindowState := wsNormal ;
  Self.Show;
  Self.BringToFront ;
end;

end.

unit uFmSingleProc;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

const

WM_SHOWTHEFORM = WM_USER + 1;

type

TFmSingleProc = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

// 如果通过ShowWindow函数显示窗口，则不用此消息

procedure WMShowTheForm(Var msg: TMessage); message WM_SHOWTHEFORM;

end;

var

FmSingleProc: TFmSingleProc;

implementation

{$R *.dfm}

{ TFmSingleProc }

procedure TFmSingleProc.FormCreate(Sender: TObject);

begin

Self.Caption := 'Form Title';

end;

procedure TFmSingleProc.WMShowTheForm(var msg: TMessage);

begin

Self.WindowState := wsNormal ;

Self.Show;

Self.BringToFront ;

end;

end.

打赏

Leave a Reply Cancel reply