怎样让程序只运行一次?(50分)

  • 主题发起人 主题发起人 wdsu
  • 开始时间 开始时间
W

wdsu

Unregistered / Unconfirmed
GUEST, unregistred user!
var Hwnd:THandle;

begin
Hwnd:=FindWindow ('Tfm_mainxt','fm_mainxt');
if Hwnd=0 then
begin
Application.Initialize;
try
fm_flash:=Tfm_flash.Create(Application);
fm_flash.Show;
fm_flash.Update;
// fm_login:=Tfm_login.create(Application);
// fm_login.show;
// fm_login.update;
// while fm_login.Active do
// Application.ProcessMessages;
// fm_login.Close;
// fm_login.Free;
Application.Title := '轧料数据管理系统';
Application.CreateForm(TDataModule2, DataModule2);
Application.CreateForm(Tfm_mainxt, fm_mainxt);
Application.CreateForm(Tfm_ordrpt, fm_ordrpt);
Application.CreateForm(TAboutBox, AboutBox);
finally
fm_flash.Hide;
fm_flash.Free;
end;
Application.Run;
end
else
begin
MessageDlg ('你已经运行了本程序的一个拷贝!',mtInformation, [mbOk], 0);

end;

但程序没用,照样可以运行无数个,不知那里出错了,希望高手指点迷津,谢谢!
 
Application.Title := '【收银系统4.0版】';
Application.Initialize;

OnlyRunOnce := CreateMutex(nil, True, '【收银系统4.0版】');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
LoadForm.Free;
Application.MessageBox('本程序已经运行了,不能再次运行!','提示信息',Mb_OK+MB_ICONINFORMATION);

Halt;
end;
 
begin
MessageDlg ('你已经运行了本程序的一个拷贝!',mtInformation, [mbOk], 0);
Application.Termainal;

end;

 
在dpr文件中加入如下代码

var
MutexHandle: Thandle;


begin
Mutexhandle := windows.CreateMutex(nil, true, '通讯服务');
if Mutexhandle <> 0 then
begin
if getlasterror = windows.ERROR_ALREADY_EXISTS then
begin
Application.MessageBox('本程序已有运行实例!', '启动提示!', 48);
closehandle(Mutexhandle);
halt;
end;
end;
 
Hwnd:=FindWindow (pchar('Tfm_mainxt'),pchar('fm_mainxt'));
 
把 Hwnd:=FindWindow ('Tfm_mainxt','fm_mainxt');
改为 Hwnd:=FindWindow ('Tfm_mainxt',nil);

 
to xminsong:
你好,我用你的方法试了以下,解决了,谢谢
to :lotusleaf:
不能运行,谢谢,pchar()是什么意思.
to sungirl112
一个都不能运行.不知你的程序是什么意思,能说说吗
 
A PChar is a pointer to a null-terminated string of 8-bit characters.
只能运行一个,delphi的工程也算
 
上面给你介绍了两种方法,一、通过互斥量或者事件对象。二、通过应用程序名在windows系统
内注册,而你又可通过应用程序查 的方法。
 
Hwnd:=FindWindow ('Tfm_mainxt','fm_mainxt');应该是查找窗体的句柄
不同的窗体的句柄都是不一样的,你当然不能控制只运行一个了.
给你另外一个方法,可以用
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
hnd:Integer;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('helloworld');
end;
//以下的代码是关键,注意上面声明了一个hnd变量
initialization
hnd := CreateMutex(nil, True, '你的字符串');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
ShowMessage('此程序已经运行!');
Halt;
end;

finalization
if hnd <> 0 then CloseHandle(hnd);

end.
 
同意 sungirl1126
 
后退
顶部