Ma solution est en Delphi, et nécessite les traductions de l'API JEDI open source que vous pouvez download here. Un problème que j'ai trouvé est que les exemples d'utilisation des en-têtes JwaMSI sont rares. Espérons que quelqu'un trouvera cela comme un exemple utile.
Voici l'unité principale, avec une 2ème unité de support la suivant (que vous pouvez inclure dans le même projet DLL). Créez simplement une nouvelle DLL (bibliothèque) dans Delphi et copiez/collez ce code. Cette unité exporte 2 fonctions qui peuvent être appelées depuis le MSI. Ils sont:
- CheckIfUpgradeable
- KillRunningApp
Ces deux fonctions lire une valeur de propriété de la table de la propriété, et définissez une valeur lorsque la complète. L'idée est qu'une deuxième action personnalisée peut alors lire cette propriété et lancer une erreur ou l'utiliser comme condition d'installation. Ce code est plus pour un exemple, et dans cet exemple ci-dessous, il vérifie si la version de 'notepad.exe' doit être mise à niveau (cela signifie que la version stockée dans la valeur de la table de propriétés "NOTEPAD_VERSON" est supérieur à la version de notepad.exe sur le système). Si ce n'est pas le cas, la propriété "UPGRADEABLE_VERSION" est définie sur "NO" (cette propriété est définie sur "YES" par défaut).
Ce code recherche également dans la table PROPERTY pour "PROGRAM_TO_KILL" et va tuer ce programme s'il est en cours d'exécution. Il doit inclure l'extension de fichier du programme à tuer, par ex. "Notepad.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.
Et voici l'unité de support "MSILogging.pas". Cette unité peut être utilisée telle quelle dans d'autres projets DLL MSI.
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.
Une autre bonne, mais plus, solution pour des actions personnalisées écrites en Delphi: http://community.flexerasoftware.com/showthread.php?124840-A-primer-on-custom-actions-written-in- Delphi – Mick