code_junkie

How do I write custom action DLL for use in an MSI?

Nov 12th, 2011
85
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.81 KB | None | 0 0
  1. library MsiHelper;
  2.  
  3. uses
  4. Windows,
  5. SysUtils,
  6. Classes,
  7. StrUtils,
  8. jwaMSI,
  9. jwaMSIDefs,
  10. jwaMSIQuery,
  11. JclSysInfo,
  12. PsApi,
  13. MSILogging in 'MSILogging.pas';
  14.  
  15. {$R *.res}
  16.  
  17.  
  18. function CompareVersionNumbers(AVersion1, AVersion2: string): Integer;
  19. var
  20. N1, N2: Integer;
  21. //Returns 1 if AVersion1 < AVersion2
  22. //Returns -1 if AVersion1 > AVersion2
  23. //Returns 0 if values are equal
  24. function GetNextNumber(var Version: string): Integer;
  25. var
  26. P: Integer;
  27. S: string;
  28. begin
  29. P := Pos('.', Version);
  30. if P > 0 then
  31. begin
  32. S := Copy(Version, 1, P - 1);
  33. Version := Copy(Version, P + 1, Length(Version) - P);
  34. end
  35. else
  36. begin
  37. S := Version;
  38. Version := '';
  39. end;
  40. if S = '' then
  41. Result := -1
  42. else
  43. try
  44. Result := StrToInt(S);
  45. except
  46. Result := -1;
  47. end;
  48. end;
  49.  
  50. begin
  51. Result := 0;
  52. repeat
  53. N1 := GetNextNumber(AVersion1);
  54. N2 := GetNextNumber(AVersion2);
  55. if N2 > N1 then
  56. begin
  57. Result := 1;
  58. Exit;
  59. end
  60. else
  61. if N2 < N1 then
  62. begin
  63. Result := -1;
  64. Exit;
  65. end
  66. until (AVersion1 = '') and (AVersion2 = '');
  67. end;
  68.  
  69. function GetFmtFileVersion(const FileName: String = ''; const Fmt: String = '%d.%d.%d.%d'): String;
  70. var
  71. sFileName: String;
  72. iBufferSize: DWORD;
  73. iDummy: DWORD;
  74. pBuffer: Pointer;
  75. pFileInfo: Pointer;
  76. iVer: array[1..4] of Word;
  77. begin
  78. // set default value
  79. Result := '';
  80. // get filename of exe/dll if no filename is specified
  81. sFileName := FileName;
  82. if (sFileName = '') then
  83. begin
  84. // prepare buffer for path and terminating #0
  85. SetLength(sFileName, MAX_PATH + 1);
  86. SetLength(sFileName,
  87. GetModuleFileName(hInstance, PChar(sFileName), MAX_PATH + 1));
  88. end;
  89. // get size of version info (0 if no version info exists)
  90. iBufferSize := GetFileVersionInfoSize(PChar(sFileName), iDummy);
  91. if (iBufferSize > 0) then
  92. begin
  93. GetMem(pBuffer, iBufferSize);
  94. try
  95. // get fixed file info (language independent)
  96. GetFileVersionInfo(PChar(sFileName), 0, iBufferSize, pBuffer);
  97. VerQueryValue(pBuffer, '', pFileInfo, iDummy);
  98. // read version blocks
  99. iVer[1] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
  100. iVer[2] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
  101. iVer[3] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
  102. iVer[4] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
  103. finally
  104. FreeMem(pBuffer);
  105. end;
  106. // format result string
  107. Result := Format(Fmt, [iVer[1], iVer[2], iVer[3], iVer[4]]);
  108. end;
  109. end;
  110.  
  111.  
  112. function KillRunningApp(hInstall: MSIHandle): Integer; stdcall;
  113. var
  114. aProcesses: array[0..1023] of DWORD;
  115. cbNeeded: DWORD;
  116. cProcesses: DWORD;
  117. i: integer;
  118. szProcessName: array[0..MAX_PATH - 1] of char;
  119. hProcess: THandle;
  120. hMod: HModule;
  121. sProcessName : PChar;
  122. iProcessNameLength : Cardinal;
  123. begin
  124. iProcessNameLength := MAX_PATH;
  125. sProcessName := StrAlloc(MAX_PATH);
  126.  
  127. try
  128. //reads the value from "PROGRAM_TO_KILL" that is stored in the PROPERTY table
  129. MsiGetProperty(hInstall, 'PROGRAM_TO_KILL', sProcessName, iProcessNameLength);
  130.  
  131. if not EnumProcesses(@aProcesses, sizeof(aProcesses), cbNeeded) then
  132. begin
  133. Exit;
  134. end;
  135. cProcesses := cbNeeded div sizeof(DWORD);
  136.  
  137. for i := 0 to cProcesses - 1 do
  138. begin
  139. hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or PROCESS_TERMINATE, False, aProcesses[i]);
  140. try
  141. if hProcess <> 0 then
  142. begin
  143. if EnumProcessModules(hProcess, @hMod, sizeof(hMod), cbNeeded) then
  144. begin
  145. GetModuleBaseName(hProcess, hMod, szProcessName, sizeof(szProcessName));
  146. if UpperCase(szProcessName) = UpperCase(sProcessName) then
  147. begin
  148. TerminateProcess(hProcess, 0);
  149. end;
  150. end;
  151. end;
  152. finally
  153. CloseHandle(hProcess);
  154. end;
  155. end;
  156. finally
  157. StrDispose(sProcessName);
  158. end;
  159.  
  160. Result:= ERROR_SUCCESS; //return success regardless of actual outcome
  161. end;
  162.  
  163.  
  164. function CheckIfUpgradeable(hInstall: MSIHandle): Integer; stdcall;
  165. var
  166. Current_Notepad_version : PChar;
  167. Current_Notepad_version_Length : Cardinal;
  168. sWinDir, sProgramFiles : string;
  169. bUpgradeableVersion : boolean;
  170. iNotepad_compare : integer;
  171. sNotepad_version : string;
  172. sNotepad_Location : string;
  173. iResult : Cardinal;
  174. begin
  175. bUpgradeableVersion := False;
  176. sWinDir := ExcludeTrailingBackslash(JclSysInfo.GetWindowsFolder);
  177. sProgramFiles := ExcludeTrailingBackslash(JclSysInfo.GetProgramFilesFolder);
  178.  
  179. Current_Notepad_version_Length := MAX_PATH;
  180. Current_Notepad_version := StrAlloc(MAX_PATH);
  181.  
  182. sNotepad_Location := sWinDir+'system32Notepad.exe';
  183.  
  184. iResult := ERROR_SUCCESS;
  185.  
  186. try
  187. //reads the value from "NOTEPAD_VERSION" that is stored in the PROPERTY table
  188. MsiGetProperty(hInstall, 'NOTEPAD_VERSION', Current_Notepad_version, Current_Notepad_version_Length);
  189.  
  190. if Not (FileExists(sNotepad_Location)) then
  191. begin
  192. bUpgradeableVersion := True;
  193. LogString(hInstall,'Notepad.exe was not found at: "'+sNotepad_Location+'"');
  194. LogString(hInstall,'This version will be upgraded.');
  195. iResult := ERROR_SUCCESS;
  196. Exit;
  197. end;
  198.  
  199. sNotepad_version := GetFmtFileVersion(sNotepad_Location);
  200. LogString(hInstall,'Found Notepad version="'+sNotepad_version+'"');
  201. iNotepad_compare := CompareVersionNumbers(sNotepad_version,StrPas(Current_Notepad_version));
  202.  
  203. if (iNotepad_compare < 0) then
  204. begin
  205. bUpgradeableVersion := False;
  206. end
  207. else
  208. begin
  209. bUpgradeableVersion := True;
  210. end;
  211.  
  212.  
  213. if bUpgradeableVersion then
  214. begin
  215. LogString(hInstall,'This version will be upgraded.');
  216. iResult := ERROR_SUCCESS;
  217. end
  218. else
  219. begin
  220. MsiSetProperty(hInstall,'UPGRADEABLE_VERSION','NO'); //this indicates failure -- this value is read by another custom action executed after this action
  221. LogString(hInstall,'ERROR: A newer version of this software is already installed. Setup cannot continue!');
  222. iResult := ERROR_SUCCESS;
  223. end;
  224. finally
  225. StrDispose(Current_Notepad_version);
  226. end;
  227.  
  228. Result:= iResult; //this function always returns success, however it could return any of the values listed below
  229. //
  230. //Custom Action Return Values
  231. //================================
  232. //
  233. //Return value Description
  234. //
  235. //ERROR_FUNCTION_NOT_CALLED Action not executed.
  236. //ERROR_SUCCESS Completed actions successfully.
  237. //ERROR_INSTALL_USEREXIT User terminated prematurely.
  238. //ERROR_INSTALL_FAILURE Unrecoverable error occurred.
  239. //ERROR_NO_MORE_ITEMS Skip remaining actions, not an error.
  240. //
  241. end;
  242.  
  243. exports CheckIfUpgradeable;
  244. exports KillRunningApp;
  245.  
  246. begin
  247. end.
  248.  
  249. unit MSILogging;
  250.  
  251. interface
  252.  
  253. uses
  254. Windows,
  255. SysUtils,
  256. JwaMsi,
  257. JwaMsiQuery,
  258. JwaMSIDefs;
  259.  
  260. procedure LogString(hInstall: MSIHandle; sMsgString : string);
  261. function MsiMessageBox(hInstall: MSIHandle; sMsgString : string; dwDlgFlags : integer): integer;
  262.  
  263. implementation
  264.  
  265. procedure LogString(hInstall: MSIHandle; sMsgString : string);
  266. var
  267. hNewMsiHandle : MSIHandle;
  268. begin
  269. try
  270. hNewMsiHandle := MsiCreateRecord(2);
  271.  
  272. sMsgString := '-- MSI_LOGGING -- ' + sMsgString;
  273. MsiRecordSetString(hNewMsiHandle, 0, PChar(sMsgString) );
  274. MsiProcessMessage(hInstall, INSTALLMESSAGE(INSTALLMESSAGE_INFO), hNewMsiHandle);
  275. finally
  276. MsiCloseHandle(hNewMsiHandle);
  277. end;
  278. end;
  279.  
  280.  
  281. function MsiMessageBox(hInstall: MSIHandle; sMsgString : string; dwDlgFlags : integer): integer;
  282. var
  283. hNewMsiHandle : MSIHandle;
  284. begin
  285. try
  286. hNewMsiHandle := MsiCreateRecord(2);
  287. MsiRecordSetString(hNewMsiHandle, 0, PChar(sMsgString) );
  288. finally
  289. MsiCloseHandle(hNewMsiHandle);
  290. end;
  291.  
  292. //Result := (MsiProcessMessage(hInstall, INSTALLMESSAGE(dwDlgFlags), hNewMsiHandle));
  293. Result := (MsiProcessMessage(hInstall, INSTALLMESSAGE(INSTALLMESSAGE_USER + dwDlgFlags), hNewMsiHandle));
  294. end;
  295.  
  296. end.
Add Comment
Please, Sign In to add comment