请教一下:如何保证Delphi程序只能被执行一次(100分)

  • 主题发起人 主题发起人 zt0826
  • 开始时间 开始时间
Z

zt0826

Unregistered / Unconfirmed
GUEST, unregistred user!
由于我的程序是与别的东西用UDP包bind的,如果多次双击可执行文件,会发生bind不上
的错误,所以,有没有什么办法可以保证进程中只能执行一次该程序?
 
[转载,参考]
Windows95的程序一般都可以重复执行,例如你按下WIN+E组合键即启动资源管理器,如果再按WIN+E组合键又会出现一个资源管理器,这两个程序互不干扰。有时候你可以需要制作这样一个程序:当该程序已经执行时,若用户企图再次执行该程序则只会激活那个已执行的程序,而不是又出现一个副本。
  完成这个目的的核心就是要在程序启动时查找该程序是否已经运行,我曾试过很多种方法,包括向“全局元素表”(Global ATOM Table)写特定字符串等等,但最简单的方法还是下面这个:
在程序启动时将Application的Title特性字段的值暂时改变。
利用Windows API函数FindWindows()查找窗口
恢复Application的Title值
  上述步骤一般在主Form的OnCreate事件中实现,示例如下:
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;
 
检索以下ID的贴子:
ID:357133
ID:415602
ID:510052
ID:284268
 
以前的贴子上有很多了,
是用MUTEX的。
 
贴段代码给你,很简单的,要自己体会:
『窗体单元源码』
unit untSingle;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
const
CM_RESTORE = WM_USER + $1000;
{自定义的"恢复"消息}
MYAPPNAME = 'My Delphi Program';
type
TfrmSingle = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
procedure CreateParams(var Params: TCreateParams);
override;
//Initializes the window-creation parameter record when the form window is created.
Procedure RestoreRequest(var message: TMessage);
message CM_RESTORE;
end;

var
frmSingle: TfrmSingle;
implementation
{$R *.DFM}
procedure TfrmSingle.CreateParams(var Params: TCreateParams);
//指定窗口名称
begin
inherited CreateParams(Params);
Params.WinClassName := MYAPPNAME;
//Initializes the window-creation parameter record when the form window is created.
end;

procedure TfrmSingle.RestoreRequest(var message: TMessage);
//处理"恢复"消息
begin
if IsIconic(Application.Handle) = TRUE then
//窗口已图标化,恢复为正常大小.
Application.Restore
else
//窗口未图标化
Application.BringToFront;
end;

end.

『工程单元源码』
program prjSingle;
uses
Forms,Windows,Messages,
untSingle in 'untSingle.pas' {frmSingle};
{$R *.RES}
const
CM_RESTORE = WM_USER + $1000;
{自定义的"恢复"消息}
MYAPPNAME = 'My Delphi Program';
var
RvHandle : hWnd;

begin
RvHandle := FindWindow(MYAPPNAME, NIL);
if RvHandle > 0 then
begin
PostMessage(RvHandle, CM_RESTORE, 0, 0);
Exit;
end;
Application.Initialize;
Application.CreateForm(TfrmSingle, frmSingle);
Application.Run;
end.

 
to:2楼的你的代码不能控制程序执行时的闪烁!
一下代码我认为更为简单!
在projecet中写代码!
var myMutex:HWND;
begin
myMutex:=CreateMutex(nil,false,'form1');// CreateMutex建立互斥对象,并且给互斥对象起一个唯一的名字。
if WaitForSingleObject(myMutex,0)<>wait_TimeOut then
//程序没有被运行过
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end
end.

注意,要引用中加入Window!
 
可是因为程序要连接数据库,所以要等好半天界面才出来,会让用户以为程序没有执行。
所以,能不能在等待期间给用户一些提示。
 
这是一个比较简单的防止程序执行两次的方法
implementation
var hnd: THandle;
initialization
hnd := CreateMutex(nil, True, 'irgendwaseinmaliges');
if GetLastError = ERROR_ALREADY_EXISTS then
Halt;
finalization
if hnd <> 0 then
CloseHandle(hnd);
end.
 
program rsgl;
uses
sharemem,
windows,
Forms,
main in 'main.pas' {form_Main},
set_User in 'set_User.pas' {Form_Set_User},
input in 'input.pas' {Form_input},
about in 'about.pas' {Form_About},
_dll_api_global2 in '../../../dll And 共享文件/_dll_api_global2.pas',
help in 'help.pas' {Form_Help},
account in 'account.pas' {Form_account},
account_modify in 'account_modify.pas' {Form_accountModify},
account_operate in 'account_operate.pas' {Form_accountOperate},
show_email in 'show_email.pas' {Form_ShowEmail},
Accounts_Set in 'Accounts_Set.pas' {Form_Accounts},
earning in 'earning.pas' {Form_earning},
Cl_PayOut in 'Cl_PayOut.pas' {Form_ClPayOut},
Cl_Earning in 'Cl_Earning.pas' {Form_ClEarning},
borrow in 'borrow.pas' {Form_Borrow},
CL_Borrow in 'CL_Borrow.pas' {Form_ClBorrow},
Type_Set in 'Type_Set.pas' {Form_Type},
Check in 'Check.pas' {Form_Check},
log in 'log.pas' {Form_log},
tl in 'tl.pas' {Form_tl},
DBGridPrint in '../../../dll And 共享文件/DBGridPrint.pas',
keep_take in 'keep_take.pas' {Form_keeptake},
bdwl in 'bdwl.pas' {Form_bdwl};
var
Rvhandle:Hwnd;
{$R *.res}
begin
RvHandle := FindWindow(nil,'人事管理');
if RvHandle > 0 then
begin
// application.MessageBox('本程序已经运行!','提示信息',MB_OK or MB_ICONINFORMATION);
if IsIconic(Rvhandle) = TRUE then
begin
showwindow(Rvhandle,1);
end
else
begin
SetForegroundWindow(RvHandle);
end;
{endif}
Exit;
end;

