如何编写自定义操作 DLL 以在 MSI 中使用?

2024-04-16

这是我打算自己回答的问题,但请随意添加其他方法来完成此任务。

我正在打包一个应用程序以用于各种配置,并且我确定在 MSI 中执行自定义逻辑的最可靠方法是编写我自己的自定义操作 DLL,该 DLL 能够从 PROPERTY 表中读取/写入,终止进程,确定应用程序是否需要升级(然后将答案记录在 PROPERTY 表中),并写入标准 MSI 日志。


我的解决方案是在 Delphi 中,并且需要开源 JEDI API 翻译,您可以在这里下载 http://sourceforge.net/project/platformdownload.php?group_id=121894。我发现的一个问题是使用 JwaMSI 标头的示例很少。希望有人会发现这是一个有用的例子。

这是主要单元,其后是第二个支持单元(您可以将其包含在同一个 DLL 项目中)。只需在 Delphi 中创建一个新的 DLL(库),然后复制/粘贴此代码即可。该单元导出 2 个可从 MSI 调用的函数。他们是:

  1. 检查是否可升级
  2. 杀死正在运行的应用程序

这两个函数都从属性表中读取 PROPERTY 值,并在完成时设置一个值。这个想法是,第二个自定义操作可以读取此属性并引发错误,或将其用作安装条件。

此代码更多地用于示例,在下面的示例中,它检查“notepad.exe”的版本是否需要升级(这意味着存储在属性表值“NOTEPAD_VERSON”中的版本大于版本号)系统上的 notepad.exe)。如果不是,则它将“UPGRADEABLE_VERSION”属性设置为“NO”(该属性默认设置为“YES”)。

此代码还会在 PROPERTY 表中查找“PROGRAM_TO_KILL”,并在该程序正在运行时杀死该程序。它需要包含要杀死的程序的文件扩展名,例如“记事本.exe”

library MsiHelper;

uses
  Windows,
  SysUtils,
  Classes,
  StrUtils,
  jwaMSI,
  jwaMSIDefs,
  jwaMSIQuery,
  JclSysInfo,
  PsApi,
  MSILogging in 'MSILogging.pas';

{$R *.res}


function CompareVersionNumbers(AVersion1, AVersion2: string): Integer;
var
  N1, N2: Integer;
//Returns 1 if AVersion1 < AVersion2
//Returns -1 if AVersion1 > AVersion2
//Returns 0 if values are equal
  function GetNextNumber(var Version: string): Integer;
  var
    P: Integer;
    S: string;
  begin
    P := Pos('.', Version);
    if P > 0 then
    begin
      S := Copy(Version, 1, P - 1);
      Version := Copy(Version, P + 1, Length(Version) - P);
    end
    else
    begin
      S := Version;
      Version := '';
    end;
    if S = '' then
      Result := -1
    else
    try
      Result := StrToInt(S);
    except
      Result := -1;
    end;
  end;

begin
  Result := 0;
  repeat
    N1 := GetNextNumber(AVersion1);
    N2 := GetNextNumber(AVersion2);
    if N2 > N1 then
    begin
      Result := 1;
      Exit;
    end
    else
    if N2 < N1 then
    begin
      Result := -1;
      Exit;
    end
  until (AVersion1 = '') and (AVersion2 = '');
end;

function GetFmtFileVersion(const FileName: String = ''; const Fmt: String = '%d.%d.%d.%d'): String;
var
  sFileName: String;
  iBufferSize: DWORD;
  iDummy: DWORD;
  pBuffer: Pointer;
  pFileInfo: Pointer;
  iVer: array[1..4] of Word;
