安装更新之前关闭正在运行的程序版本 (Inno Setup)

发布于 2024-09-14 18:52:00 字数 226 浏览 8 评论 0原文

这应该很简单,我需要在安装程序启动时停止运行任何以前版本的程序。

大多数人建议创建一个执行此操作的 exe 并在 Inno Setup 启动之前调用它。我使用 AutoIt 创建了一个 exe,它会杀死程序的所有进程。问题是我不知道如何让 Inno Setup 在安装任何东西之前调用它。

如何在安装文件之前调用可执行文件?

或者,如果我可以检测程序是否正在运行并告诉用户关闭它,那也可以。

This should be simple, I need to stop any previous version of my program from running when the installer starts.

Most people suggested making an exe which does this and calling it before Inno Setup starts. I created an exe using AutoIt which kills all processes of my program. The problem is I don't know how to get Inno Setup to call it before it installs anything.

How do I call an executable before installing files?

Alternatively, if I can just detect if a program is running and tell the user to close it, that would work too.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(10

诠释孤独 2024-09-21 18:52:00

如果应用程序有互斥锁,您可以在 Inno Setup 安装程序中添加一个 AppMutex 值,它将显示一条消息,告诉用户停止该程序。您可以通过使用 SysInternals Process Explorer 并选择程序/进程并查看下部窗格中的句柄 (CTRL-H) 来找到互斥体(如果有的话)。

以下是知识库文章的链接,其中提到了几种方法:
http://www.vincenzo.net/isxkb/index.php?title=Detect_if_an_application_is_running

或者,您可以在 InitializeSetup 中尝试以下(未经测试)代码:

[Setup]
;If the application has  Mutex, uncomment the line below, comment the InitializeSetup function out, and use the AppMutex.
;AppMutex=MyApplicationMutex

[Code]
const
  WM_CLOSE = 16;

function InitializeSetup : Boolean;
var winHwnd: Longint;
    retVal : Boolean;
    strProg: string;
begin
  Result := True;
  try
    //Either use FindWindowByClassName. ClassName can be found with Spy++ included with Visual C++. 
    strProg := 'Notepad';
    winHwnd := FindWindowByClassName(strProg);
    //Or FindWindowByWindowName.  If using by Name, the name must be exact and is case sensitive.
    strProg := 'Untitled - Notepad';
    winHwnd := FindWindowByWindowName(strProg);
    Log('winHwnd: ' + IntToStr(winHwnd));
    if winHwnd <> 0 then
      Result := PostMessage(winHwnd,WM_CLOSE,0,0);
  except
  end;
end;

If the application has a Mutex, you can add an AppMutex value in your Inno Setup installer and it will display a message telling the user to stop the program. You might be able to find the Mutex (if it's got one) by using SysInternals Process Explorer and selecting the program / process and looking at the Handles (CTRL-H) in the Lower Pane.

Here's a link to the a KB article that mentions several methods:
http://www.vincenzo.net/isxkb/index.php?title=Detect_if_an_application_is_running

Alternatively, you might try this (UNTESTED) code in the InitializeSetup:

[Setup]
;If the application has  Mutex, uncomment the line below, comment the InitializeSetup function out, and use the AppMutex.
;AppMutex=MyApplicationMutex

[Code]
const
  WM_CLOSE = 16;

function InitializeSetup : Boolean;
var winHwnd: Longint;
    retVal : Boolean;
    strProg: string;
begin
  Result := True;
  try
    //Either use FindWindowByClassName. ClassName can be found with Spy++ included with Visual C++. 
    strProg := 'Notepad';
    winHwnd := FindWindowByClassName(strProg);
    //Or FindWindowByWindowName.  If using by Name, the name must be exact and is case sensitive.
    strProg := 'Untitled - Notepad';
    winHwnd := FindWindowByWindowName(strProg);
    Log('winHwnd: ' + IntToStr(winHwnd));
    if winHwnd <> 0 then
      Result := PostMessage(winHwnd,WM_CLOSE,0,0);
  except
  end;
end;
随梦而飞# 2024-09-21 18:52:00

在版本 5.5.0 中(2012 年 5 月发布)添加了 Inno Setup在 Windows Vista 和较新。

引用 MSDN 链接文档(重点是我的):

软件安装和更新需要重新启动系统的主要原因是正在更新的某些文件当前正在由正在运行的应用程序或服务使用。 重新启动管理器可以关闭和重新启动除关键应用程序和服务之外的所有应用程序和服务。这将释放正在使用的文件并允许完成安装操作。它还可以消除或减少完成安装或更新所需的系统重新启动次数。

好处是:您不需要在安装程序或应用程序中编写自定义代码来要求用户关闭它或自动关闭它。

如果您希望应用程序在更新完成后重新启动,则必须调用 RegisterApplicationRestart 函数。

新指令的默认值会关闭安装程序的 [Files] 部分中包含的所有 .exe、.dll 和 .chm 文件。

与之相关的更改是(来自发行说明):

  • 添加了新的 [Setup] 部分指令:CloseApplications,默认为 yes。如果设置为 yes 并且安装程序不会以静默方式运行,并且如果安装程序检测到应用程序使用需要由 [Files][ 更新的文件,则安装程序现在将在“准备安装向导”页面上暂停。 InstallDelete] 部分,显示应用程序并询问用户安装程序是否应自动关闭应用程序并在安装完成后重新启动它们。如果设置为 yes 并且安装程序以静默方式运行,安装程序将始终关闭并重新启动此类应用程序,除非通过命令行告知不要这样做(见下文)。
  • 添加了新的 [Setup] 部分指令:CloseApplicationsFilter,默认为 *.exe、*.dll、*.chm。控制安装程序将检查哪些文件正在使用。将其设置为 *.* 可以提供更好的检查,但会牺牲速度。
  • 添加了新的 [Setup] 部分指令:RestartApplications,默认为 yes。注意:为了让安装程序能够在安装完成后重新启动应用程序,应用程序需要使用 Windows RegisterApplicationRestart API 函数。
  • 添加了安装程序支持的新命令行参数:/NOCLOSEAPPLICATIONS/NORESTARTAPPLICATIONS。这些可用于覆盖新的 CloseApplicationsRestartApplications 指令。
  • 添加了新的[Code]支持功能:RmSessionStarted
  • TWizardForm:添加了新的 PreparingMemo 属性。

In version 5.5.0 (Released on May 2012) Inno Setup added support for the Restart Manager API on Windows Vista and newer.

Quote from MSDN linked documentation (emphasis mine):

The primary reason software installation and updates require a system restart is that some of the files that are being updated are currently being used by a running application or service. Restart Manager enables all but the critical applications and services to be shut down and restarted. This frees the files that are in use and allows installation operations to complete. It can also eliminate or reduce the number of system restarts that are required to complete an installation or update.

The good thing is: you don't need to write custom code in the installer or your application to ask the user to close it, or close it automatically.

If you want your application to restart after the update is complete, you have to call the RegisterApplicationRestart function from your application first.

The default values for the new directives closes all the .exe, .dll and .chm files contained within the [Files] section of the installer.

The changes related to it are (from release notes):

  • Added new [Setup] section directive: CloseApplications, which defaults to yes. If set to yes and Setup is not running silently, Setup will now pause on the Preparing to Install wizard page if it detects applications using files that need to be updated by the [Files] or [InstallDelete] section, showing the applications and asking the user if Setup should automatically close the applications and restart them after the installation has completed. If set to yes and Setup is running silently, Setup will always close and restart such applications, unless told not to via the command line (see below).
  • Added new [Setup] section directive: CloseApplicationsFilter, which defaults to *.exe,*.dll,*.chm. Controls which files Setup will check for being in use. Setting this to *.* can provide better checking at the expense of speed.
  • Added new [Setup] section directive: RestartApplications, which defaults to yes. Note: for Setup to be able to restart an application after the installation has completed, the application needs to be using the Windows RegisterApplicationRestart API function.
  • Added new command line parameters supported by Setup: /NOCLOSEAPPLICATIONS and /NORESTARTAPPLICATIONS. These can be used to override the new CloseApplications and RestartApplications directives.
  • Added new [Code] support function: RmSessionStarted.
  • TWizardForm: Added new PreparingMemo property.
云醉月微眠 2024-09-21 18:52:00

我尝试使用已接受的答案(以及 jachguate 的跟进),但它不会终止我的应用程序。看起来部分原因是我的应用程序窗口没有与之关联的文本,但无论真正的原因是什么,我使用 shell 命令来终止它并且有效。在 [code] 部分中,您要添加以下函数。它在复制安装文件之前被调用。

function PrepareToInstall(var NeedsRestart: Boolean): String;
var
ErrorCode: Integer;
begin
      ShellExec('open',  'taskkill.exe', '/f /im MyProg.exe','',SW_HIDE,ewNoWait,ErrorCode);
end;

I tried using the accepted answer (and the follow up by jachguate) but it wouldn't kill my application. It looks like part of the reason was that my application window had no text associated with it but whatever is the real reason, I used shell command to kill it and that worked. In the [code] section, you want to add the following function. It is called just before setup files are copied.

function PrepareToInstall(var NeedsRestart: Boolean): String;
var
ErrorCode: Integer;
begin
      ShellExec('open',  'taskkill.exe', '/f /im MyProg.exe','',SW_HIDE,ewNoWait,ErrorCode);
end;
半仙 2024-09-21 18:52:00

如果您使用 InnoSetup,您可以考虑让 InnoSetup 安装程序执行 Windows SendBroadcastMessage,并让您的应用程序侦听该消息。当您的应用程序收到该消息时,它应该自行关闭。

我自己使用 InnoSetup 安装程序完成了此操作,效果非常好。

If you're using InnoSetup, you could look into getting your InnoSetup installer to do a Windows SendBroadcastMessage, and get your application to listen for that message. When your application receives the message, it should shut itself down.

I've done this myself with an InnoSetup installer, and it works very well.

终陌 2024-09-21 18:52:00

下面是 Inno Setup 脚本的链接,如果检测到目标程序正在运行,该脚本会提示用户关闭目标程序。用户关闭程序后,可以单击“重试”按钮继续安装:

http://www.domador.net/extras/code-samples/inno-setup-close-a-program-before-reinstalling-it/

此脚本基于一个更简单的脚本,可在 Inno Setup Extensions 知识库中找到:

http://www.vincenzo.net/isxkb/index.php?title=Call_psvince.dll_on_install_and_uninstall

Here's a link to an Inno Setup script that prompts a user to close the target program, if it detects that the program is running. After the user closes the program, they can click on a "Retry" button to proceed with the installation:

http://www.domador.net/extras/code-samples/inno-setup-close-a-program-before-reinstalling-it/

This script is based on a simpler script, found in the Inno Setup Extensions Knowledge Base:

http://www.vincenzo.net/isxkb/index.php?title=Call_psvince.dll_on_install_and_uninstall

偏闹i 2024-09-21 18:52:00

我已经成功使用 WMIC

procedure CurStepChanged(CurStep: TSetupStep);
var
    ResultCode: Integer;
    wmicommand: string;
begin
    // before installing any file
    if CurStep = ssInstall then
    begin
        wmicommand := ExpandConstant('PROCESS WHERE "ExecutablePath like ''{app}\%%''" DELETE');

        // WMIC "like" expects escaped backslashes
        StringChangeEx(wmicommand, '\', '\\', True);

        // you can/should add an "if" around this and check the ResultCode
        Exec('WMIC', wmicommand, '', SW_HIDE, ewWaitUntilTerminated, ResultCode);
    end;
end;

您也可以在 InitializeSetup 中执行此操作,但如果您这样做,请记住您还没有访问 {app} 常量的权限。我的程序不要求安装路径,但你的程序可能会。

I have had success using WMIC :

procedure CurStepChanged(CurStep: TSetupStep);
var
    ResultCode: Integer;
    wmicommand: string;
begin
    // before installing any file
    if CurStep = ssInstall then
    begin
        wmicommand := ExpandConstant('PROCESS WHERE "ExecutablePath like ''{app}\%%''" DELETE');

        // WMIC "like" expects escaped backslashes
        StringChangeEx(wmicommand, '\', '\\', True);

        // you can/should add an "if" around this and check the ResultCode
        Exec('WMIC', wmicommand, '', SW_HIDE, ewWaitUntilTerminated, ResultCode);
    end;
end;

You can also do it in the InitializeSetup but if you do, keep in mind you don't have yet access to the {app} constant. My program doesn't ask for install path, but yours might.

凉风有信 2024-09-21 18:52:00

在 [Setup] 部分添加 CloseApplications=true。

如果设置为“yes”或“force”并且安装程序不是以静默方式运行,并且安装程序检测到应用程序正在使用需要由 [Files] 或 [InstallDelete] 部分更新的文件,则安装程序将在“准备安装向导”页面上暂停,显示应用程序并询问用户是否应在安装完成后自动关闭应用程序并重新启动它们。

Add CloseApplications=true in [Setup] section.

If set to yes or force and Setup is not running silently, Setup will pause on the Preparing to Install wizard page if it detects applications using files that need to be updated by the [Files] or [InstallDelete] section, showing the applications and asking the user if Setup should automatically close the applications and restart them after the installation has completed.

寂寞花火° 2024-09-21 18:52:00

InnoSetup 允许您将 Pascal 脚本附加到构建过程中的各个位置。尝试附加一个调用 ShellExecute 的脚本。 (如果脚本引擎还没有,您可能需要将其导入。)

InnoSetup allows you to attach Pascal scripts to various places in the build process. Try attaching a script that calls ShellExecute. (Which you may have to import to the script engine if it doesn't already have it.)

逆光飞翔i 2024-09-21 18:52:00

如果您愿意编写自己的 DLL,则可以使用 TlHelp32.pas 的工具帮助 API 来确定正在运行的应用程序,然后使用 EnumWindows 获取它们的窗口句柄,然后将 WM_CLOSE 发送到窗口句柄。

这有点痛苦,但应该有效:
我不久前和朋友一起开发了一些实用程序包装类。不记得我们是否基于其他人的代码。

TWindows.ProcessISRunning 和 TWindows.StopProcess 可能会有所帮助。

interface

uses
  Classes,
  Windows,
  SysUtils,
  Contnrs,
  Messages;

type


TProcess = class(TObject)
  public
    ID: Cardinal;
    Name: string;
end;

TWindow = class(TObject)
  private
    FProcessID: Cardinal;
    FProcessName: string;
    FHandle: THandle;
    FProcessHandle : THandle;
    function GetProcessHandle: THandle;
    function GetProcessID: Cardinal;
    function GetProcessName: string;
  public
    property Handle : THandle read FHandle;
    property ProcessName : string read GetProcessName;
    property ProcessID : Cardinal read GetProcessID;
    property ProcessHandle : THandle read GetProcessHandle;
end;

TWindowList = class(TObjectList)
  private
    function GetWindow(AIndex: Integer): TWindow;
  protected

  public
    function Add(AWindow: TWindow): Integer; reintroduce;
    property Window[AIndex: Integer]: TWindow read GetWindow; default;
end;

TProcessList = class(TObjectList)
  protected
    function GetProcess(AIndex: Integer): TProcess;
  public
    function Add(AProcess: TProcess): Integer; reintroduce;
    property Process[AIndex: Integer]: TProcess read GetProcess; default;
end;

TWindows = class(TObject)
  protected
  public
    class function GetHWNDFromProcessID(ProcessID: Cardinal; BuildList: Boolean = True): THandle;
    class function GetProcessList: TProcessList;
    class procedure KillProcess(ProcessName: string);
    class procedure StopProcess(ProcessName: string);
    class function ExeIsRunning(ExeName: string): Boolean;
    class function ProcessIsRunning(PID: Cardinal): Boolean;
end;

implementation

uses
  Forms,
  Math,
  PSAPI,
  TlHelp32;

const
  cRSPUNREGISTERSERVICE = 0;
  cRSPSIMPLESERVICE = 1;

type

TProcessToHWND = class(TObject)
  public
    ProcessID: Cardinal;
    HWND: Cardinal;
end;

function RegisterServiceProcess(dwProcessID, dwType: DWord): DWord; stdcall; external 'KERNEL32.DLL';
function GetDiskFreeSpaceEx(lpDirectoryName: PChar;
  var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger;
  lpTotalNumberOfFreeBytes: PLargeInteger): Boolean; stdcall;external 'KERNEL32.DLL' name 'GetDiskFreeSpaceExA'

var
  GProcessToHWNDList: TObjectList = nil;

function EnumerateWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  proc: TProcessToHWND;
begin
  if Assigned(GProcessToHWNDList) then
  begin
    proc := TProcessToHWND.Create;
    proc.HWND := hwnd;
    GetWindowThreadProcessID(hwnd, proc.ProcessID);
    GProcessToHWNDList.Add(proc);
    Result := True;
  end
  else
    Result := False; // stop enumeration
end;

{ TWindows }

class function TWindows.ExeIsRunning(ExeName: string): Boolean;
var
  processList: TProcessList;
  i: Integer;
begin
  Result := False;

  processList := GetProcessList;
  try
    for i := 0 to processList.Count - 1 do
    begin
      if (UpperCase(ExeName) = UpperCase(processList[i].Name)) or
          (UpperCase(ExeName) = UpperCase(ExtractFileName(processList[i].Name))) then
      begin
        Result := True;
        Break;
      end;
    end;
  finally
    processList.Free;
  end;
end;

class function TWindows.GetHWNDFromProcessID(
  ProcessID: Cardinal; BuildList: Boolean): THandle;
var
  i: Integer;
begin
  Result := 0;

  if BuildList or (not Assigned(GProcessToHWNDList)) then
  begin
    GProcessToHWNDList.Free;
    GProcessToHWNDList := TObjectList.Create;
    EnumWindows(@EnumerateWindowsProc, 0);
  end;

  for i := 0 to GProcessToHWNDList.Count - 1 do
  begin
    if TProcessToHWND(GProcessToHWNDList[i]).ProcessID = ProcessID then
    begin
      Result := TProcessToHWND(GProcessToHWNDList[i]).HWND;
      Break;
    end;
  end;
end;


class function TWindows.GetProcessList: TProcessList;
var
  handle: THandle;
  pe: TProcessEntry32;
  process: TProcess;
begin
  Result := TProcessList.Create;

  handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  pe.dwSize := Sizeof(pe);
  if Process32First(handle, pe) then
  begin
    while True do
    begin
      process := TProcess.Create;
      process.Name := pe.szExeFile;
      process.ID := pe.th32ProcessID;
      Result.Add(process);
      if not Process32Next(handle, pe) then
        Break;
    end;
  end;
  CloseHandle(handle);
end;

function EnumWindowsProc(Ahwnd : HWND;      // handle to parent window
  ALParam : Integer) : BOOL;stdcall;
var
  List : TWindowList;
  Wnd : TWindow;
begin
  Result := True;
  List := TWindowList(ALParam);
  Wnd := TWindow.Create;
  List.Add(Wnd);
  Wnd.FHandle := Ahwnd;
end;


class procedure TWindows.KillProcess(ProcessName: string);
var
  handle: THandle;
  pe: TProcessEntry32;
begin
  // Warning: will kill all process with ProcessName
  // NB won't work on NT 4 as Tool Help API is not supported on NT

  handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    pe.dwSize := Sizeof(pe);

    if Process32First(handle, pe) then
    begin
      while True do begin
        if (UpperCase(ExtractFileName(pe.szExeFile)) = UpperCase(ExtractFileName(ProcessName))) or
           (UpperCase(pe.szExeFile) = UpperCase(ProcessName)) then
        begin
          if not TerminateProcess(OpenProcess(PROCESS_TERMINATE, False,
                                    pe.th32ProcessID), 0) then
          begin
            raise Exception.Create('Unable to stop process ' + ProcessName + ': Error Code ' + IntToStr(GetLastError));
          end;
        end;
        if not Process32Next(handle, pe) then
          Break;
      end;
    end;
  finally
    CloseHandle(handle);
  end;
end;

class function TWindows.ProcessIsRunning(PID: Cardinal): Boolean;
var
  processList: TProcessList;
  i: Integer;
begin
  Result := False;

  processList := GetProcessList;
  try
    for i := 0 to processList.Count - 1 do
    begin
      if processList[i].ID = PID then
      begin
        Result := True;
        Break;
      end;
    end;
  finally
    processList.Free;
  end;
end;

class procedure TWindows.StopProcess(ProcessName: string);
var
  processList: TProcessList;
  i: Integer;
  hwnd: THandle;
begin
  // Warning: will attempt to stop all process with ProcessName
  if not Assigned(GProcessToHWNDList) then
    GProcessToHWNDList := TObjectList.Create
  else
    GProcessToHWNDList.Clear;

  // get list of all current processes
  processList := GetProcessList;
  // enumerate windows only once to determine the window handle for the processes
  if EnumWindows(@EnumerateWindowsProc, 0) then
  begin
    for i := 0 to processList.Count - 1 do
    begin
      if UpperCase(ExtractFileName(processList[i].Name)) = UpperCase(ExtractFileName(ProcessName)) then
      begin
        hwnd := GetHWNDFromProcessID(processList[i].ID, False);
        SendMessage(hwnd, WM_CLOSE, 0, 0);
      end;
    end;
  end;
end;


{ TProcessList }

function TProcessList.Add(AProcess: TProcess): Integer;
begin
  Result := inherited Add(AProcess);
end;

function TProcessList.GetProcess(AIndex: Integer): TProcess;
begin
  Result := TProcess(Items[AIndex]);
end;

{ TWindowList }

function TWindowList.Add(AWindow: TWindow): Integer;
begin
  Result := inherited Add(AWindow);
end;

function TWindowList.GetWindow(AIndex: Integer): TWindow;
begin
  Result := TWindow(Items[AIndex]);
end;

{ TWindow }

function TWindow.GetProcessHandle: THandle;
begin
  if FProcessHandle = 0 then
    FProcessHandle := OpenProcess(Windows.SYNCHRONIZE or Windows.PROCESS_TERMINATE,
     True, FProcessID);
  Result := FProcessHandle;
end;

function TWindow.GetProcessID: Cardinal;
var
  Pid : Cardinal;
begin
  if FProcessID = 0 then
  begin
    Pid := 1;
    GetWindowThreadProcessId(Handle, Pid);
    FProcessID := Pid;
  end;
  Result := FProcessID;
end;


function TWindow.GetProcessName: string;
var
  Buffer : packed array [1..1024] of char;
  len : LongWord;
begin
  FillChar(Buffer, SizeOf(Buffer), 0);
  if FProcessName = '' then
  begin
    len := GetWindowModuleFileName(Handle, @Buffer[1], 1023);
    FProcessName := Copy(Buffer, 1, Len);
  end;
  Result := FProcessName;
end;

end.

If you are happy to write your own DLL, you can use the tool help API for TlHelp32.pas to determine what applications are running, and then get a window handle for them using EnumWindows, then send a WM_CLOSE to the window handle.

It's a bit of a pain, but it should work:
I have some utility wrapper classes I developed with a friend a while back. Can't remember if we based it on someone else's code.

TWindows.ProcessISRunning and TWindows.StopProcess may help.

interface

uses
  Classes,
  Windows,
  SysUtils,
  Contnrs,
  Messages;

type


TProcess = class(TObject)
  public
    ID: Cardinal;
    Name: string;
end;

TWindow = class(TObject)
  private
    FProcessID: Cardinal;
    FProcessName: string;
    FHandle: THandle;
    FProcessHandle : THandle;
    function GetProcessHandle: THandle;
    function GetProcessID: Cardinal;
    function GetProcessName: string;
  public
    property Handle : THandle read FHandle;
    property ProcessName : string read GetProcessName;
    property ProcessID : Cardinal read GetProcessID;
    property ProcessHandle : THandle read GetProcessHandle;
end;

TWindowList = class(TObjectList)
  private
    function GetWindow(AIndex: Integer): TWindow;
  protected

  public
    function Add(AWindow: TWindow): Integer; reintroduce;
    property Window[AIndex: Integer]: TWindow read GetWindow; default;
end;

TProcessList = class(TObjectList)
  protected
    function GetProcess(AIndex: Integer): TProcess;
  public
    function Add(AProcess: TProcess): Integer; reintroduce;
    property Process[AIndex: Integer]: TProcess read GetProcess; default;
end;

TWindows = class(TObject)
  protected
  public
    class function GetHWNDFromProcessID(ProcessID: Cardinal; BuildList: Boolean = True): THandle;
    class function GetProcessList: TProcessList;
    class procedure KillProcess(ProcessName: string);
    class procedure StopProcess(ProcessName: string);
    class function ExeIsRunning(ExeName: string): Boolean;
    class function ProcessIsRunning(PID: Cardinal): Boolean;
end;

implementation

uses
  Forms,
  Math,
  PSAPI,
  TlHelp32;

const
  cRSPUNREGISTERSERVICE = 0;
  cRSPSIMPLESERVICE = 1;

type

TProcessToHWND = class(TObject)
  public
    ProcessID: Cardinal;
    HWND: Cardinal;
end;

function RegisterServiceProcess(dwProcessID, dwType: DWord): DWord; stdcall; external 'KERNEL32.DLL';
function GetDiskFreeSpaceEx(lpDirectoryName: PChar;
  var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger;
  lpTotalNumberOfFreeBytes: PLargeInteger): Boolean; stdcall;external 'KERNEL32.DLL' name 'GetDiskFreeSpaceExA'

var
  GProcessToHWNDList: TObjectList = nil;

function EnumerateWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  proc: TProcessToHWND;
begin
  if Assigned(GProcessToHWNDList) then
  begin
    proc := TProcessToHWND.Create;
    proc.HWND := hwnd;
    GetWindowThreadProcessID(hwnd, proc.ProcessID);
    GProcessToHWNDList.Add(proc);
    Result := True;
  end
  else
    Result := False; // stop enumeration
end;

{ TWindows }

class function TWindows.ExeIsRunning(ExeName: string): Boolean;
var
  processList: TProcessList;
  i: Integer;
begin
  Result := False;

  processList := GetProcessList;
  try
    for i := 0 to processList.Count - 1 do
    begin
      if (UpperCase(ExeName) = UpperCase(processList[i].Name)) or
          (UpperCase(ExeName) = UpperCase(ExtractFileName(processList[i].Name))) then
      begin
        Result := True;
        Break;
      end;
    end;
  finally
    processList.Free;
  end;
end;

class function TWindows.GetHWNDFromProcessID(
  ProcessID: Cardinal; BuildList: Boolean): THandle;
var
  i: Integer;
begin
  Result := 0;

  if BuildList or (not Assigned(GProcessToHWNDList)) then
  begin
    GProcessToHWNDList.Free;
    GProcessToHWNDList := TObjectList.Create;
    EnumWindows(@EnumerateWindowsProc, 0);
  end;

  for i := 0 to GProcessToHWNDList.Count - 1 do
  begin
    if TProcessToHWND(GProcessToHWNDList[i]).ProcessID = ProcessID then
    begin
      Result := TProcessToHWND(GProcessToHWNDList[i]).HWND;
      Break;
    end;
  end;
end;


class function TWindows.GetProcessList: TProcessList;
var
  handle: THandle;
  pe: TProcessEntry32;
  process: TProcess;
begin
  Result := TProcessList.Create;

  handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  pe.dwSize := Sizeof(pe);
  if Process32First(handle, pe) then
  begin
    while True do
    begin
      process := TProcess.Create;
      process.Name := pe.szExeFile;
      process.ID := pe.th32ProcessID;
      Result.Add(process);
      if not Process32Next(handle, pe) then
        Break;
    end;
  end;
  CloseHandle(handle);
end;

function EnumWindowsProc(Ahwnd : HWND;      // handle to parent window
  ALParam : Integer) : BOOL;stdcall;
var
  List : TWindowList;
  Wnd : TWindow;
begin
  Result := True;
  List := TWindowList(ALParam);
  Wnd := TWindow.Create;
  List.Add(Wnd);
  Wnd.FHandle := Ahwnd;
end;


class procedure TWindows.KillProcess(ProcessName: string);
var
  handle: THandle;
  pe: TProcessEntry32;
begin
  // Warning: will kill all process with ProcessName
  // NB won't work on NT 4 as Tool Help API is not supported on NT

  handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    pe.dwSize := Sizeof(pe);

    if Process32First(handle, pe) then
    begin
      while True do begin
        if (UpperCase(ExtractFileName(pe.szExeFile)) = UpperCase(ExtractFileName(ProcessName))) or
           (UpperCase(pe.szExeFile) = UpperCase(ProcessName)) then
        begin
          if not TerminateProcess(OpenProcess(PROCESS_TERMINATE, False,
                                    pe.th32ProcessID), 0) then
          begin
            raise Exception.Create('Unable to stop process ' + ProcessName + ': Error Code ' + IntToStr(GetLastError));
          end;
        end;
        if not Process32Next(handle, pe) then
          Break;
      end;
    end;
  finally
    CloseHandle(handle);
  end;
end;

class function TWindows.ProcessIsRunning(PID: Cardinal): Boolean;
var
  processList: TProcessList;
  i: Integer;
begin
  Result := False;

  processList := GetProcessList;
  try
    for i := 0 to processList.Count - 1 do
    begin
      if processList[i].ID = PID then
      begin
        Result := True;
        Break;
      end;
    end;
  finally
    processList.Free;
  end;
end;

class procedure TWindows.StopProcess(ProcessName: string);
var
  processList: TProcessList;
  i: Integer;
  hwnd: THandle;
begin
  // Warning: will attempt to stop all process with ProcessName
  if not Assigned(GProcessToHWNDList) then
    GProcessToHWNDList := TObjectList.Create
  else
    GProcessToHWNDList.Clear;

  // get list of all current processes
  processList := GetProcessList;
  // enumerate windows only once to determine the window handle for the processes
  if EnumWindows(@EnumerateWindowsProc, 0) then
  begin
    for i := 0 to processList.Count - 1 do
    begin
      if UpperCase(ExtractFileName(processList[i].Name)) = UpperCase(ExtractFileName(ProcessName)) then
      begin
        hwnd := GetHWNDFromProcessID(processList[i].ID, False);
        SendMessage(hwnd, WM_CLOSE, 0, 0);
      end;
    end;
  end;
end;


{ TProcessList }

function TProcessList.Add(AProcess: TProcess): Integer;
begin
  Result := inherited Add(AProcess);
end;

function TProcessList.GetProcess(AIndex: Integer): TProcess;
begin
  Result := TProcess(Items[AIndex]);
end;

{ TWindowList }

function TWindowList.Add(AWindow: TWindow): Integer;
begin
  Result := inherited Add(AWindow);
end;

function TWindowList.GetWindow(AIndex: Integer): TWindow;
begin
  Result := TWindow(Items[AIndex]);
end;

{ TWindow }

function TWindow.GetProcessHandle: THandle;
begin
  if FProcessHandle = 0 then
    FProcessHandle := OpenProcess(Windows.SYNCHRONIZE or Windows.PROCESS_TERMINATE,
     True, FProcessID);
  Result := FProcessHandle;
end;

function TWindow.GetProcessID: Cardinal;
var
  Pid : Cardinal;
begin
  if FProcessID = 0 then
  begin
    Pid := 1;
    GetWindowThreadProcessId(Handle, Pid);
    FProcessID := Pid;
  end;
  Result := FProcessID;
end;


function TWindow.GetProcessName: string;
var
  Buffer : packed array [1..1024] of char;
  len : LongWord;
begin
  FillChar(Buffer, SizeOf(Buffer), 0);
  if FProcessName = '' then
  begin
    len := GetWindowModuleFileName(Handle, @Buffer[1], 1023);
    FProcessName := Copy(Buffer, 1, Len);
  end;
  Result := FProcessName;
end;

end.
国产ˉ祖宗 2024-09-21 18:52:00

好吧,我认为执行此操作的更简单方法可能是在 Delphi 中创建一个 DLL,它检测您的程序是否正在运行并要求用户关闭它,将该 DLL 放入您的设置中并使用标志“dontcopy”(签入 http://www.jrsoftware.org/ishelp/ 位于 Pascal Scripting \ 使用 DLL 下作为示例)。

顺便说一句,下次使用互斥体时,Inno Setup 也支持这一点,并且要容易得多。

编辑:要提取文件(如果您想使用您提到的 .exe),只需使用 ExtractTemporaryFile() 即可。

Well, I think the easier way to perform this may be creating a DLL in Delphi that detects if your program is running and ask the user to close it, put that DLL in your setup and use the flag "dontcopy" (check in http://www.jrsoftware.org/ishelp/ under Pascal Scripting \ Using DLLs for an example).

Btw, next time use mutexes, Inno Setup also support that and is far more easier.

EDIT: and for extracting a file (if you want to use that .exe you mention), just use ExtractTemporaryFile().

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文