如何防止一个程序执行两次这是一个比较简单的防止程序执行两次的方法 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.
var f:HWND; begin f := FindWindow('TForm1','Form1'); if f <> 0 then begin ShowWindow(f,SW_SHOWNORMAL); SetForegroundWindow(f); exit; end; 加在program里就可以了
可是每次运行时都是f=0 啊?我的程序是这样的:var h:HWND; begin h:=FindWindow('Tsend_card','send_card'); if h=0 then begin send_card:=Tsend_card.Create(nil); send_card.show; end;
用互斥的方法 就像 debussy(debussy) 所说的 在工程文件中加入 begin CreateMutex(nil, False, 'MyPrograme'); //MyPrograme 为一个标识,当运行程序时 //就会在系统中保存此标识,所以最好设置成独一无二的字符串 if GetLastError = ERROR_ALREADY_EXISTS then begin MessageBeep(0); ShowMessage('应用程序已经运行,不能加载!'); Exit; end; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end;
试试这个: procedure TForm1.FormCreate(Sender: TObject); var pc:pchar; strtile:string; isfound:hwnd; begin getmem(pc,255); strtile:=Applicaton.Title; application.title:='one time'; strpcopy(pc,strtitle); isfound:=findwindow(nil,pc); Application.Title:=strtitle; if isfound=0 then //if isfound=0 the program was not running; begin showwindow(isfound,SW_RESTORE); application.Terminate; end; freemem(pc); end;
//MDI的,参考一下 if not Assigned(Fm_TB_Xsqk_XsdbN) then begin Application.CreateForm(TFm_TB_Xsqk_XsdbN, Fm_TB_Xsqk_XsdbN); end else begin Fm_TB_Xsqk_XsdbN.Show; Fm_TB_Xsqk_XsdbN.WindowState:=wsNormal; Fm_TB_Xsqk_XsdbN.BringToFront; end;procedure TFm_TB_Xsqk_XsdbN.FormClose(Sender: TObject; var Action: TCloseAction); begin Action:=caFree; Fm_TB_Xsqk_XsdbN:=nil; end;
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.
f:HWND;
begin
f := FindWindow('TForm1','Form1');
if f <> 0 then
begin
ShowWindow(f,SW_SHOWNORMAL);
SetForegroundWindow(f);
exit;
end; 加在program里就可以了
begin
h:=FindWindow('Tsend_card','send_card');
if h=0 then
begin
send_card:=Tsend_card.Create(nil);
send_card.show;
end;
就像 debussy(debussy) 所说的
在工程文件中加入
begin
CreateMutex(nil, False, 'MyPrograme'); //MyPrograme 为一个标识,当运行程序时
//就会在系统中保存此标识,所以最好设置成独一无二的字符串
if GetLastError = ERROR_ALREADY_EXISTS then
begin
MessageBeep(0);
ShowMessage('应用程序已经运行,不能加载!');
Exit;
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
pc:pchar;
strtile:string;
isfound:hwnd;
begin
getmem(pc,255);
strtile:=Applicaton.Title;
application.title:='one time';
strpcopy(pc,strtitle);
isfound:=findwindow(nil,pc);
Application.Title:=strtitle;
if isfound=0 then //if isfound=0 the program was not running;
begin
showwindow(isfound,SW_RESTORE);
application.Terminate;
end;
freemem(pc);
end;
if not Assigned(Fm_TB_Xsqk_XsdbN) then begin
Application.CreateForm(TFm_TB_Xsqk_XsdbN, Fm_TB_Xsqk_XsdbN);
end else begin
Fm_TB_Xsqk_XsdbN.Show;
Fm_TB_Xsqk_XsdbN.WindowState:=wsNormal;
Fm_TB_Xsqk_XsdbN.BringToFront;
end;procedure TFm_TB_Xsqk_XsdbN.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
Fm_TB_Xsqk_XsdbN:=nil;
end;