begin
  // set default value
  Result := '';
  // get filename of exe/dll if no filename is specified
  sFileName := FileName;
  if (sFileName = '') then
  begin
    // prepare buffer for path and terminating #0
    SetLength(sFileName, MAX_PATH + 1);
    SetLength(sFileName,
      GetModuleFileName(hInstance, PChar(sFileName), MAX_PATH + 1));
  end;
  // get size of version info (0 if no version info exists)
  iBufferSize := GetFileVersionInfoSize(PChar(sFileName), iDummy);
  if (iBufferSize > 0) then
  begin
    GetMem(pBuffer, iBufferSize);
    try
    // get fixed file info (language independent)
    GetFileVersionInfo(PChar(sFileName), 0, iBufferSize, pBuffer);
    VerQueryValue(pBuffer, '\', pFileInfo, iDummy);
    // read version blocks
    iVer[1] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
    iVer[2] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
    iVer[3] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
    iVer[4] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
    finally
      FreeMem(pBuffer);
    end;
    // format result string
    Result := Format(Fmt, [iVer[1], iVer[2], iVer[3], iVer[4]]);
  end;
end;


function KillRunningApp(hInstall: MSIHandle): Integer; stdcall;
var
  aProcesses: array[0..1023] of DWORD;
  cbNeeded: DWORD;
  cProcesses: DWORD;
  i:    integer;
  szProcessName: array[0..MAX_PATH - 1] of char;
  hProcess: THandle;
  hMod: HModule;
  sProcessName : PChar;
  iProcessNameLength : Cardinal;
begin
  iProcessNameLength := MAX_PATH;
  sProcessName := StrAlloc(MAX_PATH);

  try
    //reads the value from "PROGRAM_TO_KILL" that is stored in the PROPERTY table
    MsiGetProperty(hInstall, 'PROGRAM_TO_KILL', sProcessName, iProcessNameLength);

    if not EnumProcesses(@aProcesses, sizeof(aProcesses), cbNeeded) then
    begin
      Exit;
    end;
    cProcesses := cbNeeded div sizeof(DWORD);

    for i := 0 to cProcesses - 1 do
    begin
      hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or PROCESS_TERMINATE, False, aProcesses[i]);
      try
      if hProcess <> 0 then
      begin
        if EnumProcessModules(hProcess, @hMod, sizeof(hMod), cbNeeded) then
        begin
          GetModuleBaseName(hProcess, hMod, szProcessName, sizeof(szProcessName));
          if UpperCase(szProcessName) = UpperCase(sProcessName) then
          begin
            TerminateProcess(hProcess, 0);
          end;
        end;
      end;
      finally
        CloseHandle(hProcess);
      end;                      
    end;
  finally
    StrDispose(sProcessName);
  end;

  Result:= ERROR_SUCCESS; //return success regardless of actual outcome
end;


function CheckIfUpgradeable(hInstall: MSIHandle): Integer; stdcall;
var
  Current_Notepad_version : PChar;
  Current_Notepad_version_Length  : Cardinal;
  sWinDir, sProgramFiles : string;
  bUpgradeableVersion : boolean;
  iNotepad_compare  : integer;
  sNotepad_version  : string;
  sNotepad_Location  : string;
  iResult : Cardinal;
begin
  bUpgradeableVersion := False;
  sWinDir := ExcludeTrailingBackslash(JclSysInfo.GetWindowsFolder);
  sProgramFiles := ExcludeTrailingBackslash(JclSysInfo.GetProgramFilesFolder);

  Current_Notepad_version_Length := MAX_PATH;
  Current_Notepad_version := StrAlloc(MAX_PATH);

  sNotepad_Location := sWinDir+'\system32\Notepad.exe';

  iResult := ERROR_SUCCESS;

  try
    //reads the value from "NOTEPAD_VERSION" that is stored in the PROPERTY table
    MsiGetProperty(hInstall, 'NOTEPAD_VERSION', Current_Notepad_version, Current_Notepad_version_Length);

    if Not (FileExists(sNotepad_Location)) then
    begin
      bUpgradeableVersion := True;
      LogString(hInstall,'Notepad.exe was not found at: "'+sNotepad_Location+'"');
      LogString(hInstall,'This version will be upgraded.');
      iResult := ERROR_SUCCESS;
      Exit;
    end;

    sNotepad_version := GetFmtFileVersion(sNotepad_Location);
    LogString(hInstall,'Found Notepad version="'+sNotepad_version+'"');  
    iNotepad_compare := CompareVersionNumbers(sNotepad_version,StrPas(Current_Notepad_version));

    if (iNotepad_compare < 0) then
    begin
      bUpgradeableVersion := False;
    end
    else
    begin
      bUpgradeableVersion := True;
    end;


    if bUpgradeableVersion then
    begin
      LogString(hInstall,'This version will be upgraded.');
      iResult := ERROR_SUCCESS;
    end
    else
    begin
      MsiSetProperty(hInstall,'UPGRADEABLE_VERSION','NO'); //this indicates failure -- this value is read by another custom action executed after this action
      LogString(hInstall,'ERROR: A newer version of this software is already installed. Setup cannot continue!');
      iResult := ERROR_SUCCESS;
    end;
  finally
    StrDispose(Current_Notepad_version);
  end;

  Result:= iResult; //this function always returns success, however it could return any of the values listed below
