怎么防止程序被重复执行

Question

我的程序希望同一时间运行一次如果打开了可执行文件不允许再打开，在delphi中怎么实现

Answer 1

ABC组件中就包含这个了使用ATOM和MUTEX技术都是可以的
网上的例子很多的  TabcSingleInstance = class(TComponent)
  private
    FMutex: THandle;
    FSemaphore: THandle;
    FStopMsg: string;
    FActivate: Boolean;
    FClosePrevious: Boolean;
    FMultipleInstances: Boolean;
    FOnPreviousInstance: TabcHaltEvent;
    FTerminateBy: TabcTerminateMethod;
    procedure CheckTerminate;
    function GetMutexName: string;
    function GetInstanceCount: Integer;
    function GetSemaphoreName: string;
    procedure InitSemaphore;
    procedure SetActivate(Value: Boolean);
    procedure SetClosePrevious(Value: Boolean);
    procedure SetMultipleInstances(Value: Boolean);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure HaltIfRunning;
    property InstanceCount: Integer read GetInstanceCount;
  published
    property Activate: Boolean read FActivate write SetActivate default True;
    property ClosePrevious: Boolean read FClosePrevious write SetClosePrevious default False;
    property MultipleInstances: Boolean read FMultipleInstances write SetMultipleInstances default False;
    property StopMsg: string read FStopMsg write FStopMsg;
    property TerminateBy: TabcTerminateMethod read FTerminateBy write FTerminateBy default atmAppTerminate;
    property OnPreviousInstance: TabcHaltEvent read FOnPreviousInstance write FOnPreviousInstance;
  end;

Answer 2

{ TabcSingleInstance }const
  ABC_SI_SEMAPHORE_MAX = 65535;function TabcSingleInstance.GetInstanceCount: Integer;
//returns total number of instances, including this one.
begin
  if FSemaphore <> 0 then
  begin
    ReleaseSemaphore(
      FSemaphore,      // handle of the semaphore object
      1,               // amount to add to current count
      @Result          // address of previous count
    );
    WaitForSingleObject(FSemaphore, INFINITE); //reduce count again
    Result := ABC_SI_SEMAPHORE_MAX - Result;
  end
  else
    Result := 1;
end;constructor TabcSingleInstance.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActivate := True;
  FMutex := CreateMutex(nil, True, PChar(GetMutexName));
  if (FMutex <> 0) and (GetLastError <> 0) then FMutex := 0;
end;function TabcSingleInstance.GetMutexName: string;
begin
  Result := 'TabcSingleInstance in application ' + Application.Title;
end;function TabcSingleInstance.GetSemaphoreName: string;
begin
  Result := 'TabcSingleInstance Semaphore in application ' + Application.Title;
end;destructor TabcSingleInstance.Destroy;
begin
  if FMutex <> 0 then CloseHandle(FMutex);
  if FSemaphore <> 0 then
  begin
    ReleaseSemaphore(FSemaphore, 1, nil);
    CloseHandle(FSemaphore);
  end;
  inherited Destroy;
end;procedure TabcSingleInstance.Loaded;
begin
  inherited Loaded;
  HaltIfRunning;
end;procedure TabcSingleInstance.HaltIfRunning;
begin
  if not (csDesigning in ComponentState) then
  begin
    if MultipleInstances then
      InitSemaphore;
    if (FMutex = 0) then
      CheckTerminate;
  end;
end;procedure TabcSingleInstance.InitSemaphore;
const
  SEMAPHORE_MODIFY_STATE = $0002;
begin
  if FSemaphore = 0 then
  begin
    FSemaphore := CreateSemaphore(nil, ABC_SI_SEMAPHORE_MAX, ABC_SI_SEMAPHORE_MAX, PChar(GetSemaphoreName));
    if (FSemaphore = 0) and (GetLastError = ERROR_ALREADY_EXISTS) then
      FSemaphore := OpenSemaphore(SEMAPHORE_MODIFY_STATE, False, PChar(GetSemaphoreName));
    if FSemaphore <> 0 then
      WaitForSingleObject(FSemaphore, INFINITE);
  end;
end;procedure TabcSingleInstance.CheckTerminate;
var
  AppWindow, ActiveWindow: HWND;
  ClassChar, WindowChar: array[0..255] of char;
  prevInstances: Integer;
  HaltThisInstance: Boolean;  procedure HaltOrTerminateApp;
  begin
    case TerminateBy of
      atmAppTerminate:
        begin
          Application.ShowMainForm := False;
          Application.Terminate;
        end;
      atmCloseMainForm:
        if Application.MainForm <> nil then
          Application.MainForm.Close;
      atmExitProcess:
        ExitProcess(0);
      atmHalt:
        Halt;
      atmTerminateProcess:
        TerminateProcess(GetCurrentProcess, 0);
    end;
  end;begin  if MultipleInstances then
  begin
    prevInstances := InstanceCount - 1;
    if Assigned(FOnPreviousInstance) then
    begin
      HaltThisInstance := True;
      FOnPreviousInstance(Self, prevInstances, HaltThisInstance);
      if not HaltThisInstance then
        Exit;
    end
    else
      Exit;
  end;  if FStopMsg <> '' then
    MessageBox(Application.Handle, PChar(FStopMsg), PChar(Application.Title), MB_ICONEXCLAMATION);
  if FActivate or FClosePrevious then begin
    {Find previous instance using Window Caption}
    GetClassName(Application.Handle, ClassChar, 255);
    GetWindowText(Application.Handle, WindowChar, 255);
    SetWindowText(Application.Handle, '');
    AppWindow := FindWindow(ClassChar, WindowChar);
    SetWindowText(Application.Handle, WindowChar);
    if (AppWindow <> 0) then
    begin
      {Other instance detected}
      if FClosePrevious then
        PostMessage(AppWindow, WM_QUIT, 0, 0)
      else
      begin
        if IsIconic(AppWindow) then
          {Restore when minimised}
          ShowWindow(AppWindow, SW_RESTORE)
        else
        begin
          ActiveWindow := GetLastActivePopup(AppWindow);
          if (ActiveWindow <> 0) and
              IsWindowVisible(ActiveWindow) and
              IsWindowEnabled(ActiveWindow) and
              (ActiveWindow <> AppWindow) then
            SetForegroundWindow(ActiveWindow);
        end;
        HaltOrTerminateApp;
      end;
    end
    else
      HaltOrTerminateApp;  //couldn't find app window
  end
  else
    HaltOrTerminateApp;
