怎样避免应用程序重复执行？

Question

大家好，我发现了一个问题，当执行了Delphi生成的EXE文件后，再点击该EXE文件，会再次弹出执行界面，请问怎样避免？非常感谢。

Answer 1

方法一：利用API函数FindWindow
修改项目文件，代码如下：
program Project1;uses
  windows,
  dialogs,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};{$R *.res}
var
handle:thandle;
begin
  handle:=findwindow('tform1','form1');
  if handle=0 then
    begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
    end
  else
  messagedlg('你不能运行该程序的多个实例！',mtinformation,[mbok],0);
  setforegroundwindow(handle);  
end.

Answer 2

方法二：利用互斥对象
修改项目文件，代码如下：
program Project1;uses
  Forms,windows,
  Unit1 in 'Unit1.pas' {Form1};{$R *.res}begin
  if isnextinstance then
  activefirstinstancewindow
  else
    begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    setprop(application.MainForm.Handle,windowname,1);
    Application.Run;
    end;
end.修改单元文件，代码如下：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;const
uniquekey:pchar='key';
windowname:pchar='singleinstance';type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;function isnextinstance:boolean;
procedure activefirstinstancewindow;var
  Form1: TForm1;implementation{$R *.dfm}var
mutexhandle:thandle;
function isnextinstance:boolean;
begin
  result:=false;
  mutexhandle:=createmutex(nil,true,uniquekey);
  if mutexhandle<>0 then
    if getlasterror=error_already_exists then
    begin
    result:=true;
    closehandle(mutexhandle);
    end;
end;procedure activefirstinstancewindow;
var
hprev:hwnd;
begin
hprev:=getwindow(getdesktopwindow,gw_child);
while hprev<>null do
  begin
  if getprop(hprev,windowname)<>0 then
    begin
    if isiconic(hprev) then
    showwindow(hprev,sw_restore);
    setforegroundwindow(hprev);
    setforegroundwindow(getlastactivepopup(hprev));
    halt;
    end;
  hprev:=getwindow(hprev,gw_hwndnext);
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
beginend;end.

Answer 3

去看delphi5开发人员指南
把下面的程序加入到你的程序里就行了
unit MultInst;interfaceconst
  MI_QUERYWINDOWHANDLE   = 1;
  MI_RESPONDWINDOWHANDLE = 2;  MI_ERROR_NONE          = 0;
  MI_ERROR_FAILSUBCLASS  = 1;
  MI_ERROR_CREATINGMUTEX = 2;// Call this function to determine if error occurred in startup.
// Value will be one or more of the MI_ERROR_* error flags.
function GetMIError: Integer;implementationuses Forms, Windows, SysUtils;const
  UniqueAppStr = 'DDG.I_am_the_Eggman!';var
  MessageId: Integer;
  WProc: TFNWndProc;
  MutHandle: THandle;
  MIError: Integer;function GetMIError: Integer;
begin
  Result := MIError;
end;function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
  Longint; stdcall;
begin
  Result := 0;
  // If this is the registered message...
  if Msg = MessageID then
  begin
    case wParam of
      MI_QUERYWINDOWHANDLE:
        // A new instance is asking for main window handle in order
        // to focus the main window, so normalize app and send back
        // message with main window handle.
        begin
          if IsIconic(Application.Handle) then
          begin
            Application.MainForm.WindowState := wsNormal;
            Application.Restore;
          end;
          PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
            Application.MainForm.Handle);
        end;
      MI_RESPONDWINDOWHANDLE:
        // The running instance has returned its main window handle,
        // so we need to focus it and go away.
        begin
          SetForegroundWindow(HWND(lParam));
          Application.Terminate;
        end;
    end;
  end
  // Otherwise, pass message on to old window proc
  else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;procedure SubClassApplication;
begin
  // We subclass Application window procedure so that
  // Application.OnMessage remains available for user.
  WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
    Longint(@NewWndProc)));
  // Set appropriate error flag if error condition occurred
  if WProc = nil then
    MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;procedure DoFirstInstance;
// This is called only for the first instance of the application
begin
  // Create the mutex with the (hopefully) unique string
  MutHandle := CreateMutex(nil, False, UniqueAppStr);
  if MutHandle = 0 then
    MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;procedure BroadcastFocusMessage;
// This is called when there is already an instance running.
var
  BSMRecipients: DWORD;
begin
  // Prevent main form from flashing
  Application.ShowMainForm := False;
  // Post message to try to establish a dialogue with previous instance
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
    @BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE,
    Application.Handle);
end;procedure InitInstance;
begin
  SubClassApplication;   // hook application message loop
  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
  if MutHandle = 0 then
    // Mutex object has not yet been created, meaning that no previous
    // instance has been created.
    DoFirstInstance
  else
    BroadcastFocusMessage;
end;initialization
  MessageID := RegisterWindowMessage(UniqueAppStr);
  InitInstance;
finalization
  // Restore old application window procedure
  if WProc <> Nil then
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
  if MutHandle <> 0 then CloseHandle(MutHandle);  // Free mutex
end.

Answer 4

一.在你的工程文件中这样做
const
  CM_RESTORE = WM_USER + $1000;
var
  Handle : hwnd;
begin
  handle:=FindWindow('Main_Program!',nil);
  if handle <> 0 then
    begin
      PostMessage(Handle, CM_RESTORE, 0, 0);
      Exit;
    end;
  Application.Initialize;
//以下是你的程序创建窗口的代码
  Application.CreateForm(....);
  Application.CreateForm(....);
  Application.CreateForm(...);
  Application.CreateForm(...);
  Application.Run;
end.二.在你的主窗口程序中
    procedure CreateParams(var Params: TCreateParams);override;procedure TfrmMain.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WinClassName := 'Main_Program!';
end;