//
//Custom Action Return Values
//================================
//
//Return value                        Description
//
//ERROR_FUNCTION_NOT_CALLED           Action not executed.
//ERROR_SUCCESS                       Completed actions successfully.
//ERROR_INSTALL_USEREXIT              User terminated prematurely.
//ERROR_INSTALL_FAILURE               Unrecoverable error occurred.
//ERROR_NO_MORE_ITEMS                 Skip remaining actions, not an error.
//
end;

exports CheckIfUpgradeable;
exports KillRunningApp;

begin
end.

这里是支持单元“MSILogging.pas”。该单元可以在其他 MSI DLL 项目中按原样使用。

unit MSILogging;

interface

uses
  Windows,
  SysUtils,
  JwaMsi,
  JwaMsiQuery,
  JwaMSIDefs;

procedure LogString(hInstall: MSIHandle; sMsgString : string);
function MsiMessageBox(hInstall: MSIHandle; sMsgString : string; dwDlgFlags : integer): integer; 

implementation

procedure LogString(hInstall: MSIHandle; sMsgString : string);
var
  hNewMsiHandle : MSIHandle;
begin
  try
    hNewMsiHandle := MsiCreateRecord(2);

    sMsgString := '-- MSI_LOGGING -- ' + sMsgString;
    MsiRecordSetString(hNewMsiHandle, 0, PChar(sMsgString) );
    MsiProcessMessage(hInstall, INSTALLMESSAGE(INSTALLMESSAGE_INFO), hNewMsiHandle);
  finally
    MsiCloseHandle(hNewMsiHandle);
  end;
end;


function MsiMessageBox(hInstall: MSIHandle; sMsgString : string; dwDlgFlags : integer): integer;
var
  hNewMsiHandle : MSIHandle;
begin
  try
    hNewMsiHandle := MsiCreateRecord(2);
    MsiRecordSetString(hNewMsiHandle, 0, PChar(sMsgString) );
  finally
    MsiCloseHandle(hNewMsiHandle);
  end;

  //Result := (MsiProcessMessage(hInstall, INSTALLMESSAGE(dwDlgFlags), hNewMsiHandle));
    Result := (MsiProcessMessage(hInstall, INSTALLMESSAGE(INSTALLMESSAGE_USER + dwDlgFlags), hNewMsiHandle));
end;

end.
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