Application.Initialize;
Application.Title := '人事管理';
Application.CreateForm(Tform_Main, form_Main);
Application.CreateForm(TForm_Help, Form_Help);
Application.CreateForm(TForm_Type, Form_Type);
Application.CreateForm(TForm_Check, Form_Check);
Application.CreateForm(TForm_log, Form_log);
Application.CreateForm(TForm_tl, Form_tl);
Application.CreateForm(TForm_keeptake, Form_keeptake);
Application.CreateForm(TForm_bdwl, Form_bdwl);
Application.Run;
 
program Project1;
uses
Forms,
controls,
messages,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
var
hwnd:THandle;
begin
hwnd:=findwindow('tform1',nil);
if hwnd=0 then
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end
else
begin
if not IsWindowVisible(hwnd) then
PostMessage(hwnd,wm_app,0,0);
setforegroundwindow(hwnd) ;
end;
end.

delphi7 下通过,在delphi7下运行时会发现并未运行,但你会发现在你保存的文件夹下已生成了可执行文件.关闭delphi后,双击生成的exe,即可看到你所要的效果.
 
我也参和参和
function LookAtAllWindows(Handle: HWND;
Temp: LongInt): BOOL;
stdcall;
var
WindowName, ClassName: Array[0..255] of Char;
begin
if (GetClassName(Handle, ClassName, SizeOf(ClassName)) > 0) and
(StrComp(ClassName, MyClassName) = 0) and
(GetWindowText(Handle, WindowName, SizeOf(WindowName)) > 0) and
(StrComp(WindowName, MyAppName) = 0) then
begin
Inc(NumFound);
if Handle <> Application.Handle then
LastFound := Handle;
end;
Result:= True;
end;
//检查程序是否已启动,若已启动则不再启动第二份程序,而是将已打开的程序弹出
function CheckInstance:boolean;
begin
Result:=false;
NumFound := 0;
LastFound := 0;
GetWindowText(Application.Handle, MyAppName, SizeOf(MyAppName));
GetClassName(Application.Handle, MyClassName, SizeOf(MyClassName));
EnumWindows(@LookAtAllWindows, 0);
if NumFound> 1 then
begin
MyPopup := GetLastActivePopup(LastFound);
BringWindowToTop(LastFound);
if IsIconic(MyPopup)
then
ShowWindow(MyPopup, SW_RESTORE)
else
SetForegroundWindow(MyPopup);
Application.Terminate;
Result:=true;
end
end;

使用时:
在工程单元里:
Application.Initialize;
if not CheckInstance then
begin
Application.CreateForm(TDM, DM);
Application.CreateForm(TmainForm, mainForm);
end;
 
var
hMutex : Thandle;
WaitResult : word;
BroadcastList : DWORD;
begin
MessageID := RegisterWindowMessage('Check For Choice Previous Inst');
// register a message to use later on
hMutex := createMutex(nil,false,pchar('App_Choice'));
// grab a mutex
handle
WaitResult := WaitForSingleObject(hMutex,10);
// wait to see
if we can have exclusive use of the mutex
if ( waitResult = WAIT_TIMEOUT ) then
// if we can't then
broadcast
the message to make the owner of the mutex respond
{ request that the running application takes focus }
begin
BroadcastList := BSM_APPLICATIONS;
BroadcastSystemMessage(
BSF_POSTMESSAGE,@BroadcastList,MessageID,0,0);
//32 bit - broadcast the
message to all apps - only a prev inst will hear it.
end
else
begin
{do
the normal stuff}
Application.Title := 'Choice Organics Purchase &amp;
Sales System';
Application.CreateForm(TMainForm, MainForm);
Application.Run;
ReleaseMutex(hMutex);
// release the mutex as a politeness
end;
CloseHandle(hMutex);
// close the mutex handle
end.

This goes in the MainForm
procedure Tmainform.OnAppMessage(var Msg : TMsg ;
Var Handled : Boolean);
begin
{ If it's the special message then
focus on this window}
if Msg.Message = MessageID then
// if we get the broadcast message from an
another instance of this app that is trying to start up
begin
show;
WindowState := wsMaximized;
BringToFront;
SetFocus;
Handled := true;
end;
end;

//And this goes in the TMainForm.FormCreate ;-
Application.OnMessage:= OnAppMessage;
 
该揭帖了吧!
 
使用 互斥对象 和 全局原子 的富翁请注意
如果你的进程被异常终止,不重新启动windows系统,你的程序将不能再次运行!
如果你用的是XP,请不要用XP的任务管理器来终止你自己的进程来进行测试!
win2K和98的可以用任务管理器来终止你自己的进程来进行测试
 
后退
顶部