如何使delphi编译的可执行文件不能重复打开?(20分)

  • 主题发起人 主题发起人 joann
  • 开始时间 开始时间
J

joann

Unregistered / Unconfirmed
GUEST, unregistred user!
如何使delphi编译的可执行文件不能重复打开?
 
到网上随便搜索一下,太多了
 
防止多次载入应用程序实例
  某些应用程序需要禁止用户载入多次实例。比如,控制面板中的应用程序,不管用户打开多少次,同一应用程序只有一个实例,而且每一次试图重复打开都会自动激活已经存在的实例。

  Windows API 提供了函数FindWindow,可以是应用程序在启动时检查自己是否已经存在。

  该函数在Delphi中的语法是:

  function FindWindow(lpClassName: PChar, lpWindowName: PChar): HWND;

  其中,参数lpCalssName 是要查找的窗口的类的名称,参数lpWindowName是要查找的窗口的标题(Caption)。 如果找到了相应的窗口实例,将返回一个非0 的该窗口句柄的整型值,否则返回0 。因此,只要判断应用程序的主窗口(或者伴随着应用程序存在而存在的窗口)是否存在就可以判断是否已经有实例存在了。

  例如:

  H := FindWindow('TForm1', nil);

  if H = 0 then begin

   ShowMessage('没有发现相同的应用程序实例。');

   //加入加载应用程序的语句

   //...

  end else begin

   ShowMessage('应用程序已经加载。');

   SetActiveWindow(H);

  end;

  其中,参数lpWindowName的位置以Delphi保留字nil 代替,是因为窗口的标题可能在应用程序中是变化的。Windows API 函数SetActiveWindow 用于指定活动窗口。
 
用CreateMutex
 
对用互斥向量的办法比较好,CreateMutex(...)可以创建互斥向量
 
在程序启动时将Application的Title特性字段的值暂时改变。

利用Windows API函数FindWindows()查找窗口
恢复Application的Title值

procedure TForm1.FormCreate(Sender: TObject);
var
ZAppName : array[0..127] of char;
Hold : string;
Found : HWND;
begin
Hold := Application.Title;
Application.Title := 'OnlyOne' + IntToStr(HInstance); // 暂时修改窗口标题
StrPCopy(ZAppName, Hold); // 原窗口标题
Found := FindWindow(nil, ZAppName); // 查找窗口
Application.Title := Hold; // 恢复窗口标题
if Found <> 0 then begin // 若找到则激活已运行的程序并结束自身
ShowWindow(Found, SW_RESTORE);
Application.Terminate;
end;

end;
 
program Project1;

uses
Forms,windows,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}
begin
Application.Initialize;
createmutex(nil,false,'project1');
if GetLastError =ERROR_ALREADY_EXISTS then
application.Terminate ;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
 
先在你的*.dpr中加入:
var
RvHandle: hWnd;
begin
RvHandle := FindWindow(MyAppName, nil);//在主Form单元中声明=你的程序名
if RvHandle > 0 then
begin
PostMessage(RvHandle, CM_RESTORE, 0, 0);
Exit;
end;
在主Form中:
const

CM_RESTORE = WM_USER + $1000;
MyAppName = '你的程序名';
type
TForm1 = class(TForm)
private
{ Private declarations }
public
procedure CreateParams(var Params: TCreateParams); override;
procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
{ Public declarations }
end;

var
Form1:Tform1;
implementation

{$R *.DFM}
procedure Tform1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WinClassName := MYAPPNAME;
end;

procedure TForm1.RestoreRequest(var message: TMessage);
begin
Visible := True;
if IsIconic(Application.Handle) = TRUE then Application.Restore else Application.BringToFront;
end;

ok
 
接受答案了.
 
后退
顶部