只能一次打开程序问题(100分)

R

ranxg

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #1

我有一个程序,需要经常打开.有时就会出现打开两次的讨厌情况.
现在我加了"只能一次打开程序"代码,又出现新问题.有时该程序异常退出,就再也无法打开了,只能重新开机才能重新载入,耽误了事情,请教如何解决!!

 

K

kirinma

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #2

在工程文件里面添加如下代码，（这是我用的例子，你改一下就可以）
program Server;
……
{$R *.res}
const classname='TFrm_Server'; {声明为主窗体的类名}
var
handle:integer;

begin
{-----------------判断部分---------------------- }
handle:=findwindow(classname,nil);//查找是否有此类的窗体
if handle<>0 then //不为0则程序已运行
begin
messagebox(0,'该程序已经有一个在运行中！','运行',0);//提示程序已运行
halt; //退出程序
end;

Application.Initialize;
Application.CreateForm(TFrm_Server, Frm_Server);
//
//Application.ShowMainForm:=false;//*****
//Application.OnMinimize:=Frm_Server.AppMinimize;//******
//
Application.Run;

 

Y

ysai

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #3

http://www.delphibbs.com/keylife/iblog_show.asp?xid=604
在任务管理器中直接杀死进程,没有出现不能再次打开的情况

 

L

liuying1129

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #4

在程序中加如下代码，一切搞定：
var
hnd:integer;

initialization
hnd := CreateMutex(nil, True, '控制系统');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
MessageDlg('该程序已在运行中！',mtWarning, [mbOK], 0);
Halt;
end;

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

 

T

takashiki

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #5

同意楼上，只能运行一次，一般是使用互斥量

 

T

twos

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #6

使用互斥量
看这个叶面，http://jinesc.6600.org/myweb/disp.asp?idd=22&room=30

 

吉

吉祥鸟

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #7

hHandle := FindWindow(APPNAME, nil)
if (hHandle > 0) then
begin
PostMessage(hHandle, CM_RESTORE, 0, 0);
Exit;
end;

 

7

7syw

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #8

看如下代码 对你有所帮助

program HttpRecSend;

uses
windows,
Forms,
RecSendU in 'RecSendU.pas' {HttpRecSendF},
ThrdU in 'ThrdU.pas';

{$R *.res}

begin
Application.Initialize;

MessageID := RegisterWindowMessage('HttpRecSendMessage');
MutexRun := OpenMutex(MUTEX_ALL_ACCESS, false, Pchar('RunHttpRecSnd'));
if MutexRun = 0 then
begin
CreateMutex(nil, false, Pchar('RunHttpRecSnd'));
Application.CreateForm(THttpRecSendF, HttpRecSendF);
Application.Run;
end
else
begin
CloseHandle(MutexRun);
PostMessage(HWND_BROADCAST, MessageID, 0, 0);
end;
end.

unit RecSendU;

interface

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

type
THttpRecSendF = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
HttpRecSendF: THttpRecSendF;
MutexRun: THandle = 0; //同时只允许运行一个实例;

implementation

{$R *.dfm}

end.

 

L

lichaogang

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #9

这类问题回答过很多次的，建议在提问之前先找一下类似的帖子。

 

A

app2001

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-05

• #10

const
CM_RESTORE = WM_USER + $1000; {自定义的“恢复”消息}
MYAPPNAME ='MW_MerryLandSell_app';
var
RvHandle : hWnd;
begin
RvHandle := FindWindow(MYAPPNAME, NIL); //防止同一程序执行两次
if RvHandle > 0 then
begin
PostMessage(RvHandle, CM_RESTORE, 0, 0);
Exit;
end;
end

 

Z

zLight

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-18

• #11

这个问题，找个 《Delphi葵花宝典》，有很多……

 

3

3cs

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-09-18

• #12

程序只能打开一次的方法很多，楼上的这些思路都行，我只是觉得你的程序一定有问题，否则不可能产生异常！还是先找出异常的原因，再说吧！最好是贴出代码，大家都可以帮你找找！

 

W

w128

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2003-11-15

• #13

// 自身不能重复运行
procedure TUserLogin.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
messagedlg('程序控制，不能同时运行本身。',mtinformation,[mbok]);
// 若找到则激活已运行的程序并结束自身
ShowWindow(Found, SW_RESTORE);
Application.Terminate;
End;
end;

 

暴

暴雪无痕

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2004-04-21

• #14

formcreata那加入以下代码
var
foundwin:HWND;
begin
forndwin:=findwindows(nil,'系统的标题');
if foundwin <> 0 then
begin //调用DELPHI自带的查询窗口函数，查找特定标题的窗体
showwindows(foundwin,sw_restore);//若找到，则激活已运行的程序，同时结束自身
half;
end;
end;

 

B

bfox

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2004-04-21

• #15

估计用互斥量就会出现你说的问题

 

A

anyway

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2004-04-22

• #16

把代码放在
TRY
FINALLY
之间试试