Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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+'system32Notepad.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.
- 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.
Add Comment
Please, Sign In to add comment