如何编写自定义操作 DLL 以在 MSI 中使用? 的相关文章

  • 检测反射 DLL 注入

    在过去的几年中 恶意软件 以及一些渗透测试工具 如 Metasploit 的 meterpreter 负载 已经开始使用反射 DLL 注入 PDF http www harmonysecurity com files HS P005 Ref
  • 在 Delphi 2007 中将具有透明度的位图保存为 PNG

    我有一个包含透明度信息的 Delphi 位图 32 位 我需要将其转换并保存为 PNG 文件 同时保留透明度 我目前拥有的工具是graphics32 Library GR32 PNG 由Christian Budde 提供 和PNGImag
  • Delphi - 如何获取 USB 可移动硬盘和记忆棒的列表?

    在我的应用程序 Delphi 中 我需要列出所有 USB 存储设备 这些可以是闪存棒or外部存储驱动器 有一个Jvcl成分JvDriveCombo 并且它有DriveType属性 问题是我是否选择DriveType Fixed那么除了外部驱
  • 查找Delphi项目中的所有编译错误

    我正在对我的 Delphi 项目进行一些重构 我希望能够做出改变 然后看看all项目中因该更改而中断的地方 类似于 Eclipse 列出项目的所有编译错误 在 Java 中 在 Delphi 中 我可以进行更改 然后重新编译我的项目 但编译
  • 在Delphi 7中,为什么我可以给const赋值?

    我将一些 Delphi 代码从一个项目复制到另一个项目 发现它在新项目中无法编译 但在旧项目中可以编译 代码看起来像这样 procedure TForm1 CalculateGP const Price money 0 begin Pric
  • 对象的引用计数

    在我的代码中 我使用一个小的数据存储类 它是在不同的地方创建的 为了避免内存泄漏并简化事情 我想使用引用计数 所以我这样做了 type TFileInfo class TInterfacedObject IInterface 并删除了我对
  • 如何在iOS的Delphi程序中使用IPv6协议

    我尝试在我的移动程序中使用 IPv6 协议 我的服务器位于 NAT 后面的 LAN 内 在服务器上我使用IP端口3000 我已经组织了从路由器端口 45500 到服务器端口 3000 的虚拟服务器 端口转发 在服务器上 我运行 ipconf
  • Delphi中使用FindVCLWindow调用WinHelp32(WinXP Pro SP3 32bit)

    有什么问题吗 procedure TForm1 VCLHelpClick Sender TObject var Ctrl TWinControl begin Ctrl FindVCLWindow Mouse CursorPos if Ctr
  • 在 Delphi 或 C++ Builder 中使用 Chromium Edge WebView2 [重复]

    这个问题在这里已经有答案了 既然 Microsoft Chromium Edge 已经最终确定 是否可以在 Delphi 或 C Builder 中使用它 据我了解 它是基于WebView2成分 是否有一个组件 例如TWebView2或者E
  • 从 Delphi VCL 样式获取特定字形

    我想从 VCL 样式获取特定的位图 并将其设置为按钮上的图像 它实际上是帮助问号 在位图样式编辑器中是来自表单的 btnHelp 图像 要从 VCL 样式获取视觉元素 字形 您必须使用GetElementDetails和TCustomSty
  • 将图像加载到 TImageList 并读取它们?

    我试图通过将 jpg 转换为 bmp 然后将其保存到 imagelist1 来将 jpg 加载到图像列表中 从上到下的代码片段 Selectdir 有效 fileexists 部分有效 这用于加载文件夹中的所有图像 所有图像都以 0 jpg
  • logback的“谨慎模式”是如何实现的?

    The 审慎模式 http logback qos ch manual appenders html prudentlogback 中的序列化所有 JVM 之间的 IO 操作 写入同一文件 可能运行在不同的主机上 在其他日志记录框架中 如果
  • 如何从该 JAVA 文件中提取 Delphi 类以与 Android 一起使用?

    我的Delphi XE7项目需要与FTDI FT311 Android 配件芯片 http www ftdichip com Products ICs FT311D html 他们帮助提供了一个 Android 演示 其中包括他们的 JAV
  • 如何在Delphi中将对象方法作为参数传递,然后调用它?

    我担心这可能是一个有点愚蠢的问题 但这让我很难过 我正在寻找将对象的方法传递到过程中的最简单的方法 以便过程可以调用对象的方法 例如 超时后 或者可能在不同的线程中 所以基本上我想 捕获对对象方法的引用 将该引用传递给过程 使用该引用 从过
  • 阻止 IDE 自动添加使用单位

    我正在将 Lazarus 项目转移到德尔福西雅图 Lazarus 项目依赖于 40 多个单元 包括控件 并具有多种应用程序 在所有项目的使用条款中 他们使用了以下内容 uses Classes SysUtils Forms Controls
  • H2161 重复资源[一个VCL项目可以有2个类名相同但命名空间不同的表单吗?]

    我尝试在 2 个不同的命名空间中创建具有相同类名的 2 个表单 FirstNameSpace ExampleFormName TExampleFormName SecondNameSpace ExampleFormName TExample
  • 在 Delphi 中淡入 alpha 混合 PNG 表单

    几年前 当 Vista 首次发布时 我曾提出过这个问题 但始终没有解决这个问题 并把它搁置起来 留待以后再考虑 我有一个启动屏幕 我花了很大力气让它看起来很棒 这是 32bpp alpha 混合的 PNG 我有一些代码 如果需要 我可以挖掘
  • 如何读取和更改 TEdit 控件的值?

    我有一个表格TForm1有 5TEdit and 2 TBitBtn 我还需要该程序 以便在输入数字数据后Edit1 and Edit2 on BitBtn1Click Edit1 and Edit2值将被求和并显示在Edit3 你想做这样
  • Delphi Prism 中 TStringList 的替代品。

    我正在将用 Delphi 2007 Net 编写的应用程序迁移到 Delphi Prism 哪个是替换 TStringList 和 TStrings 类的最佳选择 提前致谢 Bye 只需使用 NET 框架中内置的 List 类型 或者字符串
  • D2010编译行数差异

    构建项目时 有两个地方会报告源代码行数 在编译进度对话框中 项目下 信息 在 Delphi 2007 中 对于我们正在构建的项目 这两个数字是相同的 在 Delphi 2010 中 这两个数字截然不同 1st 计数多出 100 万行或 40

随机推荐