end;procedure TabcSingleInstance.SetActivate(Value: Boolean);
begin
  FActivate := Value;
  if Value then
  begin
    FClosePrevious := False;
  end;
end;procedure TabcSingleInstance.SetClosePrevious(Value: Boolean);
begin
  FClosePrevious := Value;
  if Value then
  begin
    FActivate := False;
    FMultipleInstances := False;
  end;
end;procedure TabcSingleInstance.SetMultipleInstances(Value: Boolean);
begin
  FMultipleInstances := Value;
  if Value then
    FClosePrevious := False;
end;

Answer 3

program TelClient;uses
  Forms,
  windows,
  about in 'about.pas' {AboutForm},
  Clientvar in 'Clientvar.pas',
  FindMan in 'FindMan.pas' {FormFindMan},
  GroupMan in 'GroupMan.pas' {FormGroupMan},
  Load in 'Load.pas' {LoadForm},
  Main in 'Main.pas' {MainForm},
  Option in 'Option.pas' {FormOption},
  SelectFaxTel in 'SelectFaxTel.pas' {FormSelectFaxtel};{$R *.res}Var
handle,handle1,handle2:THandle;begin
 handle1:=findwindow('TloadForm','登陆Dj来电显示');
 handle2:=FindWindow('Tmainform','Dj来电显示');
 //Application.Terminate;
 if handle1<>0 then handle:=handle1
 else handle:=handle2;
 if handle=0 then
 Application.Initialize;
  Application.Title := 'TelClient';
  LoadForm:=TLoadForm.Create(Application);
  LoadForm.ShowModal;
   if LoadForm.Loadif then
  begin
  LoadForm.Free;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
  end;
 end
  else
  begin
   messagebox(handle,'此程序已经运行了！','提示',MB_ICONASTERISK);
   end;
end.

Answer 4

program ****
uses
  windows; //一定要有
var
  hMutex:hwnd;
  ret:integer;{$R *.res}
begin
// 程序只能运行一次---------------------------------------
  hMutex:=CreateMutex(nil,false,'****');
  ret:=GetLastError;
  if ret=ERROR_ALREADY_EXISTS then
  begin
    ReleaseMutex(hMutex);
    MessageBox(Application.Handle,'抱歉，本系统已经启动或正在运行!',' 系统信息' ,
    MB_OK + MB_DEFBUTTON1 + MB_ICONEXCLAMATION);
    exit;
  end;
//-----------------------------------------------------

Answer 5

解决没有？如果没有解决请用下面的代码（相对比较少，程序以精简为妙啊）：
  use windows,variants
  只要在工程前面加上：
  if (CreateMutex(nil,TRUE,pChar(‘你的应用程序名称’))<>NULL) and   (GetLastError=ERROR_ALREADY_EXISTS) then
  begin
     MessageBox(0,pchar(‘自己定义的提示’),pchar('警告'),MB_OK);
     application.Terminate ;
     exit;
     Application.FreeOnRelease ;
  end;

Answer 6

cnhgj(戏子 ■ 学习C++) 兄弟的代码好像是我以前写的，现在我已经把它改进了。
改进之处：如果再打开程序的话，则调出已经打开的程序。
program TelClient;uses
  Forms,
  windows,
  Load in 'Load.pas' {LoadForm},
  Main in 'Main.pas' {MainForm};{$R *.res}varhwnd1,handle1:THandle;
begin
hwnd1:=0;
repeat
   hwnd1:=FindWindowEx(0,hwnd1,'TApplication','TelClient');
until (hwnd1<>application.Handle);if hwnd1=0 then
   begin
   Application.Initialize;
   Application.Title := 'TelClient';
   Application.CreateForm(TMainForm, MainForm);
   Application.Run;
   end
else
   begin
   handle1:=FindWindow('TMainForm','Dj来电显示');
   ShowWindow(hwnd1,SW_RESTORE);  //恢复Application状态
   ShowWindow(handle1,SW_SHOWNORMAL);//恢复主窗口
   ShowWindow(handle1,SW_SHOW);//显示主窗口
   SetForegroundWindow(hwnd1);//设置为最前方
   end;
end.

Answer 7

wlw88(飞扬) 你的代码不错，谢谢。

Answer 8

将工程文件中的begin...end;部分换为以下形式：
var
  Hwnd : THandle;
begin
  Hwnd := FindWindow(Pchar(String(TFmTaiShoeMain.classname)),nil);
  //TFmTaiShoeMain是主窗口类名 
  if Hwnd<>0 then
    begin
      SetForegroundWindow(Hwnd); //将已经运行的程序调到最前
      Application.Terminate; //终止本次运行
    end
  else
    begin
      Application.Initialize;
      Application.CreateForm(TFmTaiShoeMain, FmTaiShoeMain);
      Application.Run;//运行新实例
    end;
end.