如何不让程序启动两次

Question

可能方法很多，在这里请教各位大侠的方法是什末？谢谢。

Answer 1

在*.DPR中加上这样一段：
  CreateMutex(nil, True, 'Pro');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    MessageBox(0, '程序已经在运行中......', '提醒' ,MB_ICONINFORMATION);
    Halt;
  end;
  Application.Initialize;
  ……

Answer 2

使用互斥！！！var
  Mutex: THandle;
begin
  Mutex := CreateMutex(nil, True, 'TradeGate');
  if GetLastError <> ERROR_ALREADY_EXISTS then
  begin
    Application.Initialize;
    Application.Title := 'TradeGate';
    Application.CreateForm(TFrmMain, FrmMain);
    Application.CreateForm(TFormWriteOff, FormWriteOff);
    Application.Run;
    ReleaseMutex(Mutex);
  end;
  CloseHandle(Mutex);
end.

Answer 3

下面这段代码就可以
procedure TForm1.FormCreate(Sender: TObject);
var
  zappname:array[0..127] of char;
  hold:string;
  found:hwnd;
begin
  hold:=application.Title;
  application.Title:='test';
  strpcopy(zappname,hold);
  found:=findwindow(nil,zappname);
  application.Title:=hold;
  if found<>0 then
  begin
    showwindow(found,sw_restore);
    application.Terminate;
  end;
end;

Answer 4

program Project1;uses
  WinTypes,
  WinProcs,
  Messages,
  Classes,
  Graphics,
  Controls,
  Dialogs,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};{$R *.res}
function kk:boolean;
var h1,h2:hwnd;
const
 a1:array[0..12] of char ='TApplication'#0;
 t1:array[0..9] of char ='Project1'#0;
 A2:array[0..6] of char ='TForm1'#0;
 t2:array[0..5] of char ='Form1'#0;
begin
 H1:=FindWindow(A1, T1);
 H2:=FindWindow(A2, T2);
// h2:=FindWindow(nil,'project1');  Result:=(H1 <> 0)and (H2<>0);
end;begin
  if kk then 
  begin 
    MessageDlg('该程序已经在内存中,你不必再运行!',mtInformation,[mbOk],0);
    Halt;
  end;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
ok了~~