Создание кастомного файла DLL для использования в MSI

Delphi , Программа и Интерфейс , Инсталяция

При создании установщика (MSI) для вашего приложения может возникнуть необходимость в выполнении определенной логики в процессе установки. Одним из способов реализовать это является создание кастомного файла DLL, который будет содержать функции, выполняющие эту логику. В данной статье мы рассмотрим, как создать кастомный файл DLL на Object Pascal (Delphi) для использования в MSI.

Почему кастомный файл DLL?

Кастомный файл DLL позволяет выполнять сложную логику в процессе установки, такую как чтение/запись из таблицы свойств MSI, убийство процесса, определение необходимости обновления приложения и запись в лог MSI.

Пример кастомного файла DLL на Object Pascal (Delphi)

Ниже приведен пример кастомного файла DLL на Object Pascal (Delphi), который содержит две функции: CheckIfUpgradeable и KillRunningApp. Эти функции могут быть вызваны из MSI во время установки.

1. Создайте новый проект DLL в Delphi.
2. Добавьте следующие единицы в раздел "uses":

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

1. Добавьте следующий код в раздел "implementation":

{$R *.res}

function CompareVersionNumbers(AVersion1, AVersion2: string): Integer;
var
  N1, N2: Integer;
  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;

1. Добавьте следующий код в раздел "exports":

exports CheckIfUpgradeable;
exports KillRunningApp;

1. Добавьте следующий код в раздел "implementation" для единицы "MSILogging.pas":

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.

Использование кастомного файла DLL в MSI

После создания кастомного файла DLL, его необходимо использовать в MSI. Для этого:

1. Добавьте кастомный файл DLL в проект MSI.
2. Добавьте две новые строки в таблицу CustomAction:
   • Type: 133 (immediate execution), Action: CheckIfUpgradeable, Source: YourDLLName.dll, Target:
   • Type: 133 (immediate execution), Action: KillRunningApp, Source: YourDLLName.dll, Target:
3. Добавьте две новые строки в таблицу Property:
   • Name: NOTEPAD_VERSION, Value: 1.0.0.0 (или другая версия, которую вы хотите проверить)
   • Name: PROGRAM_TO_KILL, Value: Notepad.exe (или другое имя процесса, который вы хотитеkill)
4. Добавьте две новые строки в таблицу Condition:
   • Property: UPGRADEABLE_VERSION, Value: YES (это значение будет установлено кастомным действием CheckIfUpgradeable)
   • Property: PROGRAM_TO_KILL, Value: Notepad.exe (это значение будет прочитано кастомным действием KillRunningApp)

Теперь кастомный файл DLL будет использоваться в процессе установки MSI для выполнения кастомной логики.

Создано по материалам из источника по ссылке.

Создание кастомного файла DLL для использования в MSI.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Инсталяция ::