Setup.Install.pas 128 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978
  1. unit Setup.Install;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2025 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. Installation procedures
  8. }
  9. interface
  10. procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
  11. ChangesAssociations: Boolean);
  12. implementation
  13. uses
  14. Windows, Messages, ShlObj, RegStr, Classes, SysUtils, Forms,
  15. ISSigFunc, PathFunc, SHA256, UnsignedFunc,
  16. Shared.CommonFunc, Shared.CommonFunc.Vcl, Shared.FileClass,
  17. Shared.SetupMessageIDs, Shared.SetupTypes, Shared.Struct, Shared.VerInfoFunc,
  18. Compression.Base, Compression.SevenZipDLLDecoder,
  19. SetupLdrAndSetup.InstFunc, SetupLdrAndSetup.Messages, Setup.RedirFunc,
  20. Setup.DebugClient, Setup.DotNetFunc, Setup.DownloadFileFunc, Setup.InstFunc, Setup.InstFunc.Ole,
  21. Setup.ISSigVerifyFunc, Setup.FileExtractor, Setup.Install.HelperFunc, Setup.Helper,
  22. Setup.MainFunc, Setup.LoggingFunc, Setup.RegDLL, Setup.SecurityFunc,
  23. Setup.UninstallLog, Setup.WizardForm;
  24. type
  25. PRegisterFilesListRec = ^TRegisterFilesListRec;
  26. TRegisterFilesListRec = record
  27. Filename: String;
  28. Is64Bit, TypeLib, NoErrorMessages: Boolean;
  29. end;
  30. TUninstallExeCreated = (ueNone, ueNew, ueReplaced);
  31. procedure RecordStartInstall(const UninstLog: TUninstallLog);
  32. var
  33. AppDir: String;
  34. begin
  35. if shCreateAppDir in SetupHeader.Options then
  36. AppDir := WizardDirValue
  37. else
  38. AppDir := '';
  39. UninstLog.Add(utStartInstall, [GetComputerNameString, GetUserNameString,
  40. AppDir, GetLocalTimeAsStr], 0);
  41. end;
  42. procedure RecordCompiledCode(const UninstLog: TUninstallLog);
  43. var
  44. LeadBytesStr, ExpandedApp, ExpandedGroup, CustomMessagesStr: String;
  45. begin
  46. { Only use app if Setup creates one }
  47. if shCreateAppDir in SetupHeader.Options then
  48. ExpandedApp := ExpandConst('{app}')
  49. else
  50. ExpandedApp := '';
  51. try
  52. ExpandedGroup := ExpandConst('{group}');
  53. except
  54. { Yep, expanding "group" might fail with an exception }
  55. ExpandedGroup := '';
  56. end;
  57. if SetupHeader.CompiledCodeText <> '' then
  58. PackCustomMessagesIntoString(CustomMessagesStr);
  59. { Record [Code] even if empty to 'overwrite' old versions }
  60. UninstLog.Add(utCompiledCode, [PackCompiledCodeTextIntoString(SetupHeader.CompiledCodeText),
  61. LeadBytesStr, ExpandedApp, ExpandedGroup, WizardGroupValue,
  62. ExpandConst('{language}'), CustomMessagesStr], SetupBinVersion or Integer($80000000));
  63. end;
  64. procedure RegisterUninstallInfo(const UninstLog: TUninstallLog; const UninstallRegKeyBaseName: String;
  65. const AfterInstallFilesSize: Int64);
  66. { Stores uninstall information in the Registry so that the program can be
  67. uninstalled through the Control Panel Add/Remove Programs applet. }
  68. const
  69. AdminInstallModeNames: array [Boolean] of String =
  70. ('non administrative', 'administrative');
  71. BitInstallModeNames: array [Boolean] of String =
  72. ('32-bit', '64-bit');
  73. var
  74. RegView, OppositeRegView: TRegView;
  75. RegViewIs64Bit, OppositeRegViewIs64Bit: Boolean;
  76. RootKey, OppositeRootKey: HKEY;
  77. RootKeyIsHKLM, OppositeRootKeyIsHKLM: Boolean;
  78. SubkeyName: String;
  79. procedure SetStringValue(const K: HKEY; const ValueName: PChar;
  80. const Data: String);
  81. begin
  82. const ErrorCode = DWORD(RegSetValueEx(K, ValueName, 0, REG_SZ, PChar(Data),
  83. (ULength(Data)+1)*SizeOf(Data[1])));
  84. if ErrorCode <> ERROR_SUCCESS then
  85. RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode);
  86. end;
  87. procedure SetStringValueUnlessEmpty(const K: HKEY; const ValueName: PChar;
  88. const Data: String);
  89. begin
  90. if Data <> '' then
  91. SetStringValue(K, ValueName, Data);
  92. end;
  93. procedure SetDWordValue(const K: HKEY; const ValueName: PChar;
  94. const Data: DWord);
  95. begin
  96. const ErrorCode = DWORD(RegSetValueEx(K, ValueName, 0, REG_DWORD, @Data,
  97. SizeOf(Data)));
  98. if ErrorCode <> ERROR_SUCCESS then
  99. RegError(reRegSetValueEx, RootKey, SubkeyName, ErrorCode);
  100. end;
  101. function GetInstallDateString: String;
  102. var
  103. ST: TSystemTime;
  104. begin
  105. GetLocalTime(ST);
  106. Result := Format('%.4u%.2u%.2u', [ST.wYear, ST.wMonth, ST.wDay]);
  107. end;
  108. function ExtractMajorMinorVersion(Version: String; var Major, Minor: Cardinal): Boolean;
  109. var
  110. P, I: Integer;
  111. begin
  112. P := Pos('.', Version);
  113. if P <> 0 then begin
  114. Val(Copy(Version, 1, P-1), Major, I);
  115. if I = 0 then begin
  116. Delete(Version, 1, P);
  117. P := Pos('.', Version);
  118. if P <> 0 then
  119. Val(Copy(Version, 1, P-1), Minor, I)
  120. else
  121. Val(Version, Minor, I);
  122. end;
  123. end else begin
  124. Val(Version, Major, I);
  125. Minor := 0;
  126. end;
  127. Result := I = 0;
  128. end;
  129. { Also see Main.pas }
  130. function ExistingInstallationAt(const RegView: TRegView; const RootKey: HKEY): Boolean;
  131. var
  132. K: HKEY;
  133. begin
  134. if RegOpenKeyExView(RegView, RootKey, PChar(SubkeyName), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  135. Result := True;
  136. RegCloseKey(K);
  137. end else
  138. Result := False;
  139. end;
  140. procedure HandleDuplicateDisplayNames(var DisplayName: String);
  141. const
  142. UninstallDisplayNameMarksUser: array [Boolean] of TSetupMessageId =
  143. (msgUninstallDisplayNameMarkCurrentUser, msgUninstallDisplayNameMarkAllUsers);
  144. UninstallDisplayNameMarksBits: array [Boolean] of TSetupMessageId =
  145. (msgUninstallDisplayNameMark32Bit, msgUninstallDisplayNameMark64Bit);
  146. var
  147. ExistingAtOppositeAdminInstallMode, ExistingAtOpposite64BitInstallMode: Boolean;
  148. begin
  149. { Check opposite administrative install mode. }
  150. ExistingAtOppositeAdminInstallMode := ExistingInstallationAt(RegView, OppositeRootKey);
  151. if RootKeyIsHKLM or not IsWin64 then begin
  152. { Opposite (HKCU) is shared for 32-bit and 64-bit so don't log bitness. Also don't log bitness on a 32-bit system. }
  153. LogFmt('Detected previous %s install? %s',
  154. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always False}], SYesNo[ExistingAtOppositeAdminInstallMode]])
  155. end else begin
  156. { Opposite (HKLM) is not shared for 32-bit and 64-bit so log bitness. }
  157. LogFmt('Detected previous %s %s install? %s',
  158. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit], SYesNo[ExistingAtOppositeAdminInstallMode]]);
  159. end;
  160. if IsWin64 then begin
  161. { Check opposite 32-bit or 64-bit install mode. }
  162. if RootKeyIsHKLM then begin
  163. { HKLM is not shared for 32-bit and 64-bit so check it for opposite 32-bit or 64-bit install mode. Not checking HKCU
  164. since HKCU is shared for 32-bit and 64-bit mode and we already checked HKCU above. }
  165. ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, RootKey {always HKLM});
  166. LogFmt('Detected previous %s %s install? %s',
  167. [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]);
  168. end else begin
  169. { HKCU is shared for 32-bit and 64-bit so not checking it but we do still need to check HKLM for opposite 32-bit or
  170. 64-bit install mode since we haven't already done that. }
  171. ExistingAtOpposite64BitInstallMode := ExistingInstallationAt(OppositeRegView, OppositeRootKey {always HKLM});
  172. if ExistingAtOpposite64BitInstallMode then
  173. ExistingAtOppositeAdminInstallMode := True;
  174. LogFmt('Detected previous %s %s install? %s',
  175. [AdminInstallModeNames[OppositeRootKeyIsHKLM {always True}], BitInstallModeNames[OppositeRegViewIs64Bit], SYesNo[ExistingAtOpposite64BitInstallMode]]);
  176. end;
  177. end else
  178. ExistingAtOpposite64BitInstallMode := False;
  179. { Mark new display name if needed. Note: currently we don't attempt to mark existing display names as well. }
  180. if ExistingAtOppositeAdminInstallMode or ExistingAtOpposite64BitInstallMode then begin
  181. if ExistingAtOppositeAdminInstallMode and ExistingAtOpposite64BitInstallMode then
  182. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMarks,
  183. [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]],
  184. SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]])
  185. else if ExistingAtOppositeAdminInstallMode then
  186. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark,
  187. [DisplayName, SetupMessages[UninstallDisplayNameMarksUser[RootKeyIsHKLM]]])
  188. else
  189. DisplayName := FmtSetupMessage(msgUninstallDisplayNameMark,
  190. [DisplayName, SetupMessages[UninstallDisplayNameMarksBits[RegViewIs64Bit]]]);
  191. LogFmt('Marked uninstall display name to avoid duplicate entries. New display name: %s', [DisplayName]);
  192. end;
  193. end;
  194. var
  195. H2: HKEY;
  196. Z: String;
  197. EstimatedSize: Int64;
  198. begin
  199. RegView := InstallDefaultRegView;
  200. RegViewIs64Bit := RegView = rv64Bit;
  201. if RegViewIs64Bit then
  202. OppositeRegView := rv32Bit
  203. else
  204. OppositeRegView := rv64Bit;
  205. OppositeRegViewIs64Bit := not RegViewIs64Bit;
  206. RootKey := InstallModeRootKey;
  207. RootKeyIsHKLM := RootKey = HKEY_LOCAL_MACHINE;
  208. if RootKeyIsHKLM then
  209. OppositeRootKey := HKEY_CURRENT_USER
  210. else
  211. OppositeRootKey := HKEY_LOCAL_MACHINE;
  212. OppositeRootKeyIsHKLM := not RootKeyIsHKLM;
  213. SubkeyName := GetUninstallRegSubkeyName(UninstallRegKeyBaseName);
  214. if ExistingInstallationAt(RegView, RootKey) then begin
  215. if RootKeyIsHKLM then begin
  216. { HKLM is not shared for 32-bit and 64-bit so log bitness. }
  217. LogFmt('Deleting uninstall key left over from previous %s %s install.',
  218. [AdminInstallModeNames[RootKeyIsHKLM {always True}], BitInstallModeNames[RegViewIs64Bit]]);
  219. end else begin
  220. { HKCU is shared for 32-bit and 64-bit so don't log bitness. }
  221. LogFmt('Deleting uninstall key left over from previous %s install.',
  222. [AdminInstallModeNames[RootKeyIsHKLM {always False}]])
  223. end;
  224. RegDeleteKeyIncludingSubkeys(RegView, RootKey, PChar(SubkeyName));
  225. end;
  226. LogFmt('Creating new uninstall key: %s\%s', [GetRegRootKeyName(RootKey), SubkeyName]);
  227. { Create uninstall key }
  228. const ErrorCode = DWORD(RegCreateKeyExView(RegView, RootKey, PChar(SubkeyName),
  229. 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, H2, nil));
  230. if ErrorCode <> ERROR_SUCCESS then
  231. RegError(reRegCreateKeyEx, RootKey, SubkeyName, ErrorCode);
  232. try
  233. Log('Writing uninstall key values.');
  234. { do not localize or change any of the following strings }
  235. SetStringValue(H2, 'Inno Setup: Setup Version', SetupVersion);
  236. if shCreateAppDir in SetupHeader.Options then
  237. Z := WizardDirValue
  238. else
  239. Z := '';
  240. SetStringValue(H2, 'Inno Setup: App Path', Z);
  241. SetStringValueUnlessEmpty(H2, 'InstallLocation', AddBackslash(Z));
  242. SetStringValue(H2, 'Inno Setup: Icon Group', WizardGroupValue);
  243. if WizardNoIcons then
  244. SetDWordValue(H2, 'Inno Setup: No Icons', 1);
  245. SetStringValue(H2, 'Inno Setup: User', GetUserNameString);
  246. if WizardSetupType <> nil then begin
  247. SetStringValue(H2, 'Inno Setup: Setup Type', WizardSetupType.Name);
  248. SetStringValue(H2, 'Inno Setup: Selected Components', StringsToCommaString(WizardComponents));
  249. SetStringValue(H2, 'Inno Setup: Deselected Components', StringsToCommaString(WizardDeselectedComponents));
  250. end;
  251. if HasTasks then begin
  252. SetStringValue(H2, 'Inno Setup: Selected Tasks', StringsToCommaString(WizardTasks));
  253. SetStringValue(H2, 'Inno Setup: Deselected Tasks', StringsToCommaString(WizardDeselectedTasks));
  254. end;
  255. if shUserInfoPage in SetupHeader.Options then begin
  256. SetStringValue(H2, 'Inno Setup: User Info: Name', WizardUserInfoName);
  257. SetStringValue(H2, 'Inno Setup: User Info: Organization', WizardUserInfoOrg);
  258. SetStringValue(H2, 'Inno Setup: User Info: Serial', WizardUserInfoSerial);
  259. end;
  260. SetStringValue(H2, 'Inno Setup: Language', PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name);
  261. if SetupHeader.UninstallDisplayName <> '' then
  262. Z := ExpandConst(SetupHeader.UninstallDisplayName)
  263. else
  264. Z := ExpandedAppVerName;
  265. HandleDuplicateDisplayNames(Z);
  266. { For the entry to appear in ARP, DisplayName cannot exceed 259 characters
  267. on Windows 2000 and later. }
  268. SetStringValue(H2, 'DisplayName', Copy(Z, 1, 259));
  269. SetStringValueUnlessEmpty(H2, 'DisplayIcon', ExpandConst(SetupHeader.UninstallDisplayIcon));
  270. var ExtraUninstallString: String;
  271. if shUninstallLogging in SetupHeader.Options then
  272. ExtraUninstallString := ' /LOG'
  273. else
  274. ExtraUninstallString := '';
  275. SetStringValue(H2, 'UninstallString', '"' + UninstallExeFilename + '"' + ExtraUninstallString);
  276. SetStringValue(H2, 'QuietUninstallString', '"' + UninstallExeFilename + '" /SILENT' + ExtraUninstallString);
  277. SetStringValueUnlessEmpty(H2, 'DisplayVersion', ExpandConst(SetupHeader.AppVersion));
  278. SetStringValueUnlessEmpty(H2, 'Publisher', ExpandConst(SetupHeader.AppPublisher));
  279. SetStringValueUnlessEmpty(H2, 'URLInfoAbout', ExpandConst(SetupHeader.AppPublisherURL));
  280. SetStringValueUnlessEmpty(H2, 'HelpTelephone', ExpandConst(SetupHeader.AppSupportPhone));
  281. SetStringValueUnlessEmpty(H2, 'HelpLink', ExpandConst(SetupHeader.AppSupportURL));
  282. SetStringValueUnlessEmpty(H2, 'URLUpdateInfo', ExpandConst(SetupHeader.AppUpdatesURL));
  283. SetStringValueUnlessEmpty(H2, 'Readme', ExpandConst(SetupHeader.AppReadmeFile));
  284. SetStringValueUnlessEmpty(H2, 'Contact', ExpandConst(SetupHeader.AppContact));
  285. SetStringValueUnlessEmpty(H2, 'Comments', ExpandConst(SetupHeader.AppComments));
  286. Z := ExpandConst(SetupHeader.AppModifyPath);
  287. if Z <> '' then
  288. SetStringValue(H2, 'ModifyPath', Z)
  289. else
  290. SetDWordValue(H2, 'NoModify', 1);
  291. SetDWordValue(H2, 'NoRepair', 1);
  292. SetStringValue(H2, 'InstallDate', GetInstallDateString);
  293. var MajorVersion, MinorVersion: Cardinal;
  294. if ExtractMajorMinorVersion(ExpandConst(SetupHeader.AppVersion), MajorVersion, MinorVersion) then begin
  295. { Originally MSDN said to write to Major/MinorVersion, now it says to write to VersionMajor/Minor. So write to both. }
  296. SetDWordValue(H2, 'MajorVersion', MajorVersion);
  297. SetDWordValue(H2, 'MinorVersion', MinorVersion);
  298. SetDWordValue(H2, 'VersionMajor', MajorVersion);
  299. SetDWordValue(H2, 'VersionMinor', MinorVersion);
  300. end;
  301. { Note: Windows 7 (and later?) doesn't automatically calculate sizes so set EstimatedSize ourselves. }
  302. if SetupHeader.UninstallDisplaySize = 0 then begin
  303. { Estimate the size by taking the size of all files and adding any ExtraDiskSpaceRequired. }
  304. EstimatedSize := AfterInstallFilesSize + SetupHeader.ExtraDiskSpaceRequired;
  305. for var I := 0 to Entries[seComponent].Count-1 do begin
  306. with PSetupComponentEntry(Entries[seComponent][I])^ do begin
  307. if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') then
  308. Inc(EstimatedSize, ExtraDiskSpaceRequired);
  309. end;
  310. end;
  311. end else
  312. EstimatedSize := SetupHeader.UninstallDisplaySize;
  313. { ARP on Windows 7 without SP1 only pays attention to the lower 6 bytes of EstimatedSize and
  314. throws away the rest. For example putting in $4000001 (=4GB + 1KB) displays as 1 KB.
  315. So we need to check for this. }
  316. if (Hi(NTServicePackLevel) > 0) or IsWindows8 or (EstimatedSize <= High(Cardinal)) then begin
  317. EstimatedSize := EstimatedSize div 1024;
  318. SetDWordValue(H2, 'EstimatedSize', DWORD(EstimatedSize));
  319. end;
  320. { Also see SetPreviousData in ScriptFunc.pas }
  321. if CodeRunner <> nil then begin
  322. try
  323. CodeRunner.RunProcedures('RegisterPreviousData', [Integer(H2)], False);
  324. except
  325. Log('RegisterPreviousData raised an exception.');
  326. Application.HandleException(nil);
  327. end;
  328. end;
  329. finally
  330. RegCloseKey(H2);
  331. end;
  332. UninstLog.AddReg(utRegDeleteEntireKey, RegView, RootKey,
  333. [SubkeyName]);
  334. end;
  335. type
  336. TMakeDirFlags = set of (mdNoUninstall, mdAlwaysUninstall, mdDeleteAfterInstall,
  337. mdNotifyChange);
  338. function MakeDir(const UninstLog: TUninstallLog; const DisableFsRedir: Boolean; Dir: String;
  339. const Flags: TMakeDirFlags): Boolean;
  340. { Returns True if a new directory was created.
  341. Note: If DisableFsRedir is True, the mdNotifyChange flag should not be
  342. specified; it won't work properly. }
  343. var
  344. ErrorCode: DWORD;
  345. UninstFlags: Longint;
  346. begin
  347. Result := False;
  348. Dir := RemoveBackslashUnlessRoot(PathExpand(Dir));
  349. if PathExtractName(Dir) = '' then { reached root? }
  350. Exit;
  351. if DirExistsRedir(DisableFsRedir, Dir) then begin
  352. if not(mdAlwaysUninstall in Flags) then
  353. Exit;
  354. end
  355. else begin
  356. MakeDir(UninstLog, DisableFsRedir, PathExtractDir(Dir), Flags - [mdAlwaysUninstall]);
  357. LogFmt('Creating directory: %s', [Dir]);
  358. if not CreateDirectoryRedir(DisableFsRedir, Dir) then begin
  359. ErrorCode := GetLastError;
  360. raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
  361. [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
  362. Win32ErrorString(ErrorCode)]));
  363. end;
  364. Result := True;
  365. if mdNotifyChange in Flags then begin
  366. SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(Dir), nil);
  367. SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
  368. PChar(PathExtractDir(Dir)), nil);
  369. end;
  370. end;
  371. if mdDeleteAfterInstall in Flags then
  372. DeleteDirsAfterInstallList.AddObject(Dir, Pointer(Ord(DisableFsRedir)))
  373. else begin
  374. if not(mdNoUninstall in Flags) then begin
  375. UninstFlags := utDeleteDirOrFiles_IsDir;
  376. if DisableFsRedir then
  377. UninstFlags := UninstFlags or utDeleteDirOrFiles_DisableFsRedir;
  378. if mdNotifyChange in Flags then
  379. UninstFlags := UninstFlags or utDeleteDirOrFiles_CallChangeNotify;
  380. UninstLog.Add(utDeleteDirOrFiles, [Dir], UninstFlags);
  381. end;
  382. end;
  383. end;
  384. procedure CreateDirs(const UninstLog: TUninstallLog);
  385. { Creates the application's directories }
  386. procedure ApplyPermissions(const DisableFsRedir: Boolean;
  387. const Filename: String; const PermsEntry: Integer);
  388. var
  389. P: PSetupPermissionEntry;
  390. begin
  391. if PermsEntry <> -1 then begin
  392. LogFmt('Setting permissions on directory: %s', [Filename]);
  393. const RedirFilename = ApplyPathRedirRules(DisableFsRedir, Filename);
  394. if RedirFilename <> Filename then
  395. LogFmt(#$2514#$2500' Redirected path: %s', [RedirFilename]);
  396. P := Entries[sePermission][PermsEntry];
  397. if not GrantPermissionOnFile(False, RedirFilename,
  398. TGrantPermissionEntry(Pointer(P.Permissions)^),
  399. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
  400. LogFmt('Failed to set permissions on directory (%d).', [GetLastError]);
  401. end;
  402. end;
  403. procedure ApplyNTFSCompression(const DisableFsRedir: Boolean;
  404. const Filename: String; const Compress: Boolean);
  405. begin
  406. if Compress then
  407. LogFmt('Setting NTFS compression on directory: %s', [Filename])
  408. else
  409. LogFmt('Unsetting NTFS compression on directory: %s', [Filename]);
  410. if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then
  411. LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
  412. end;
  413. var
  414. Flags: TMakeDirFlags;
  415. N: String;
  416. begin
  417. { Create main application directory }
  418. MakeDir(UninstLog, InstallDefaultDisableFsRedir, WizardDirValue, []);
  419. { Create the rest of the directories, if any }
  420. for var CurDirNumber := 0 to Entries[seDir].Count-1 do
  421. with PSetupDirEntry(Entries[seDir][CurDirNumber])^ do begin
  422. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  423. DebugNotifyEntry(seDir, CurDirNumber);
  424. NotifyBeforeInstallEntry(BeforeInstall);
  425. Flags := [];
  426. if doUninsNeverUninstall in Options then Include(Flags, mdNoUninstall);
  427. if doDeleteAfterInstall in Options then Include(Flags, mdDeleteAfterInstall);
  428. if doUninsAlwaysUninstall in Options then Include(Flags, mdAlwaysUninstall);
  429. N := RemoveBackslashUnlessRoot(PathExpand(ExpandConst(DirName)));
  430. MakeDir(UninstLog, InstallDefaultDisableFsRedir, N, Flags);
  431. AddAttributesToFile(InstallDefaultDisableFsRedir, N, Attribs);
  432. ApplyPermissions(InstallDefaultDisableFsRedir, N, PermissionsEntry);
  433. if (doSetNTFSCompression in Options) or (doUnsetNTFSCompression in Options) then
  434. ApplyNTFSCompression(InstallDefaultDisableFsRedir, N, doSetNTFSCompression in Options);
  435. NotifyAfterInstallEntry(AfterInstall);
  436. end;
  437. end;
  438. end;
  439. procedure BindUninstallMsgDataToExe(const ExpandedAppId: String; const F: TFile);
  440. var
  441. UniqueValue: TSHA256Digest;
  442. UninstallerMsgTail: TUninstallerMsgTail;
  443. begin
  444. F.SeekToEnd;
  445. { First append the hash of AppId so that unins*.exe files from different
  446. applications won't have the same file hash. This is done to combat broken
  447. anti-spyware programs that catch all unins*.exe files with certain hash
  448. sums just because some piece of spyware was deployed with Inno Setup and
  449. had the unins*.exe file in its directory. }
  450. UniqueValue := GetSHA256OfUnicodeString(ExpandedAppId);
  451. F.WriteBuffer(UniqueValue, SizeOf(UniqueValue));
  452. UninstallerMsgTail.ID := UninstallerMsgTailID;
  453. UninstallerMsgTail.Offset := F.Position;
  454. WriteMsgData(F);
  455. F.WriteBuffer(UninstallerMsgTail, SizeOf(UninstallerMsgTail));
  456. end;
  457. procedure DoHandleFailedDeleteOrMoveFileTry(const CurFile: PSetupFileEntry;
  458. const DisableFsRedir: Boolean; const Func, TempFile, DestFile: String;
  459. const LastError: DWORD; var RetriesLeft: Integer; var LastOperation: String;
  460. var NeedsRestart, ReplaceOnRestart: Boolean;
  461. var NextAction: TFileOperationFailingNextAction);
  462. begin
  463. { Automatically retry. Wait with replace on restart until no
  464. retries left, unless we already know we're going to restart. }
  465. if ((RetriesLeft = 0) or NeedsRestart) and
  466. (foRestartReplace in CurFile^.Options) and IsAdmin then begin
  467. LogFmt('%s: The existing file appears to be in use (%d). ' +
  468. 'Will replace on restart.', [Func, LastError]);
  469. LastOperation := SetupMessages[msgErrorRestartReplace];
  470. NeedsRestart := True;
  471. RestartReplace(DisableFsRedir, TempFile, DestFile);
  472. ReplaceOnRestart := True;
  473. NextAction := naStopAndSucceed;
  474. end else if RetriesLeft > 0 then begin
  475. LogFmt('%s: The existing file appears to be in use (%d). ' +
  476. 'Retrying.', [Func, LastError]);
  477. Dec(RetriesLeft);
  478. Sleep(1000);
  479. ProcessEvents;
  480. NextAction := naRetry;
  481. end;
  482. end;
  483. type
  484. TOverwriteAll = (oaUnknown, oaOverwrite, oaKeep);
  485. procedure ProcessFileEntry(const UninstLog: TUninstallLog; const ExpandedAppId: String;
  486. const RegisterFilesList: TList; const CurFile: PSetupFileEntry;
  487. const DisableFsRedir: Boolean; AExternalSourceFile, ADestFile: String;
  488. const FileLocationFilenames: TStringList; const AExternalSize: Int64;
  489. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  490. var WarnedPerUserFonts: Boolean; const AExternalFileDate: PFileTime;
  491. var UninstallTempExeFilename: String; var UninstallExeCreated: TUninstallExeCreated);
  492. { Not external: AExternalSourceFile and ADestFile should be empty strings,
  493. FileLocationFilenames should be set, AExternalSize is unused,
  494. AExternalFileDate should not be set
  495. External : Opposite except AExternalFileDate still not set
  496. Ext. Archive: Same as external except AExternalFileDate set and
  497. AExternalSourceFile should be set to ArchiveFindHandle as a string
  498. Ext. Downl. : Same as external except
  499. AExternalSourceFile should be set to an URL }
  500. procedure InstallFont(const Filename, FontName: String;
  501. const PerUserFont, AddToFontTableNow: Boolean; var WarnedPerUserFonts: Boolean);
  502. var
  503. RootKey, K: HKEY;
  504. begin
  505. if PerUserFont and not WindowsVersionAtLeast(10, 0, 17134) then begin
  506. { Per-user fonts require Windows 10 Version 1803 (10.0.17134) or newer. }
  507. if not WarnedPerUserFonts then begin
  508. Log('Failed to set value in Fonts registry key: per-user fonts are not supported by this version of Windows.');
  509. WarnedPerUserFonts := True;
  510. end;
  511. end else begin
  512. { 64-bit Windows note: The Fonts key is evidently exempt from registry
  513. redirection. When a 32-bit app writes to the Fonts key, it's the main
  514. 64-bit key that is modified. (There is actually a Fonts key under
  515. Wow6432Node but it appears it's never used or updated.)
  516. Also: We don't bother with any FS redirection stuff here. I'm not sure
  517. it's safe to disable FS redirection when calling AddFontResource, or
  518. if it would even work. Users should be installing their fonts to the
  519. Fonts directory instead of the System directory anyway. }
  520. if PerUserFont then
  521. RootKey := HKEY_CURRENT_USER
  522. else
  523. RootKey := HKEY_LOCAL_MACHINE;
  524. if RegOpenKeyExView(rvDefault, RootKey, 'Software\Microsoft\Windows NT\CurrentVersion\Fonts', 0,
  525. KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  526. if RegSetValueEx(K, PChar(FontName), 0, REG_SZ, PChar(Filename),
  527. (ULength(Filename)+1)*SizeOf(Filename[1])) <> ERROR_SUCCESS then
  528. Log('Failed to set value in Fonts registry key.');
  529. RegCloseKey(K);
  530. end
  531. else
  532. Log('Failed to open Fonts registry key.');
  533. end;
  534. if AddToFontTableNow then begin
  535. repeat
  536. { Note: AddFontResource doesn't set the thread's last error code }
  537. if AddFontResource(PChar(Filename)) <> 0 then begin
  538. SendNotifyMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
  539. Break;
  540. end;
  541. until AbortRetryIgnoreTaskDialogMsgBox(
  542. AddPeriod(FmtSetupMessage1(msgErrorFunctionFailedNoCode, 'AddFontResource')),
  543. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
  544. end;
  545. end;
  546. procedure SetFileLocationFilename(const LocationEntry: Integer;
  547. Filename: String);
  548. var
  549. LowercaseFilename: String;
  550. Hash: Longint;
  551. I: Integer;
  552. begin
  553. Filename := PathExpand(Filename);
  554. LowercaseFilename := PathLowercase(Filename);
  555. Hash := GetCRC32(LowercaseFilename[1], ULength(LowercaseFilename)*SizeOf(LowercaseFilename[1]));
  556. { If Filename was already associated with another LocationEntry,
  557. disassociate it. If we *don't* do this, then this script won't
  558. produce the expected result:
  559. [Files]
  560. Source: "fileA"; DestName: "file2"
  561. Source: "fileB"; DestName: "file2"
  562. Source: "fileA"; DestName: "file1"
  563. 1. It extracts fileA under the name "file2"
  564. 2. It extracts fileB under the name "file2"
  565. 3. It copies file2 to file1, thinking a copy of fileA was still
  566. stored in file2.
  567. }
  568. for I := 0 to FileLocationFilenames.Count-1 do
  569. if (Longint(FileLocationFilenames.Objects[I]) = Hash) and
  570. (PathLowercase(FileLocationFilenames[I]) = LowercaseFilename) then begin
  571. FileLocationFilenames[I] := '';
  572. FileLocationFilenames.Objects[I] := nil;
  573. Break;
  574. end;
  575. FileLocationFilenames[LocationEntry] := Filename;
  576. FileLocationFilenames.Objects[LocationEntry] := Pointer(Hash);
  577. end;
  578. procedure ApplyPermissions(const DisableFsRedir: Boolean;
  579. const Filename: String; const PermsEntry: Integer);
  580. var
  581. P: PSetupPermissionEntry;
  582. begin
  583. if PermsEntry <> -1 then begin
  584. LogFmt('Setting permissions on file: %s', [Filename]);
  585. const RedirFilename = ApplyPathRedirRules(DisableFsRedir, Filename);
  586. if RedirFilename <> Filename then
  587. LogFmt(#$2514#$2500' Redirected path: %s', [RedirFilename]);
  588. const Attr = GetFileAttributes(PChar(RedirFilename));
  589. if Attr = INVALID_FILE_ATTRIBUTES then
  590. LogWithLastError('Cannot set permissions; failed to read file attributes.')
  591. else if Attr and FILE_ATTRIBUTE_DIRECTORY <> 0 then
  592. Log('Cannot set permissions; a directory exists at that path.')
  593. else begin
  594. P := Entries[sePermission][PermsEntry];
  595. if not GrantPermissionOnFile(False, RedirFilename,
  596. TGrantPermissionEntry(Pointer(P.Permissions)^),
  597. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then
  598. LogFmt('Failed to set permissions on file (%d).', [GetLastError]);
  599. end;
  600. end;
  601. end;
  602. procedure ApplyNTFSCompression(const DisableFsRedir: Boolean;
  603. const Filename: String; const Compress: Boolean);
  604. begin
  605. if Compress then
  606. LogFmt('Setting NTFS compression on file: %s', [Filename])
  607. else
  608. LogFmt('Unsetting NTFS compression on file: %s', [Filename]);
  609. if not SetNTFSCompressionRedir(DisableFsRedir, Filename, Compress) then
  610. LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
  611. end;
  612. function AskOverwrite(const DestFile, Instruction, Caption: string; const ButtonLabels: array of String;
  613. const VerificationText: String; const Typ: TMsgBoxType; const Default, Overwrite: Integer;
  614. var OverwriteAll: TOverwriteAll): Boolean;
  615. var
  616. VerificationFlagChecked: BOOL;
  617. begin
  618. if OverwriteAll = oaKeep then
  619. Result := False { The user already said to keep (=not overwrite) all }
  620. else begin
  621. Result := LoggedTaskDialogMsgBox('', Instruction, DestFile + SNewLine2 + Caption, '',
  622. Typ, MB_YESNO, ButtonLabels, 0, True, Default, VerificationText, @VerificationFlagChecked) = Overwrite;
  623. if VerificationFlagChecked then begin
  624. if Result then
  625. OverwriteAll := oaOverwrite
  626. else
  627. OverwriteAll := oaKeep;
  628. end;
  629. end;
  630. end;
  631. var
  632. ProgressUpdated: Boolean;
  633. LastOperation: String;
  634. CurFileLocation: PSetupFileLocationEntry;
  635. SourceFile, DestFile, TempFile, FontFilename: String;
  636. DestFileExists, DestFileExistedBefore, CheckedDestFileExistedBefore,
  637. TempFileLeftOver, AllowFileToBeDuplicated, ReplaceOnRestart: Boolean;
  638. Failed: String;
  639. CurFileVersionInfoValid: Boolean;
  640. CurFileVersionInfo, ExistingVersionInfo: TFileVersionNumbers;
  641. CurFileDateValid, ExistingFileDateValid: Boolean;
  642. IsProtectedFile, AllowTimeStampComparison: Boolean;
  643. DeleteFlags: Longint;
  644. CurFileDate, ExistingFileDate: TFileTime;
  645. RegisterRec: PRegisterFilesListRec;
  646. DestF, SourceF: TFile;
  647. Flags: TMakeDirFlags;
  648. Overwrite, PerUserFont: Boolean;
  649. label Retry, Skip;
  650. begin
  651. Log('-- File entry --');
  652. CheckedDestFileExistedBefore := False;
  653. DestFileExistedBefore := False; { prevent warning }
  654. if CurFile^.LocationEntry <> -1 then
  655. CurFileLocation := PSetupFileLocationEntry(Entries[seFileLocation][CurFile^.LocationEntry])
  656. else
  657. CurFileLocation := nil;
  658. Retry:
  659. DestFile := '';
  660. TempFile := '';
  661. TempFileLeftOver := False;
  662. ProgressUpdated := False;
  663. var PreviousProgress := CurProgress;
  664. LastOperation := '';
  665. Failed := '';
  666. try
  667. try
  668. ReplaceOnRestart := False;
  669. DeleteFlags := 0;
  670. if DisableFsRedir then
  671. DeleteFlags := DeleteFlags or utDeleteFile_DisableFsRedir;
  672. if foRegisterServer in CurFile^.Options then
  673. DeleteFlags := DeleteFlags or utDeleteFile_RegisteredServer;
  674. if foRegisterTypeLib in CurFile^.Options then
  675. DeleteFlags := DeleteFlags or utDeleteFile_RegisteredTypeLib;
  676. if foUninsRestartDelete in CurFile^.Options then
  677. DeleteFlags := DeleteFlags or utDeleteFile_RestartDelete;
  678. if foUninsRemoveReadOnly in CurFile^.Options then
  679. DeleteFlags := DeleteFlags or utDeleteFile_RemoveReadOnly;
  680. if foGacInstall in CurFile^.Options then
  681. DeleteFlags := DeleteFlags or utDeleteFile_GacInstalled;
  682. FontFilename := '';
  683. { Determine the destination filename }
  684. try
  685. case CurFile^.FileType of
  686. ftUninstExe: DestFile := UninstallExeFilename;
  687. else
  688. if ADestFile = '' then
  689. DestFile := ExpandConst(CurFile^.DestName)
  690. else
  691. DestFile := ADestFile;
  692. end;
  693. DestFile := PathExpand(DestFile);
  694. except
  695. { If an exception occurred, reset DestFile back to an empty string
  696. so the error message doesn't show an unexpanded name }
  697. DestFile := '';
  698. raise;
  699. end;
  700. { Update the status and filename labels }
  701. if foDownload in CurFile^.Options then
  702. SetStatusLabelText(SetupMessages[msgStatusDownloadFiles], False)
  703. else
  704. SetStatusLabelText(SetupMessages[msgStatusExtractFiles], False);
  705. SetFilenameLabelText(DestFile, True);
  706. LogFmt('Dest filename: %s', [DestFile]);
  707. if DisableFsRedir <> InstallDefaultDisableFsRedir then begin
  708. if DisableFsRedir then
  709. Log('Non-default bitness: 64-bit')
  710. else
  711. Log('Non-default bitness: 32-bit');
  712. end;
  713. { See if it's a protected system file. }
  714. if IsProtectedSystemFile(DisableFsRedir, DestFile) then begin
  715. Log('Dest file is protected by Windows File Protection.');
  716. IsProtectedFile := (CurFile^.FileType = ftUserFile);
  717. end else
  718. IsProtectedFile := False;
  719. DestFileExists := NewFileExistsRedir(DisableFsRedir, DestFile);
  720. if not CheckedDestFileExistedBefore then begin
  721. DestFileExistedBefore := DestFileExists;
  722. CheckedDestFileExistedBefore := True;
  723. end;
  724. if DestFileExistedBefore then
  725. DeleteFlags := DeleteFlags or utDeleteFile_ExistedBeforeInstall;
  726. var CurFileDateDidRead := True; { Set to False later if needed }
  727. if Assigned(CurFileLocation) then begin
  728. { Not an "external" file }
  729. if CurFileLocation^.TimeStamp.HasTime then begin
  730. if floTimeStampInUTC in CurFileLocation^.Flags then
  731. CurFileDate := CurFileLocation^.TimeStamp
  732. else
  733. LocalFileTimeToFileTime(CurFileLocation^.TimeStamp, CurFileDate);
  734. CurFileDateValid := True;
  735. end else begin
  736. CurFileDateValid := False;
  737. CurFileDateDidRead := False;
  738. end;
  739. end else begin
  740. { An "external" file }
  741. if Assigned(AExternalFileDate) then begin
  742. CurFileDate := AExternalFileDate^;
  743. CurFileDateValid := CurFileDate.HasTime;
  744. end else if not(foDownload in CurFile^.Options) then
  745. CurFileDateValid := GetFileDateTime(DisableFsRedir, AExternalSourceFile, CurFileDate)
  746. else begin
  747. CurFileDateValid := False;
  748. CurFileDateDidRead := False;
  749. end;
  750. end;
  751. if CurFileDateValid then
  752. LogFmt('Time stamp of our file: %s', [FileTimeToStr(CurFileDate)])
  753. else if CurFileDateDidRead then
  754. Log('Time stamp of our file: (failed to read)');
  755. if DestFileExists then begin
  756. Log('Dest file exists.');
  757. if foOnlyIfDoesntExist in CurFile^.Options then begin
  758. Log('Skipping due to "onlyifdoesntexist" flag.');
  759. goto Skip;
  760. end;
  761. LastOperation := SetupMessages[msgErrorReadingExistingDest];
  762. ExistingFileDateValid := GetFileDateTime(DisableFsRedir, DestFile, ExistingFileDate);
  763. if ExistingFileDateValid then
  764. LogFmt('Time stamp of existing file: %s', [FileTimeToStr(ExistingFileDate)])
  765. else
  766. Log('Time stamp of existing file: (failed to read)');
  767. { Compare version info }
  768. if not(foIgnoreVersion in CurFile^.Options) then begin
  769. AllowTimeStampComparison := False;
  770. { Read version info of file being installed }
  771. if foDownload in CurFile^.Options then
  772. InternalError('Unexpected Download flag');
  773. if foExtractArchive in CurFile^.Options then
  774. InternalError('Unexpected ExtractArchive flag');
  775. if Assigned(CurFileLocation) then begin
  776. CurFileVersionInfoValid := floVersionInfoValid in CurFileLocation^.Flags;
  777. CurFileVersionInfo.MS := CurFileLocation^.FileVersionMS;
  778. CurFileVersionInfo.LS := CurFileLocation^.FileVersionLS;
  779. end
  780. else
  781. CurFileVersionInfoValid := GetVersionNumbersRedir(DisableFsRedir,
  782. PathExpand(AExternalSourceFile), CurFileVersionInfo);
  783. if CurFileVersionInfoValid then
  784. LogFmt('Version of our file: %u.%u.%u.%u',
  785. [LongRec(CurFileVersionInfo.MS).Hi, LongRec(CurFileVersionInfo.MS).Lo,
  786. LongRec(CurFileVersionInfo.LS).Hi, LongRec(CurFileVersionInfo.LS).Lo])
  787. else
  788. Log('Version of our file: (none)');
  789. { Does the existing file have version info? }
  790. if GetVersionNumbersRedir(DisableFsRedir, PathExpand(DestFile), ExistingVersionInfo) then begin
  791. { If the file being installed has no version info, or the existing
  792. file is a newer version... }
  793. LogFmt('Version of existing file: %u.%u.%u.%u',
  794. [LongRec(ExistingVersionInfo.MS).Hi, LongRec(ExistingVersionInfo.MS).Lo,
  795. LongRec(ExistingVersionInfo.LS).Hi, LongRec(ExistingVersionInfo.LS).Lo]);
  796. if not CurFileVersionInfoValid or
  797. ((ExistingVersionInfo.MS > CurFileVersionInfo.MS) or
  798. ((ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
  799. (ExistingVersionInfo.LS > CurFileVersionInfo.LS))) then begin
  800. { No version info, or existing file is newer, ask user what to do unless we shouldn't }
  801. if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
  802. if PromptIfOlderOverwriteAll <> oaOverwrite then begin
  803. Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
  804. SetupMessages[msgExistingFileNewer2],
  805. [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
  806. SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
  807. mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
  808. if not Overwrite then begin
  809. Log('User opted not to overwrite the existing file. Skipping.');
  810. goto Skip;
  811. end;
  812. end;
  813. end else begin
  814. Log('Existing file is a newer version. Skipping.');
  815. goto Skip;
  816. end;
  817. end
  818. else begin
  819. { If the existing file and the file being installed are the same
  820. version... }
  821. if (ExistingVersionInfo.MS = CurFileVersionInfo.MS) and
  822. (ExistingVersionInfo.LS = CurFileVersionInfo.LS) and
  823. not(foOverwriteSameVersion in CurFile^.Options) then begin
  824. if foReplaceSameVersionIfContentsDiffer in CurFile^.Options then begin
  825. { Get the two files' SHA-256 hashes and compare them }
  826. var ExistingFileHash: TSHA256Digest;
  827. if TryToGetSHA256OfFile(DisableFsRedir, DestFile, ExistingFileHash) then begin
  828. var CurFileHash: TSHA256Digest;
  829. if Assigned(CurFileLocation) then
  830. CurFileHash := CurFileLocation^.SHA256Sum
  831. else begin
  832. LastOperation := SetupMessages[msgErrorReadingSource];
  833. { This GetSHA256OfFile call could raise an exception, but
  834. it's very unlikely since we were already able to
  835. successfully read the file's version info. }
  836. CurFileHash := GetSHA256OfFile(DisableFsRedir, AExternalSourceFile);
  837. LastOperation := SetupMessages[msgErrorReadingExistingDest];
  838. end;
  839. { If the two files' SHA-256 hashes are equal, skip the file }
  840. if SHA256DigestsEqual(ExistingFileHash, CurFileHash) then begin
  841. Log('Existing file''s SHA-256 hash matches our file. Skipping.');
  842. goto Skip;
  843. end;
  844. Log('Existing file''s SHA-256 hash is different from our file. Proceeding.');
  845. end
  846. else
  847. Log('Failed to read existing file''s SHA-256 hash. Proceeding.');
  848. end
  849. else begin
  850. { Skip the file or fall back to time stamp comparison }
  851. if not(foCompareTimeStamp in CurFile^.Options) then begin
  852. Log('Same version. Skipping.');
  853. goto Skip;
  854. end;
  855. AllowTimeStampComparison := True;
  856. end;
  857. end;
  858. end;
  859. end
  860. else begin
  861. Log('Version of existing file: (none)');
  862. { If neither the existing file nor our file have version info,
  863. allow time stamp comparison }
  864. if not CurFileVersionInfoValid then
  865. AllowTimeStampComparison := True;
  866. end;
  867. end
  868. else begin
  869. { When foIgnoreVersion is in Options, always allow time stamp
  870. comparison }
  871. AllowTimeStampComparison := True;
  872. end;
  873. { Fall back to comparing time stamps if needed }
  874. if AllowTimeStampComparison and
  875. (foCompareTimeStamp in CurFile^.Options) then begin
  876. if foDownload in CurFile^.Options then
  877. InternalError('Unexpected Download flag');
  878. if not CurFileDateValid or not ExistingFileDateValid then begin
  879. { If we failed to read one of the time stamps, do the safe thing
  880. and just skip the file }
  881. Log('Couldn''t read time stamp. Skipping.');
  882. goto Skip;
  883. end;
  884. if CompareFileTime(ExistingFileDate, CurFileDate) = 0 then begin
  885. { Same time stamp }
  886. Log('Same time stamp. Skipping.');
  887. goto Skip;
  888. end;
  889. if CompareFileTime(ExistingFileDate, CurFileDate) > 0 then begin
  890. { Existing file has a later time stamp, ask user what to do unless we shouldn't }
  891. if (foPromptIfOlder in CurFile^.Options) and not IsProtectedFile then begin
  892. if PromptIfOlderOverwriteAll <> oaOverwrite then begin
  893. Overwrite := AskOverwrite(DestFile, SetupMessages[msgExistingFileNewerSelectAction],
  894. SetupMessages[msgExistingFileNewer2],
  895. [SetupMessages[msgExistingFileNewerKeepExisting], SetupMessages[msgExistingFileNewerOverwriteExisting]],
  896. SetupMessages[msgExistingFileNewerOverwriteOrKeepAll],
  897. mbError, IDYES, IDNO, PromptIfOlderOverwriteAll);
  898. if not Overwrite then begin
  899. Log('User opted not to overwrite the existing file. Skipping.');
  900. goto Skip;
  901. end;
  902. end;
  903. end else begin
  904. Log('Existing file has a later time stamp. Skipping.');
  905. goto Skip;
  906. end;
  907. end;
  908. end;
  909. LastOperation := '';
  910. { Don't attempt to replace an existing protected system file.
  911. (Do this *after* the version numbers of the new & existing files
  912. have been logged.) }
  913. if IsProtectedFile then begin
  914. Log('Existing file is protected by Windows File Protection. Skipping.');
  915. goto Skip;
  916. end;
  917. { If file already exists and foConfirmOverwrite is in Options, ask the user what to do }
  918. if foConfirmOverwrite in CurFile^.Options then begin
  919. if ConfirmOverwriteOverwriteAll <> oaOverwrite then begin
  920. Overwrite := AskOverwrite(DestFile, SetupMessages[msgFileExistsSelectAction],
  921. SetupMessages[msgFileExists2],
  922. [SetupMessages[msgFileExistsOverwriteExisting], SetupMessages[msgFileExistsKeepExisting]],
  923. SetupMessages[msgFileExistsOverwriteOrKeepAll],
  924. mbConfirmation, IDNO, IDYES, ConfirmOverwriteOverwriteAll);
  925. if not Overwrite then begin
  926. Log('User opted not to overwrite the existing file. Skipping.');
  927. goto Skip;
  928. end;
  929. end;
  930. end;
  931. { Check if existing file is read-only }
  932. while True do begin
  933. var ExistingFileAttr := GetFileAttributesRedir(DisableFsRedir, DestFile);
  934. if (ExistingFileAttr <> INVALID_FILE_ATTRIBUTES) and
  935. (ExistingFileAttr and FILE_ATTRIBUTE_READONLY <> 0) then begin
  936. if not(foOverwriteReadOnly in CurFile^.Options) and
  937. AbortRetryIgnoreTaskDialogMsgBox(
  938. DestFile + SNewLine2 + SetupMessages[msgExistingFileReadOnly2],
  939. [SetupMessages[msgExistingFileReadOnlyRetry], SetupMessages[msgExistingFileReadOnlyKeepExisting], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  940. Log('User opted not to strip the existing file''s read-only attribute. Skipping.');
  941. goto Skip;
  942. end;
  943. LastOperation := SetupMessages[msgErrorChangingAttr];
  944. if SetFileAttributesRedir(DisableFsRedir, DestFile,
  945. ExistingFileAttr and not FILE_ATTRIBUTE_READONLY) then
  946. Log('Stripped read-only attribute.')
  947. else
  948. Log('Failed to strip read-only attribute.');
  949. if foOverwriteReadOnly in CurFile^.Options then
  950. Break; { don't retry }
  951. end
  952. else
  953. Break;
  954. end;
  955. end
  956. else begin
  957. if (foOnlyIfDestFileExists in CurFile^.Options) and not DestFileExistedBefore then begin
  958. Log('Skipping due to "onlyifdestfileexists" flag.');
  959. goto Skip;
  960. end;
  961. end;
  962. Log('Installing the file.');
  963. { Locate source file }
  964. SourceFile := AExternalSourceFile; { Empty string if not external }
  965. if DisableFsRedir = InstallDefaultDisableFsRedir then begin
  966. { If the file is compressed in the setup package, has the same file
  967. already been copied somewhere else? If so, just make a duplicate of
  968. that file instead of extracting it over again. }
  969. if (SourceFile = '') and (FileLocationFilenames <> nil) and
  970. (FileLocationFilenames[CurFile^.LocationEntry] <> '') and
  971. NewFileExistsRedir(DisableFsRedir, FileLocationFilenames[CurFile^.LocationEntry]) then
  972. SourceFile := FileLocationFilenames[CurFile^.LocationEntry];
  973. AllowFileToBeDuplicated := (SourceFile = '');
  974. end
  975. else begin
  976. { This file uses a non-default FS redirection setting. Files in
  977. FileLocationFilenames are assumed to have been installed with the
  978. default FS redirection setting, so we can't use a file in
  979. FileLocationFilenames as the source, or put this file there. }
  980. AllowFileToBeDuplicated := False;
  981. end;
  982. { Download or extract or copy the file to a temporary file. Create the destination
  983. file's directory if it didn't already exist. }
  984. LastOperation := SetupMessages[msgErrorCreatingTemp];
  985. TempFile := GenerateUniqueName(DisableFsRedir, PathExtractPath(DestFile), '.tmp');
  986. Flags := [];
  987. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  988. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  989. MakeDir(UninstLog, DisableFsRedir, PathExtractDir(TempFile), Flags);
  990. DestF := TFileRedir.Create(DisableFsRedir, TempFile, fdCreateAlways, faReadWrite, fsNone);
  991. try
  992. TempFileLeftOver := True;
  993. try
  994. ProgressUpdated := True;
  995. LastOperation := SetupMessages[msgErrorReadingSource];
  996. if SourceFile = '' then begin
  997. { Decompress a file }
  998. FileExtractor.SeekTo(CurFileLocation^, InternalProgressProc);
  999. LastOperation := SetupMessages[msgErrorCopying];
  1000. FileExtractor.DecompressFile(CurFileLocation^, DestF, InternalProgressProc,
  1001. not (foDontVerifyChecksum in CurFile^.Options));
  1002. end
  1003. else if foExtractArchive in CurFile^.Options then begin
  1004. { Extract a file from archive. Note: ISSigVerify for archive has
  1005. already been handled by RecurseExternalArchiveCopyFiles. }
  1006. LastOperation := SetupMessages[msgErrorExtracting];
  1007. var MaxProgress := CurProgress;
  1008. Inc(MaxProgress, AExternalSize);
  1009. ArchiveFindExtract(TArchiveFindHandle(StrToUInt64(SourceFile)), DestF, ExternalProgressProc64, MaxProgress);
  1010. end
  1011. else if foDownload in CurFile^.Options then begin
  1012. { Download a file with or without ISSigVerify. Note: estimate of
  1013. extra .issig size has already been added to CurFile's ExternalSize. }
  1014. LastOperation := SetupMessages[msgErrorDownloading];
  1015. const DownloadUserName = ExpandConst(CurFile^.DownloadUserName);
  1016. const DownloadPassword = ExpandConst(CurFile^.DownloadPassword);
  1017. var MaxProgress := CurProgress;
  1018. Inc(MaxProgress, AExternalSize);
  1019. if CurFile^.Verification.Typ = fvISSig then begin
  1020. const ISSigTempFile = TempFile + ISSigExt;
  1021. const ISSigDestF = TFileRedir.Create(DisableFsRedir, ISSigTempFile, fdCreateAlways, faReadWrite, fsNone);
  1022. try
  1023. { Download the .issig file }
  1024. const ISSigUrl = GetISSigUrl(SourceFile, ExpandConst(CurFile^.DownloadISSigSource));
  1025. DownloadFile(ISSigUrl, DownloadUserName, DownloadPassword,
  1026. ISSigDestF, NoVerification, '', JustProcessEventsProc64, 0, ProcessEvents);
  1027. FreeAndNil(ISSigDestF);
  1028. { Download and verify the actual file }
  1029. DownloadFile(SourceFile, DownloadUserName, DownloadPassword,
  1030. DestF, CurFile^.Verification, TempFile, ExternalProgressProc64, MaxProgress, ProcessEvents);
  1031. finally
  1032. ISSigDestF.Free;
  1033. { Delete the .issig file }
  1034. DeleteFileRedir(DisableFsRedir, ISSigTempFile);
  1035. end;
  1036. end else
  1037. DownloadFile(SourceFile, DownloadUserName, DownloadPassword,
  1038. DestF, CurFile^.Verification, '', ExternalProgressProc64, MaxProgress, ProcessEvents);
  1039. end
  1040. else begin
  1041. { Copy a duplicated non-external file, or an external file }
  1042. SourceF := TFileRedir.Create(DisableFsRedir, SourceFile, fdOpenExisting, faRead, fsRead);
  1043. try
  1044. LastOperation := SetupMessages[msgErrorCopying];
  1045. if Assigned(CurFileLocation) then
  1046. CopySourceFileToDestFile(SourceF, DestF, NoVerification,
  1047. '', CurFileLocation^.OriginalSize)
  1048. else
  1049. CopySourceFileToDestFile(SourceF, DestF, CurFile^.Verification,
  1050. SourceFile, AExternalSize);
  1051. finally
  1052. SourceF.Free;
  1053. end;
  1054. end;
  1055. except
  1056. { If an exception occurred, put progress meter back to where it was }
  1057. ProgressUpdated := False;
  1058. SetProgress(PreviousProgress);
  1059. raise;
  1060. end;
  1061. { Set time/date stamp }
  1062. if CurFileDateValid then
  1063. SetFileTime(DestF.Handle, nil, nil, @CurFileDate);
  1064. { If it's the uninstall program, bind the messages }
  1065. if CurFile^.FileType = ftUninstExe then begin
  1066. AllowFileToBeDuplicated := False;
  1067. MarkExeHeader(DestF, SetupExeModeUninstaller);
  1068. if not(shSignedUninstaller in SetupHeader.Options) and
  1069. not DetachedUninstMsgFile then
  1070. BindUninstallMsgDataToExe(ExpandedAppId, DestF);
  1071. end;
  1072. finally
  1073. DestF.Free;
  1074. end;
  1075. { If it's a font, unregister the existing one to ensure that Windows
  1076. 'notices' the file is being replaced, and to increase the chances
  1077. of the file being unlocked/closed before we replace it. }
  1078. if CurFile^.InstallFontName <> '' then begin
  1079. LastOperation := '';
  1080. FontFilename := ShortenOrExpandFontFilename(DestFile);
  1081. if DestFileExistedBefore then
  1082. RemoveFontResource(PChar(FontFilename));
  1083. end;
  1084. { Delete existing version of file, if any. If it can't be deleted
  1085. because it's in use and the "restartreplace" flag was specified
  1086. on the entry, register it to be replaced when the system is
  1087. restarted. Do retry deletion before doing this. }
  1088. if DestFileExists and (CurFile^.FileType <> ftUninstExe) then begin
  1089. LastOperation := SetupMessages[msgErrorReplacingExistingFile];
  1090. PerformFileOperationWithRetries(4, False,
  1091. function(out LastError: Cardinal): Boolean
  1092. begin
  1093. Result := DeleteFileRedir(DisableFsRedir, DestFile);
  1094. if not Result then begin
  1095. LastError := GetLastError;
  1096. if LastError = ERROR_FILE_NOT_FOUND then begin
  1097. Result := True; { If the file inexplicably vanished, it's not a problem }
  1098. LastError := ERROR_SUCCESS;
  1099. end;
  1100. end;
  1101. end,
  1102. procedure(const LastError: Cardinal; var RetriesLeft: Integer; var NextAction: TFileOperationFailingNextAction)
  1103. begin
  1104. DoHandleFailedDeleteOrMoveFileTry(CurFile, DisableFsRedir, 'DeleteFile', TempFile, DestFile,
  1105. LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart, NextAction);
  1106. end,
  1107. procedure(const LastError: Cardinal; var TryOnceMore: Boolean)
  1108. begin
  1109. Win32ErrorMsg('DeleteFile'); { Throws an exception }
  1110. end);
  1111. end;
  1112. { Rename the temporary file to the new name now, unless the file is
  1113. to be replaced when the system is restarted, or if the file is the
  1114. uninstall program and an existing uninstall program already exists.
  1115. If it can't be renamed and the "restartreplace" flag was specified
  1116. on the entry, register it to be replaced when the system is
  1117. restarted. Do retry renaming before doing this. }
  1118. if not (ReplaceOnRestart or
  1119. ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore)) then begin
  1120. LastOperation := SetupMessages[msgErrorRenamingTemp];
  1121. { Since the DeleteFile above succeeded you would expect the rename to
  1122. also always succeed, but if it doesn't retry anyway. }
  1123. PerformFileOperationWithRetries(4, True,
  1124. function(out LastError: Cardinal): Boolean
  1125. begin
  1126. Result := MoveFileRedir(DisableFsRedir, TempFile, DestFile);
  1127. if not Result then
  1128. LastError := GetLastError;
  1129. end,
  1130. procedure(const LastError: Cardinal; var RetriesLeft: Integer; var NextAction: TFileOperationFailingNextAction)
  1131. begin
  1132. DoHandleFailedDeleteOrMoveFileTry(CurFile, DisableFsRedir, 'MoveFile', TempFile, DestFile,
  1133. LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart, NextAction);
  1134. end,
  1135. procedure(const LastError: Cardinal; var TryOnceMore: Boolean)
  1136. begin
  1137. Win32ErrorMsg('MoveFile'); { Throws an exception }
  1138. end);
  1139. { If ReplaceOnRestart is still False the rename succeeded so handle this.
  1140. Then set any file attributes. }
  1141. if not ReplaceOnRestart then begin
  1142. TempFileLeftOver := False;
  1143. TempFile := '';
  1144. LastOperation := '';
  1145. Log('Successfully installed the file.');
  1146. if AllowFileToBeDuplicated then
  1147. SetFileLocationFilename(CurFile^.LocationEntry, DestFile);
  1148. if foDeleteAfterInstall in CurFile^.Options then
  1149. DeleteFilesAfterInstallList.AddObject(DestFile, Pointer(Ord(DisableFsRedir)));
  1150. { Set file attributes *after* renaming the file since Novell
  1151. reportedly can't rename read-only files. }
  1152. AddAttributesToFile(DisableFsRedir, DestFile, CurFile^.Attribs);
  1153. end;
  1154. end;
  1155. { Leave the temporary file in place for now if the file is to be
  1156. replaced when the system is restarted, or if the file is the uninstall
  1157. program and an existing uninstall program already exists. }
  1158. if ReplaceOnRestart or
  1159. ((CurFile^.FileType = ftUninstExe) and DestFileExistedBefore) then begin
  1160. if CurFile^.FileType = ftUninstExe then
  1161. UninstallTempExeFilename := TempFile;
  1162. TempFileLeftOver := False;
  1163. LastOperation := '';
  1164. Log('Leaving temporary file in place for now.');
  1165. if AllowFileToBeDuplicated then
  1166. SetFileLocationFilename(CurFile^.LocationEntry, TempFile);
  1167. AddAttributesToFile(DisableFsRedir, TempFile, CurFile^.Attribs);
  1168. end;
  1169. { If it's a font, register it }
  1170. if CurFile^.InstallFontName <> '' then begin
  1171. LastOperation := '';
  1172. LogFmt('Registering file as a font ("%s")', [CurFile^.InstallFontName]);
  1173. PerUserFont := not IsAdminInstallMode;
  1174. InstallFont(FontFilename, CurFile^.InstallFontName, PerUserFont, not ReplaceOnRestart, WarnedPerUserFonts);
  1175. DeleteFlags := DeleteFlags or utDeleteFile_IsFont;
  1176. if PerUserFont then
  1177. DeleteFlags := DeleteFlags or utDeleteFile_PerUserFont;
  1178. end;
  1179. { There were no errors so add the uninstall log entry, unless the file
  1180. is the uninstall program, or if it has the foSharedFile flag; shared
  1181. files are handled below. }
  1182. LastOperation := '';
  1183. if CurFile^.FileType <> ftUninstExe then begin
  1184. if not(foUninsNeverUninstall in CurFile^.Options) and
  1185. not(foSharedFile in CurFile^.Options) then begin
  1186. UninstLog.Add(utDeleteFile, [DestFile, TempFile,
  1187. CurFile^.InstallFontName, FontFilename,
  1188. CurFile^.StrongAssemblyName], DeleteFlags);
  1189. end;
  1190. end
  1191. else begin
  1192. if UninstallTempExeFilename = '' then
  1193. UninstallExeCreated := ueNew
  1194. else
  1195. UninstallExeCreated := ueReplaced;
  1196. end;
  1197. Skip:
  1198. { If foRegisterServer or foRegisterTypeLib is in Options, add the
  1199. file to RegisterFilesList for registering later.
  1200. Don't attempt to register if the file doesn't exist (which can
  1201. happen if the foOnlyIfDestFileExists flag is used). }
  1202. if ((foRegisterServer in CurFile^.Options) or
  1203. (foRegisterTypeLib in CurFile^.Options)) and
  1204. NewFileExistsRedir(DisableFsRedir, DestFile) then begin
  1205. LastOperation := '';
  1206. if foRegisterTypeLib in CurFile^.Options then
  1207. Log('Will register the file (a type library) later.')
  1208. else
  1209. Log('Will register the file (a DLL/OCX) later.');
  1210. New(RegisterRec);
  1211. RegisterRec^.Filename := DestFile;
  1212. RegisterRec^.Is64Bit := DisableFsRedir;
  1213. RegisterRec^.TypeLib := foRegisterTypeLib in CurFile^.Options;
  1214. RegisterRec^.NoErrorMessages := foNoRegError in CurFile^.Options;
  1215. RegisterFilesList.Add(RegisterRec);
  1216. end;
  1217. { If foSharedFile is in Options, increment the reference count in the
  1218. registry for the file, then add the uninstall log entry (which,
  1219. unlike non-shared files, must be done on skipped files as well;
  1220. that's why there are two places where utDeleteFile entries are
  1221. added). }
  1222. if foSharedFile in CurFile^.Options then begin
  1223. LastOperation := '';
  1224. if DisableFsRedir then begin
  1225. Log('Incrementing shared file count (64-bit).');
  1226. IncrementSharedCount(rv64Bit, DestFile, DestFileExistedBefore);
  1227. end
  1228. else begin
  1229. Log('Incrementing shared file count (32-bit).');
  1230. IncrementSharedCount(rv32Bit, DestFile, DestFileExistedBefore);
  1231. end;
  1232. if not(foUninsNeverUninstall in CurFile^.Options) then begin
  1233. DeleteFlags := DeleteFlags or utDeleteFile_SharedFile;
  1234. if DisableFsRedir then
  1235. DeleteFlags := DeleteFlags or utDeleteFile_SharedFileIn64BitKey;
  1236. if foUninsNoSharedFilePrompt in CurFile^.Options then
  1237. DeleteFlags := DeleteFlags or utDeleteFile_NoSharedFilePrompt;
  1238. UninstLog.Add(utDeleteFile, [DestFile, TempFile,
  1239. CurFile^.InstallFontName, FontFilename,
  1240. CurFile^.StrongAssemblyName], DeleteFlags);
  1241. end
  1242. else begin
  1243. if DisableFsRedir then
  1244. UninstLog.Add(utDecrementSharedCount, [DestFile],
  1245. utDecrementSharedCount_64BitKey)
  1246. else
  1247. UninstLog.Add(utDecrementSharedCount, [DestFile], 0);
  1248. end;
  1249. end;
  1250. { Apply permissions (even if the file wasn't replaced) }
  1251. LastOperation := '';
  1252. if TempFile <> '' then
  1253. ApplyPermissions(DisableFsRedir, TempFile, CurFile^.PermissionsEntry)
  1254. else
  1255. ApplyPermissions(DisableFsRedir, DestFile, CurFile^.PermissionsEntry);
  1256. { Set NTFS compression (even if the file wasn't replaced) }
  1257. if (foSetNTFSCompression in CurFile^.Options) or (foUnsetNTFSCompression in CurFile^.Options) then begin
  1258. LastOperation := '';
  1259. if TempFile <> '' then
  1260. ApplyNTFSCompression(DisableFsRedir, TempFile, foSetNTFSCompression in CurFile^.Options)
  1261. else
  1262. ApplyNTFSCompression(DisableFsRedir, DestFile, foSetNTFSCompression in CurFile^.Options);
  1263. end;
  1264. { Install into GAC (even if the file wasn't replaced) }
  1265. if foGacInstall in CurFile^.Options then begin
  1266. Log('Installing into GAC');
  1267. with TAssemblyCacheInfo.Create(rvDefault) do try
  1268. if TempFile <> '' then
  1269. InstallAssembly(TempFile)
  1270. else
  1271. InstallAssembly(DestFile);
  1272. finally
  1273. Free;
  1274. end;
  1275. end;
  1276. except
  1277. if ExceptObject is EAbort then
  1278. raise;
  1279. Failed := GetExceptMessage;
  1280. end;
  1281. finally
  1282. { If an exception occurred before TempFile was cleaned up, delete it now }
  1283. if TempFileLeftOver then
  1284. DeleteFileRedir(DisableFsRedir, TempFile);
  1285. end;
  1286. { Was there an exception? Display error message and offer to retry }
  1287. if Failed <> '' then begin
  1288. if (CurFile^.FileType = ftUninstExe) and (UninstallTempExeFilename <> '') then begin
  1289. DeleteFile(UninstallTempExeFilename);
  1290. UninstallTempExeFilename := '';
  1291. UninstallExeCreated := ueNone;
  1292. end;
  1293. if LastOperation <> '' then
  1294. LastOperation := LastOperation + SNewLine;
  1295. if not AbortRetryIgnoreTaskDialogMsgBox(
  1296. DestFile + SNewLine2 + LastOperation + Failed,
  1297. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  1298. if ProgressUpdated then
  1299. SetProgress(PreviousProgress);
  1300. goto Retry;
  1301. end;
  1302. end;
  1303. { Increment progress meter, if not already done so }
  1304. if not ProgressUpdated then begin
  1305. if Assigned(CurFileLocation) then { not an "external" file }
  1306. IncProgress(CurFileLocation^.OriginalSize)
  1307. else
  1308. IncProgress(AExternalSize);
  1309. end;
  1310. { Process any events between copying files }
  1311. ProcessEvents;
  1312. { Clear previous filename label in case an exception or debugger break
  1313. occurs between now and when the label for the next entry is set }
  1314. SetFilenameLabelText('', False);
  1315. end;
  1316. procedure CopyFiles(const UninstLog: TUninstallLog; const ExpandedAppId: String;
  1317. const RegisterFilesList: TList; Uninstallable: Boolean;
  1318. var UninstallTempExeFilename: String; var UninstallExeCreated: TUninstallExeCreated);
  1319. { Copies all the application's files }
  1320. function RecurseExternalCopyFiles(const DisableFsRedir: Boolean;
  1321. const SearchBaseDir, SearchSubDir, SearchWildcard: String; const SourceIsWildcard: Boolean;
  1322. const Excludes: TStrings; const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Int64;
  1323. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1324. var WarnedPerUserFonts: Boolean): Boolean;
  1325. begin
  1326. { Also see RecurseExternalFiles and RecurseExternalGetSizeOfFiles in Setup.MainFunc
  1327. Also see RecurseExternalArchiveCopyFiles directly below }
  1328. Result := False;
  1329. var FindData: TWin32FindData;
  1330. var H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + SearchWildcard, FindData);
  1331. if H <> INVALID_HANDLE_VALUE then begin
  1332. try
  1333. repeat
  1334. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1335. var FileName: String;
  1336. if SourceIsWildcard then begin
  1337. if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
  1338. Continue;
  1339. FileName := FindData.cFileName;
  1340. end
  1341. else
  1342. FileName := SearchWildcard; { use the case specified in the script }
  1343. if IsExcluded(SearchSubDir + FileName, Excludes) then
  1344. Continue;
  1345. Result := True;
  1346. var SourceFile := SearchBaseDir + SearchSubDir + FileName;
  1347. { Note: CurFile^.DestName only includes a a filename if foCustomDestName is set,
  1348. see TSetupCompiler.EnumFilesProc.ProcessFileList }
  1349. var DestFile := ExpandConst(CurFile^.DestName);
  1350. if not(foCustomDestName in CurFile^.Options) then
  1351. DestFile := DestFile + SearchSubDir + FileName
  1352. else if SearchSubDir <> '' then
  1353. DestFile := PathExtractPath(DestFile) + SearchSubDir + PathExtractName(DestFile);
  1354. var Size := FindDataFileSizeToInt64(FindData);
  1355. if Size > ExpectedBytesLeft then begin
  1356. { Don't allow the progress bar to overflow if the size of the
  1357. files is greater than when we last checked }
  1358. Size := ExpectedBytesLeft;
  1359. end;
  1360. ProcessFileEntry(UninstLog, ExpandedAppId, RegisterFilesList,
  1361. CurFile, DisableFsRedir, SourceFile, DestFile, nil,
  1362. Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1363. WarnedPerUserFonts, nil, UninstallTempExeFilename, UninstallExeCreated);
  1364. Dec(ExpectedBytesLeft, Size);
  1365. end;
  1366. until not FindNextFile(H, FindData);
  1367. finally
  1368. Windows.FindClose(H);
  1369. end;
  1370. end;
  1371. if foRecurseSubDirsExternal in CurFile^.Options then begin
  1372. H := FindFirstFileRedir(DisableFsRedir, SearchBaseDir + SearchSubDir + '*', FindData);
  1373. if H <> INVALID_HANDLE_VALUE then begin
  1374. try
  1375. repeat
  1376. if IsRecurseableDirectory(FindData) then
  1377. Result := RecurseExternalCopyFiles(DisableFsRedir, SearchBaseDir,
  1378. SearchSubDir + FindData.cFileName + '\', SearchWildcard,
  1379. SourceIsWildcard, Excludes, CurFile, ExpectedBytesLeft,
  1380. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1381. WarnedPerUserFonts) or Result;
  1382. until not FindNextFile(H, FindData);
  1383. finally
  1384. Windows.FindClose(H);
  1385. end;
  1386. end;
  1387. end;
  1388. if SearchSubDir <> '' then begin
  1389. { If Result is False this subdir won't be created, so create it now if
  1390. CreateAllSubDirs was set }
  1391. if not Result and (foCreateAllSubDirs in CurFile.Options) then begin
  1392. var DestName := ExpandConst(CurFile^.DestName); { See above }
  1393. if not(foCustomDestName in CurFile^.Options) then
  1394. DestName := DestName + SearchSubDir
  1395. else
  1396. DestName := PathExtractPath(DestName) + SearchSubDir;
  1397. var Flags: TMakeDirFlags := [];
  1398. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1399. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1400. MakeDir(UninstLog, DisableFsRedir, DestName, Flags);
  1401. Result := True;
  1402. end;
  1403. end;
  1404. { When recursively searching but not picking up every file, we could
  1405. be frozen for a long time when installing from a network. Calling
  1406. ProcessEvents after every directory helps. }
  1407. ProcessEvents;
  1408. end;
  1409. function RecurseExternalArchiveCopyFiles(const DisableFsRedir: Boolean;
  1410. const ArchiveFilename: String; const Excludes: TStrings;
  1411. const CurFile: PSetupFileEntry; var ExpectedBytesLeft: Int64;
  1412. var ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1413. var WarnedPerUserFonts: Boolean): Boolean;
  1414. begin
  1415. { See above }
  1416. { If the archive doesn't exist then the caller should handle this with
  1417. a msgSourceDoesntExist message. All other errors we handle ourselves
  1418. with a msgErrorExtracting message, without informing the caller, unless
  1419. you count EAbort. }
  1420. Result := NewFileExistsRedir(DisableFsRedir, ArchiveFilename);
  1421. if not Result then
  1422. Exit;
  1423. if foCustomDestName in CurFile^.Options then
  1424. InternalError('Unexpected custom DestName');
  1425. const DestDir = ExpandConst(CurFile^.DestName);
  1426. Log('-- Archive entry --');
  1427. var VerifySourceF: TFile := nil;
  1428. try
  1429. var FindData: TWin32FindData;
  1430. var H: TArchiveFindHandle := INVALID_HANDLE_VALUE;
  1431. var Failed: String;
  1432. repeat
  1433. try
  1434. if CurFile^.Verification.Typ <> fvNone then begin
  1435. if VerifySourceF = nil then
  1436. VerifySourceF := TFileRedir.Create(DisableFsRedir, ArchiveFilename, fdOpenExisting, faRead, fsRead);
  1437. var ExpectedFileHash: TSHA256Digest;
  1438. if CurFile^.Verification.Typ = fvHash then
  1439. ExpectedFileHash := CurFile^.Verification.Hash
  1440. else begin
  1441. DoISSigVerify(VerifySourceF, nil, ArchiveFilename, True, CurFile^.Verification.ISSigAllowedKeys,
  1442. ExpectedFileHash);
  1443. end;
  1444. { Can't get the SHA-256 while extracting so need to get and check it now }
  1445. const ActualFileHash = GetSHA256OfFile(VerifySourceF);
  1446. if not SHA256DigestsEqual(ActualFileHash, ExpectedFileHash) then
  1447. VerificationError(veFileHashIncorrect);
  1448. Log(VerificationSuccessfulLogMessage);
  1449. { Keep VerifySourceF open until extraction has completed to prevent TOCTOU problem }
  1450. end;
  1451. H := ArchiveFindFirstFileRedir(DisableFsRedir, ArchiveFilename, DestDir,
  1452. ExpandConst(CurFile^.ExtractArchivePassword), foRecurseSubDirsExternal in CurFile^.Options,
  1453. True, FindData);
  1454. Failed := '';
  1455. except
  1456. if ExceptObject is EAbort then
  1457. raise;
  1458. Failed := GetExceptMessage;
  1459. end;
  1460. until (Failed = '') or
  1461. AbortRetryIgnoreTaskDialogMsgBox(
  1462. ArchiveFilename + SNewLine2 + SetupMessages[msgErrorExtracting] + SNewLine + Failed,
  1463. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
  1464. if H <> INVALID_HANDLE_VALUE then begin
  1465. try
  1466. repeat
  1467. if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
  1468. if IsExcluded(FindData.cFileName, Excludes) then
  1469. Continue;
  1470. var SourceFile := UIntToStr(H);
  1471. const DestFile = DestDir + FindData.cFileName;
  1472. var Size := FindDataFileSizeToInt64(FindData);
  1473. if Size > ExpectedBytesLeft then begin
  1474. { Don't allow the progress bar to overflow if the size of the
  1475. files is greater than when we last checked }
  1476. Size := ExpectedBytesLeft;
  1477. end;
  1478. ProcessFileEntry(UninstLog, ExpandedAppId, RegisterFilesList,
  1479. CurFile, DisableFsRedir, SourceFile, DestFile,
  1480. nil, Size, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1481. WarnedPerUserFonts, @FindData.ftLastWriteTime,
  1482. UninstallTempExeFilename, UninstallExeCreated);
  1483. Dec(ExpectedBytesLeft, Size);
  1484. end else if foCreateAllSubDirs in CurFile.Options then begin
  1485. var Flags: TMakeDirFlags := [];
  1486. if foUninsNeverUninstall in CurFile^.Options then Include(Flags, mdNoUninstall);
  1487. if foDeleteAfterInstall in CurFile^.Options then Include(Flags, mdDeleteAfterInstall);
  1488. MakeDir(UninstLog, DisableFsRedir, DestDir + FindData.cFileName, Flags);
  1489. Result := True;
  1490. end;
  1491. until not ArchiveFindNextFile(H, FindData);
  1492. finally
  1493. ArchiveFindClose(H);
  1494. end;
  1495. Log('Successfully extracted the archive.');
  1496. end else
  1497. Log('Found no files to extract.');
  1498. finally
  1499. VerifySourceF.Free;
  1500. end;
  1501. end;
  1502. var
  1503. CurFile: PSetupFileEntry;
  1504. SourceWildcard: String;
  1505. DisableFsRedir, FoundFiles: Boolean;
  1506. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll: TOverwriteAll;
  1507. WarnedPerUserFonts: Boolean;
  1508. begin
  1509. ConfirmOverwriteOverwriteAll := oaUnknown;
  1510. PromptIfOlderOverwriteAll := oaUnknown;
  1511. WarnedPerUserFonts := False;
  1512. var FileLocationFilenames: TStringList := nil;
  1513. var Excludes: TStringList := nil;
  1514. try
  1515. FileLocationFilenames := TStringList.Create;
  1516. for var I := 0 to Entries[seFileLocation].Count-1 do
  1517. FileLocationFilenames.Add('');
  1518. Excludes := TStringList.Create;
  1519. Excludes.StrictDelimiter := True;
  1520. Excludes.Delimiter := ',';
  1521. for var CurFileNumber := 0 to Entries[seFile].Count-1 do begin
  1522. CurFile := PSetupFileEntry(Entries[seFile][CurFileNumber]);
  1523. if ((CurFile^.FileType <> ftUninstExe) or Uninstallable) and
  1524. ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
  1525. DebugNotifyEntry(seFile, CurFileNumber);
  1526. NotifyBeforeInstallFileEntry(CurFile);
  1527. DisableFsRedir := InstallDefaultDisableFsRedir;
  1528. if fo32Bit in CurFile^.Options then
  1529. DisableFsRedir := False;
  1530. if fo64Bit in CurFile^.Options then begin
  1531. if not IsWin64 then
  1532. InternalError('Cannot install files to 64-bit locations on this version of Windows');
  1533. DisableFsRedir := True;
  1534. end;
  1535. if CurFile^.LocationEntry <> -1 then begin
  1536. ProcessFileEntry(UninstLog, ExpandedAppId, RegisterFilesList,
  1537. CurFile, DisableFsRedir, '', '', FileLocationFilenames, 0,
  1538. ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll, WarnedPerUserFonts, nil,
  1539. UninstallTempExeFilename, UninstallExeCreated);
  1540. end
  1541. else begin
  1542. { File is an 'external' file }
  1543. if CurFile^.FileType = ftUninstExe then begin
  1544. { This is the file entry for the uninstaller program }
  1545. SourceWildcard := NewParamStr(0);
  1546. DisableFsRedir := False;
  1547. end
  1548. else
  1549. SourceWildcard := ExpandConst(CurFile^.SourceFilename);
  1550. Excludes.DelimitedText := CurFile^.Excludes;
  1551. var ProgressBefore := CurProgress;
  1552. repeat
  1553. SetProgress(ProgressBefore);
  1554. var ExpectedBytesLeft := CurFile^.ExternalSize;
  1555. if foDownload in CurFile^.Options then begin
  1556. { Archive download should have been done already by Setup.WizardForm's DownloadArchivesToExtract }
  1557. if foExtractArchive in CurFile^.Options then
  1558. InternalError('Unexpected Download flag');
  1559. if foSkipIfSourceDoesntExist in CurFile^.Options then
  1560. InternalError('Unexpected SkipIfSourceDoesntExist flag');
  1561. if not(foCustomDestName in CurFile^.Options) then
  1562. InternalError('Expected CustomDestName flag');
  1563. { CurFile^.DestName now includes a filename, see TSetupCompiler.EnumFilesProc.ProcessFileList }
  1564. ProcessFileEntry(UninstLog, ExpandedAppId, RegisterFilesList,
  1565. CurFile, DisableFsRedir, SourceWildcard, ExpandConst(CurFile^.DestName),
  1566. nil, ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1567. WarnedPerUserFonts, nil,
  1568. UninstallTempExeFilename, UninstallExeCreated);
  1569. FoundFiles := True;
  1570. end else if foExtractArchive in CurFile^.Options then
  1571. FoundFiles := RecurseExternalArchiveCopyFiles(DisableFsRedir,
  1572. SourceWildcard, Excludes, CurFile,
  1573. ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1574. WarnedPerUserFonts)
  1575. else
  1576. FoundFiles := RecurseExternalCopyFiles(DisableFsRedir,
  1577. PathExtractPath(SourceWildcard), '', PathExtractName(SourceWildcard),
  1578. IsWildcard(SourceWildcard), Excludes, CurFile,
  1579. ExpectedBytesLeft, ConfirmOverwriteOverwriteAll, PromptIfOlderOverwriteAll,
  1580. WarnedPerUserFonts);
  1581. until FoundFiles or
  1582. (foSkipIfSourceDoesntExist in CurFile^.Options) or
  1583. AbortRetryIgnoreTaskDialogMsgBox(
  1584. SetupMessages[msgErrorReadingSource] + SNewLine + AddPeriod(FmtSetupMessage(msgSourceDoesntExist, [SourceWildcard])),
  1585. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreSkipNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]);
  1586. { In case we didn't end up copying all the expected bytes, bump
  1587. the progress bar up to the expected amount }
  1588. Inc(ProgressBefore, CurFile^.ExternalSize);
  1589. SetProgress(ProgressBefore);
  1590. end;
  1591. NotifyAfterInstallFileEntry(CurFile);
  1592. end;
  1593. end;
  1594. finally
  1595. Excludes.Free;
  1596. FileLocationFilenames.Free;
  1597. end;
  1598. end;
  1599. procedure CreateIcons(const UninstLog: TUninstallLog);
  1600. function IsPathURL(const S: String): Boolean;
  1601. { Returns True if S begins with a scheme name and colon. Should be
  1602. compliant with RFC 2396 section 3.1. }
  1603. const
  1604. SchemeAlphaChars = ['A'..'Z', 'a'..'z'];
  1605. SchemeAllChars = SchemeAlphaChars + ['0'..'9', '+', '-', '.'];
  1606. var
  1607. P, I: Integer;
  1608. begin
  1609. Result := False;
  1610. P := PathPos(':', S);
  1611. if (P > 2) and CharInSet(S[1], SchemeAlphaChars) then begin
  1612. for I := 2 to P-1 do
  1613. if not CharInSet(S[I], SchemeAllChars) then
  1614. Exit;
  1615. Result := True;
  1616. end;
  1617. end;
  1618. procedure CreateURLFile(const Filename, URL, IconFilename: String;
  1619. const IconIndex: Integer);
  1620. var
  1621. S: String;
  1622. F: TTextFileWriter;
  1623. begin
  1624. S := '[InternetShortcut]' + SNewLine + 'URL=' + URL + SNewLine;
  1625. if IconFilename <> '' then
  1626. S := S + 'IconFile=' + IconFilename + SNewLine +
  1627. 'IconIndex=' + IntToStr(IconIndex) + SNewLine;
  1628. F := TTextFileWriter.Create(Filename, fdCreateAlways, faWrite, fsNone);
  1629. try
  1630. if SameText(S, String(AnsiString(S))) then
  1631. F.WriteAnsi(AnsiString(S))
  1632. else
  1633. F.Write(S);
  1634. finally
  1635. F.Free;
  1636. end;
  1637. end;
  1638. procedure DeleteFolderShortcut(const Dir: String);
  1639. var
  1640. Attr: DWORD;
  1641. DesktopIniFilename, S: String;
  1642. begin
  1643. Attr := GetFileAttributes(PChar(Dir));
  1644. if (Attr <> INVALID_FILE_ATTRIBUTES) and (Attr and FILE_ATTRIBUTE_DIRECTORY <> 0) then begin
  1645. { To be sure this is really a folder shortcut and not a regular folder,
  1646. look for a desktop.ini file specifying CLSID_FolderShortcut }
  1647. DesktopIniFilename := PathCombine(Dir, 'desktop.ini');
  1648. S := GetIniString('.ShellClassInfo', 'CLSID2', '', DesktopIniFilename);
  1649. if CompareText(S, '{0AFACED1-E828-11D1-9187-B532F1E9575D}') = 0 then begin
  1650. DeleteFile(DesktopIniFilename);
  1651. DeleteFile(PathCombine(Dir, 'target.lnk'));
  1652. SetFileAttributes(PChar(Dir), Attr and not FILE_ATTRIBUTE_READONLY);
  1653. RemoveDirectory(PChar(Dir));
  1654. end;
  1655. end;
  1656. end;
  1657. procedure CreateAnIcon(Name: String; const Description, Path, Parameters,
  1658. WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
  1659. const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit;
  1660. const HotKey: Word; const AppUserModelID: String;
  1661. const AppUserModelToastActivatorCLSID: PGUID;
  1662. const ExcludeFromShowInNewInstall, PreventPinning: Boolean);
  1663. var
  1664. BeginsWithGroup: Boolean;
  1665. LinkFilename, PifFilename, UrlFilename, DirFilename, ProbableFilename,
  1666. ResultingFilename: String;
  1667. Flags: TMakeDirFlags;
  1668. URLShortcut: Boolean;
  1669. begin
  1670. BeginsWithGroup := Copy(Name, 1, 8) = '{group}\';
  1671. { Note: PathExpand removes trailing spaces, so it can't be called on
  1672. Name before the extensions are appended }
  1673. Name := ExpandConst(Name);
  1674. LinkFilename := PathExpand(Name + '.lnk');
  1675. PifFilename := PathExpand(Name + '.pif');
  1676. UrlFilename := PathExpand(Name + '.url');
  1677. DirFilename := PathExpand(Name);
  1678. Flags := [mdNotifyChange];
  1679. if NeverUninstall then
  1680. Include(Flags, mdNoUninstall)
  1681. else if BeginsWithGroup then
  1682. Include(Flags, mdAlwaysUninstall);
  1683. URLShortcut := IsPathURL(Path);
  1684. if URLShortcut then
  1685. ProbableFilename := UrlFilename
  1686. else
  1687. ProbableFilename := LinkFilename;
  1688. LogFmt('Dest filename: %s', [ProbableFilename]);
  1689. SetFilenameLabelText(ProbableFilename, True);
  1690. MakeDir(UninstLog, False, PathExtractDir(ProbableFilename), Flags);
  1691. { Delete any old files first }
  1692. DeleteFile(LinkFilename);
  1693. DeleteFile(PifFilename);
  1694. if NewFileExists(UrlFilename) then begin
  1695. { Flush out any pending writes by other apps before deleting }
  1696. WritePrivateProfileString(nil, nil, nil, PChar(UrlFilename));
  1697. end;
  1698. DeleteFile(UrlFilename);
  1699. DeleteFolderShortcut(DirFilename);
  1700. Log('Creating the icon.');
  1701. if not URLShortcut then begin
  1702. { Create the shortcut.
  1703. Note: Don't call PathExpand on any of the paths since they may contain
  1704. environment-variable strings (e.g. %SystemRoot%\...) }
  1705. ResultingFilename := CreateShellLink(LinkFilename, Description, Path,
  1706. Parameters, WorkingDir, IconFilename, IconIndex, ShowCmd, HotKey,
  1707. AppUserModelID, AppUserModelToastActivatorCLSID,
  1708. ExcludeFromShowInNewInstall, PreventPinning);
  1709. { If a .pif file was created, apply the "Close on exit" setting }
  1710. if (CloseOnExit <> icNoSetting) and
  1711. SameText(PathExtractExt(ResultingFilename), '.pif') then begin
  1712. try
  1713. ModifyPifFile(ResultingFilename, CloseOnExit = icYes);
  1714. except
  1715. { Failure isn't important here. Ignore exceptions }
  1716. end;
  1717. end;
  1718. end
  1719. else begin
  1720. { Create an Internet Shortcut (.url) file }
  1721. CreateURLFile(UrlFilename, Path, IconFilename, IconIndex);
  1722. ResultingFilename := UrlFilename;
  1723. end;
  1724. Log('Successfully created the icon.');
  1725. { Set the global flag that is checked by the Finished wizard page }
  1726. CreatedIcon := True;
  1727. { Notify shell of the change }
  1728. SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil);
  1729. SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
  1730. PChar(PathExtractDir(ResultingFilename)), nil);
  1731. { Add uninstall log entries }
  1732. if not NeverUninstall then begin
  1733. if URLShortcut then
  1734. UninstLog.Add(utDeleteFile, [ResultingFilename], utDeleteFile_CallChangeNotify)
  1735. else begin
  1736. { Even though we only created one file, go ahead and try deleting
  1737. both a .lnk and .pif file at uninstall time, in case the user
  1738. alters the shortcut after installation }
  1739. UninstLog.Add(utDeleteFile, [LinkFilename], utDeleteFile_CallChangeNotify);
  1740. UninstLog.Add(utDeleteFile, [PifFilename], utDeleteFile_CallChangeNotify);
  1741. end;
  1742. end;
  1743. end;
  1744. function ExpandAppPath(const Filename: String): String;
  1745. var
  1746. K: HKEY;
  1747. Found: Boolean;
  1748. begin
  1749. if RegOpenKeyExView(InstallDefaultRegView, HKEY_LOCAL_MACHINE,
  1750. PChar(REGSTR_PATH_APPPATHS + '\' + Filename), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  1751. Found := RegQueryStringValue(K, '', Result);
  1752. RegCloseKey(K);
  1753. if Found then
  1754. Exit;
  1755. end;
  1756. Result := Filename;
  1757. end;
  1758. var
  1759. CurIcon: PSetupIconEntry;
  1760. FN: String;
  1761. TACLSID: PGUID;
  1762. begin
  1763. for var CurIconNumber := 0 to Entries[seIcon].Count-1 do begin
  1764. try
  1765. CurIcon := PSetupIconEntry(Entries[seIcon][CurIconNumber]);
  1766. with CurIcon^ do begin
  1767. if ShouldProcessIconEntry(WizardComponents, WizardTasks, WizardNoIcons, CurIcon) then begin
  1768. DebugNotifyEntry(seIcon, CurIconNumber);
  1769. NotifyBeforeInstallEntry(BeforeInstall);
  1770. Log('-- Icon entry --');
  1771. FN := ExpandConst(Filename);
  1772. if ioUseAppPaths in Options then
  1773. FN := ExpandAppPath(FN);
  1774. if not(ioCreateOnlyIfFileExists in Options) or NewFileExistsRedir(IsWin64, FN) then begin
  1775. if ioHasAppUserModelToastActivatorCLSID in Options then
  1776. TACLSID := @AppUserModelToastActivatorCLSID
  1777. else
  1778. TACLSID := nil;
  1779. CreateAnIcon(IconName, ExpandConst(Comment), FN,
  1780. ExpandConst(Parameters), ExpandConst(WorkingDir),
  1781. ExpandConst(IconFilename), IconIndex, ShowCmd,
  1782. ioUninsNeverUninstall in Options, CloseOnExit, HotKey,
  1783. ExpandConst(AppUserModelID), TACLSID,
  1784. ioExcludeFromShowInNewInstall in Options,
  1785. ioPreventPinning in Options)
  1786. end else
  1787. Log('Skipping due to "createonlyiffileexists" flag.');
  1788. { Increment progress meter }
  1789. IncProgress(1000);
  1790. NotifyAfterInstallEntry(AfterInstall);
  1791. end;
  1792. end;
  1793. except
  1794. if not(ExceptObject is EAbort) then
  1795. Application.HandleException(nil)
  1796. else
  1797. raise;
  1798. end;
  1799. ProcessEvents;
  1800. { Clear previous filename label in case an exception or debugger break
  1801. occurs between now and when the label for the next entry is set }
  1802. SetFilenameLabelText('', False);
  1803. end;
  1804. end;
  1805. procedure CreateIniEntries(const UninstLog: TUninstallLog);
  1806. var
  1807. CurIni: PSetupIniEntry;
  1808. IniSection, IniEntry, IniValue, IniFilename, IniDir: String;
  1809. Skip: Boolean;
  1810. begin
  1811. for var CurIniNumber := 0 to Entries[seIni].Count-1 do begin
  1812. CurIni := PSetupIniEntry(Entries[seIni][CurIniNumber]);
  1813. with CurIni^ do begin
  1814. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  1815. DebugNotifyEntry(seIni, CurIniNumber);
  1816. NotifyBeforeInstallEntry(BeforeInstall);
  1817. Log('-- INI entry --');
  1818. IniSection := ExpandConst(Section);
  1819. IniEntry := ExpandConst(Entry);
  1820. IniValue := ExpandConst(Value);
  1821. IniFilename := ExpandConst(Filename);
  1822. LogFmt('Dest filename: %s', [IniFilename]);
  1823. LogFmt('Section: %s', [IniSection]);
  1824. if IniEntry <> '' then
  1825. LogFmt('Entry: %s', [IniEntry]);
  1826. if ioHasValue in Options then
  1827. LogFmt('Value: %s', [IniValue]);
  1828. if (IniEntry <> '') and (ioHasValue in Options) and
  1829. (not(ioCreateKeyIfDoesntExist in Options) or
  1830. not IniKeyExists(IniSection, IniEntry, IniFilename)) then begin
  1831. Skip := False;
  1832. IniDir := PathExtractDir(IniFilename);
  1833. if IniDir <> '' then begin
  1834. while True do begin
  1835. try
  1836. MakeDir(UninstLog, False, IniDir, []);
  1837. Break;
  1838. except
  1839. if AbortRetryIgnoreTaskDialogMsgBox(
  1840. GetExceptMessage,
  1841. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  1842. Skip := True;
  1843. Break;
  1844. end;
  1845. end;
  1846. end;
  1847. end;
  1848. if not Skip then
  1849. Log('Updating the .INI file.');
  1850. repeat
  1851. if SetIniString(IniSection, IniEntry, IniValue, IniFilename) then begin
  1852. Log('Successfully updated the .INI file.');
  1853. Break;
  1854. end;
  1855. until AbortRetryIgnoreTaskDialogMsgBox(
  1856. FmtSetupMessage1(msgErrorIniEntry, IniFilename),
  1857. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]);
  1858. end else
  1859. Log('Skipping updating the .INI file, only updating uninstall log.');
  1860. if ioUninsDeleteEntireSection in Options then
  1861. UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection], 0);
  1862. if ioUninsDeleteSectionIfEmpty in Options then
  1863. UninstLog.Add(utIniDeleteSection, [IniFilename, IniSection],
  1864. utIniDeleteSection_OnlyIfEmpty);
  1865. if (ioUninsDeleteEntry in Options) and (IniEntry <> '') then
  1866. UninstLog.Add(utIniDeleteEntry, [IniFilename, IniSection, IniEntry], 0);
  1867. { ^ add utIniDeleteEntry last since we want it done first by the
  1868. uninstaller (in case the entry's also got the
  1869. "uninsdeletesectionifempty" flag) }
  1870. NotifyAfterInstallEntry(AfterInstall);
  1871. end;
  1872. end;
  1873. end;
  1874. { Increment progress meter }
  1875. IncProgress(1000);
  1876. end;
  1877. procedure CreateRegistryEntries(const UninstLog: TUninstallLog);
  1878. function IsDeletableSubkey(const S: String): Boolean;
  1879. { A sanity check to prevent people from shooting themselves in the foot by
  1880. using
  1881. Root: HKLM; Subkey: ""; Flags: [unins]deletekey
  1882. or a 'code' constant in Subkey that returns a blank string or only
  1883. backslashes. }
  1884. var
  1885. P: PChar;
  1886. begin
  1887. Result := False;
  1888. P := PChar(S);
  1889. while P^ <> #0 do begin
  1890. if P^ <> '\' then begin
  1891. Result := True;
  1892. Break;
  1893. end;
  1894. Inc(P);
  1895. end;
  1896. end;
  1897. procedure ApplyPermissions(const RegView: TRegView; const RootKey: HKEY;
  1898. const Subkey: String; const PermsEntry: Integer);
  1899. var
  1900. P: PSetupPermissionEntry;
  1901. begin
  1902. LogFmt('Setting permissions on key: %s\%s',
  1903. [GetRegRootKeyName(RootKey), Subkey]);
  1904. P := Entries[sePermission][PermsEntry];
  1905. if not GrantPermissionOnKey(RegView, RootKey, Subkey,
  1906. TGrantPermissionEntry(Pointer(P.Permissions)^),
  1907. Length(P.Permissions) div SizeOf(TGrantPermissionEntry)) then begin
  1908. if GetLastError = ERROR_FILE_NOT_FOUND then
  1909. Log('Could not set permissions on the key because it currently does not exist.')
  1910. else
  1911. LogFmt('Failed to set permissions on the key (%d).', [GetLastError]);
  1912. end;
  1913. end;
  1914. const
  1915. REG_QWORD = 11;
  1916. var
  1917. RK, K: HKEY;
  1918. Disp: DWORD;
  1919. N, V, ExistingData: String;
  1920. ExistingType, NewType, DV: DWORD;
  1921. S: String;
  1922. RV: TRegView;
  1923. NeedToRetry, DidDeleteKey: Boolean;
  1924. I: Integer;
  1925. AnsiS: AnsiString;
  1926. begin
  1927. for var CurRegNumber := 0 to Entries[seRegistry].Count-1 do begin
  1928. with PSetupRegistryEntry(Entries[seRegistry][CurRegNumber])^ do begin
  1929. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  1930. DebugNotifyEntry(seRegistry, CurRegNumber);
  1931. NotifyBeforeInstallEntry(BeforeInstall);
  1932. Log('-- Registry entry --');
  1933. RK := HKEY(RootKey);
  1934. if RK = HKEY_AUTO then
  1935. RK := InstallModeRootKey;
  1936. S := ExpandConst(Subkey);
  1937. LogFmt('Key: %s\%s', [GetRegRootKeyName(RK), Subkey]);
  1938. N := ExpandConst(ValueName);
  1939. if N <> '' then
  1940. LogFmt('Value name: %s', [N]);
  1941. RV := InstallDefaultRegView;
  1942. if (ro32Bit in Options) and (RV <> rv32Bit) then begin
  1943. Log('Non-default bitness: 32-bit');
  1944. RV := rv32Bit;
  1945. end;
  1946. if ro64Bit in Options then begin
  1947. if not IsWin64 then
  1948. InternalError('Cannot access 64-bit registry keys on this version of Windows');
  1949. if RV <> rv64Bit then begin
  1950. Log('Non-default bitness: 64-bit');
  1951. RV := rv64Bit;
  1952. end;
  1953. end;
  1954. repeat
  1955. NeedToRetry := False;
  1956. try
  1957. DidDeleteKey := False;
  1958. if roDeleteKey in Options then begin
  1959. if IsDeletableSubkey(S) then begin
  1960. Log('Deleting the key.');
  1961. RegDeleteKeyIncludingSubkeys(RV, RK, PChar(S));
  1962. DidDeleteKey := True;
  1963. end else
  1964. Log('Key to delete is not deletable.');
  1965. end;
  1966. if (roDeleteKey in Options) and (Typ = rtNone) then begin
  1967. { We've deleted the key, and no value is to be created.
  1968. Our work is done. }
  1969. if DidDeleteKey then
  1970. Log('Successfully deleted the key.');
  1971. end else if (roDeleteValue in Options) and (Typ = rtNone) then begin
  1972. { We're going to delete a value with no intention of creating
  1973. another, so don't create the key if it didn't exist. }
  1974. if RegOpenKeyExView(RV, RK, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  1975. Log('Deleting the value.');
  1976. RegDeleteValue(K, PChar(N));
  1977. RegCloseKey(K);
  1978. Log('Successfully deleted the value.');
  1979. { Our work is done. }
  1980. end else
  1981. Log('Key of value to delete does not exist.');
  1982. end
  1983. else begin
  1984. { Apply any permissions *before* calling RegCreateKeyExView or
  1985. RegOpenKeyExView, since we may (in a rather unlikely scenario)
  1986. need those permissions in order for those calls to succeed }
  1987. if PermissionsEntry <> -1 then
  1988. ApplyPermissions(RV, RK, S, PermissionsEntry);
  1989. { Create or open the key }
  1990. var ErrorCode: DWORD;
  1991. if not(roDontCreateKey in Options) then begin
  1992. Log('Creating or opening the key.');
  1993. ErrorCode := DWORD(RegCreateKeyExView(RV, RK, PChar(S), 0, nil,
  1994. REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE,
  1995. nil, K, @Disp));
  1996. if ErrorCode = ERROR_SUCCESS then begin
  1997. { Apply permissions again if a new key was created }
  1998. if (Disp = REG_CREATED_NEW_KEY) and (PermissionsEntry <> -1) then begin
  1999. Log('New key created, need to set permissions again.');
  2000. ApplyPermissions(RV, RK, S, PermissionsEntry);
  2001. end;
  2002. end
  2003. else begin
  2004. if not(roNoError in Options) then
  2005. RegError(reRegCreateKeyEx, RK, S, ErrorCode);
  2006. end;
  2007. end
  2008. else begin
  2009. if Typ <> rtNone then begin
  2010. Log('Opening the key.');
  2011. ErrorCode := DWORD(RegOpenKeyExView(RV, RK, PChar(S), 0,
  2012. KEY_QUERY_VALUE or KEY_SET_VALUE, K));
  2013. if (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ERROR_FILE_NOT_FOUND) then
  2014. if not(roNoError in Options) then
  2015. RegError(reRegOpenKeyEx, RK, S, ErrorCode);
  2016. end
  2017. else begin
  2018. { We're not creating a value, and we're not just deleting a
  2019. value (that was checked above), so there is no reason to
  2020. even open the key }
  2021. Log('Not creating the key or a value, skipping the key and only updating uninstall log.');
  2022. ErrorCode := ERROR_FILE_NOT_FOUND;
  2023. end;
  2024. end;
  2025. { If there was no error opening the key, proceed with deleting
  2026. and/or creating the value }
  2027. if ErrorCode = ERROR_SUCCESS then
  2028. try
  2029. if roDeleteValue in Options then begin
  2030. Log('Deleting the value.');
  2031. RegDeleteValue(K, PChar(N));
  2032. end;
  2033. if (Typ <> rtNone) and
  2034. (not(roCreateValueIfDoesntExist in Options) or
  2035. not RegValueExists(K, PChar(N))) then begin
  2036. Log('Creating or setting the value.');
  2037. case Typ of
  2038. rtString, rtExpandString, rtMultiString: begin
  2039. NewType := REG_SZ;
  2040. case Typ of
  2041. rtExpandString: NewType := REG_EXPAND_SZ;
  2042. rtMultiString: NewType := REG_MULTI_SZ;
  2043. end;
  2044. if Typ <> rtMultiString then begin
  2045. if (Pos('{olddata}', ValueData) <> 0) and
  2046. RegQueryStringValue(K, PChar(N), ExistingData) then
  2047. { successful }
  2048. else
  2049. ExistingData := '';
  2050. if roPreserveStringType in Options then begin
  2051. if (RegQueryValueEx(K, PChar(N), nil, @ExistingType, nil, nil) = ERROR_SUCCESS) and
  2052. ((ExistingType = REG_SZ) or (ExistingType = REG_EXPAND_SZ)) then
  2053. NewType := ExistingType;
  2054. end;
  2055. V := ExpandConstEx(ValueData, ['olddata', ExistingData])
  2056. end
  2057. else begin
  2058. if (Pos('{olddata}', ValueData) <> 0) and
  2059. RegQueryMultiStringValue(K, PChar(N), ExistingData) then
  2060. { successful }
  2061. else
  2062. ExistingData := '';
  2063. V := ExpandConstEx(ValueData, ['olddata', ExistingData,
  2064. 'break', #0]);
  2065. { Multi-string data requires two null terminators:
  2066. one after the last string, and one to mark the end.
  2067. Delphi's String type is implicitly null-terminated,
  2068. so only one null needs to be added to the end. }
  2069. if (V <> '') and (V[Length(V)] <> #0) then
  2070. V := V + #0;
  2071. end;
  2072. ErrorCode := DWORD(RegSetValueEx(K, PChar(N), 0, NewType,
  2073. PChar(V), (ULength(V)+1)*SizeOf(V[1])));
  2074. if (ErrorCode <> ERROR_SUCCESS) and
  2075. not(roNoError in Options) then
  2076. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2077. end;
  2078. rtDWord: begin
  2079. DV := DWORD(StrToInt(ExpandConst(ValueData)));
  2080. ErrorCode := DWORD(RegSetValueEx(K, PChar(N), 0, REG_DWORD,
  2081. @DV, SizeOf(DV)));
  2082. if (ErrorCode <> ERROR_SUCCESS) and
  2083. not(roNoError in Options) then
  2084. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2085. end;
  2086. rtQWord: begin
  2087. const QV: UInt64 = StrToUInt64(ExpandConst(ValueData));
  2088. ErrorCode := DWORD(RegSetValueEx(K, PChar(N), 0, REG_QWORD,
  2089. @QV, SizeOf(QV)));
  2090. if (ErrorCode <> ERROR_SUCCESS) and
  2091. not(roNoError in Options) then
  2092. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2093. end;
  2094. rtBinary: begin
  2095. AnsiS := '';
  2096. for I := 1 to Length(ValueData) do
  2097. AnsiS := AnsiS + AnsiChar(Ord(ValueData[I]));
  2098. ErrorCode := DWORD(RegSetValueEx(K, PChar(N), 0, REG_BINARY,
  2099. PAnsiChar(AnsiS), ULength(AnsiS)));
  2100. if (ErrorCode <> ERROR_SUCCESS) and
  2101. not(roNoError in Options) then
  2102. RegError(reRegSetValueEx, RK, S, ErrorCode);
  2103. end;
  2104. end;
  2105. Log('Successfully created or set the value.');
  2106. end else if roDeleteValue in Options then
  2107. Log('Successfully deleted the value.')
  2108. else
  2109. Log('Successfully created the key.')
  2110. { Our work is done. }
  2111. finally
  2112. RegCloseKey(K);
  2113. end;
  2114. end;
  2115. except
  2116. if not AbortRetryIgnoreTaskDialogMsgBox(
  2117. GetExceptMessage,
  2118. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgAbortRetryIgnoreIgnore], SetupMessages[msgAbortRetryIgnoreCancel]]) then begin
  2119. Log('Retrying.');
  2120. NeedToRetry := True;
  2121. end;
  2122. end;
  2123. until not NeedToRetry;
  2124. if roUninsDeleteEntireKey in Options then
  2125. if IsDeletableSubkey(S) then
  2126. UninstLog.AddReg(utRegDeleteEntireKey, RV, RK, [S]);
  2127. if roUninsDeleteEntireKeyIfEmpty in Options then
  2128. if IsDeletableSubkey(S) then
  2129. UninstLog.AddReg(utRegDeleteKeyIfEmpty, RV, RK, [S]);
  2130. if roUninsDeleteValue in Options then
  2131. UninstLog.AddReg(utRegDeleteValue, RV, RK, [S, N]);
  2132. { ^ must add roUninsDeleteValue after roUninstDeleteEntireKey*
  2133. since the entry may have both the roUninsDeleteValue and
  2134. roUninsDeleteEntireKeyIfEmpty options }
  2135. if roUninsClearValue in Options then
  2136. UninstLog.AddReg(utRegClearValue, RV, RK, [S, N]);
  2137. NotifyAfterInstallEntry(AfterInstall);
  2138. end;
  2139. end;
  2140. end;
  2141. { Increment progress meter }
  2142. IncProgress(1000);
  2143. end;
  2144. procedure RegisterFiles(const RegisterFilesList: TList);
  2145. procedure RegisterServersOnRestart;
  2146. function CreateRegSvrExe(const Dir: String): String;
  2147. var
  2148. ExeFilename: String;
  2149. SourceF, DestF: TFile;
  2150. NumRead: Cardinal;
  2151. Buf: array[0..16383] of Byte;
  2152. begin
  2153. ExeFilename := GenerateUniqueName(False, Dir, '.exe');
  2154. DestF := nil;
  2155. SourceF := TFile.Create(NewParamStr(0), fdOpenExisting, faRead, fsRead);
  2156. try
  2157. DestF := TFile.Create(ExeFilename, fdCreateAlways, faWrite, fsNone);
  2158. try
  2159. DestF.Seek(SourceF.Size);
  2160. DestF.Truncate;
  2161. DestF.Seek(0);
  2162. while True do begin
  2163. NumRead := SourceF.Read(Buf, SizeOf(Buf));
  2164. if NumRead = 0 then
  2165. Break;
  2166. DestF.WriteBuffer(Buf, NumRead);
  2167. end;
  2168. if not(shSignedUninstaller in SetupHeader.Options) then
  2169. MarkExeHeader(DestF, SetupExeModeRegSvr);
  2170. except
  2171. FreeAndNil(DestF);
  2172. DeleteFile(ExeFilename);
  2173. raise;
  2174. end;
  2175. finally
  2176. DestF.Free;
  2177. SourceF.Free;
  2178. end;
  2179. Result := ExeFilename;
  2180. end;
  2181. procedure CreateRegSvrMsg(const Filename: String);
  2182. var
  2183. F: TFile;
  2184. begin
  2185. F := TFile.Create(Filename, fdCreateAlways, faWrite, fsNone);
  2186. try
  2187. WriteMsgData(F);
  2188. finally
  2189. F.Free;
  2190. end;
  2191. end;
  2192. const
  2193. Chars: array[Boolean, Boolean] of Char = (('s', 't'), ('S', 'T'));
  2194. var
  2195. RegSvrExeFilename: String;
  2196. F: TTextFileWriter;
  2197. Rec: PRegisterFilesListRec;
  2198. RootKey, H: HKEY;
  2199. J: Integer;
  2200. Disp: DWORD;
  2201. ValueName, Data: String;
  2202. begin
  2203. { Create RegSvr program used to register OLE servers & type libraries on
  2204. the next reboot }
  2205. if IsAdmin then begin
  2206. try
  2207. RegSvrExeFilename := CreateRegSvrExe(WinDir);
  2208. except
  2209. { In case Windows directory is write protected, try the Temp directory.
  2210. Windows directory is our first choice since some people (ignorantly)
  2211. put things like "DELTREE C:\WINDOWS\TEMP\*.*" in their AUTOEXEC.BAT.
  2212. Also, each user has his own personal Temp directory which may not
  2213. be accessible by other users. }
  2214. RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
  2215. end;
  2216. end
  2217. else begin
  2218. { Always use Temp directory when user doesn't have admin privileges }
  2219. RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
  2220. end;
  2221. LogFmt('Registration executable created: %s', [RegSvrExeFilename]);
  2222. try
  2223. CreateRegSvrMsg(PathChangeExt(RegSvrExeFilename, '.msg'));
  2224. F := TTextFileWriter.Create(PathChangeExt(RegSvrExeFilename, '.lst'),
  2225. fdCreateAlways, faWrite, fsNone);
  2226. try
  2227. F.WriteLine('; This file was created by the installer for:');
  2228. F.WriteLine('; ' + ExpandedAppVerName);
  2229. F.WriteLine('; Location: ' + SetupLdrOriginalFilename);
  2230. F.WriteLine('');
  2231. F.WriteLine('; List of files to be registered on the next reboot. DO NOT EDIT!');
  2232. F.WriteLine('');
  2233. for var I := 0 to RegisterFilesList.Count-1 do begin
  2234. Rec := RegisterFilesList[I];
  2235. Data := '[..]' + Rec.Filename;
  2236. Data[2] := Chars[Rec.Is64Bit, Rec.TypeLib];
  2237. if Rec.NoErrorMessages then
  2238. Data[3] := 'q';
  2239. F.WriteLine(Data);
  2240. end;
  2241. finally
  2242. F.Free;
  2243. end;
  2244. if IsAdmin then
  2245. RootKey := HKEY_LOCAL_MACHINE
  2246. else
  2247. RootKey := HKEY_CURRENT_USER;
  2248. var ErrorCode := DWORD(RegCreateKeyExView(rvDefault, RootKey, REGSTR_PATH_RUNONCE, 0, nil,
  2249. REG_OPTION_NON_VOLATILE, KEY_SET_VALUE or KEY_QUERY_VALUE,
  2250. nil, H, @Disp));
  2251. if ErrorCode <> ERROR_SUCCESS then
  2252. RegError(reRegCreateKeyEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
  2253. try
  2254. J := 0;
  2255. while True do begin
  2256. Inc(J);
  2257. ValueName := Format('InnoSetupRegFile.%.10d', [J]); { don't localize }
  2258. { ^ Note: Names of values written to the "RunOnce" key cannot
  2259. exceed 31 characters! Otherwise the original Windows
  2260. Explorer 4.0 will not process them. }
  2261. if not RegValueExists(H, PChar(ValueName)) then begin
  2262. Data := '"' + RegSvrExeFilename + '" /REG';
  2263. if not IsAdmin then
  2264. Data := Data + 'U'; { /REG -> /REGU when not running as admin }
  2265. { Note: RegSvr expects /REG(U) to be the first parameter }
  2266. Data := Data + ' /REGSVRMODE';
  2267. ErrorCode := DWORD(RegSetValueEx(H, PChar(ValueName), 0, REG_SZ, PChar(Data),
  2268. (ULength(Data)+1)*SizeOf(Data[1])));
  2269. if ErrorCode <> ERROR_SUCCESS then
  2270. RegError(reRegSetValueEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
  2271. Break;
  2272. end;
  2273. end;
  2274. finally
  2275. RegCloseKey(H);
  2276. end;
  2277. except
  2278. DeleteFile(PathChangeExt(RegSvrExeFilename, '.lst'));
  2279. DeleteFile(PathChangeExt(RegSvrExeFilename, '.msg'));
  2280. DeleteFile(RegSvrExeFilename);
  2281. raise;
  2282. end;
  2283. end;
  2284. procedure RegisterSvr(const Is64Bit: Boolean; const Filename: String;
  2285. const NoErrorMessages: Boolean);
  2286. var
  2287. NeedToRetry: Boolean;
  2288. begin
  2289. repeat
  2290. if Is64Bit then
  2291. LogFmt('Registering 64-bit DLL/OCX: %s', [Filename])
  2292. else
  2293. LogFmt('Registering 32-bit DLL/OCX: %s', [Filename]);
  2294. NeedToRetry := False;
  2295. try
  2296. RegisterServer(False, Is64Bit, Filename, NoErrorMessages);
  2297. Log('Registration successful.');
  2298. except
  2299. Log('Registration failed:' + SNewLine + GetExceptMessage);
  2300. if not NoErrorMessages then
  2301. if not AbortRetryIgnoreTaskDialogMsgBox(
  2302. Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterServer, GetExceptMessage),
  2303. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2304. NeedToRetry := True;
  2305. end;
  2306. until not NeedToRetry;
  2307. end;
  2308. procedure RegisterTLib(const Is64Bit: Boolean; const Filename: String;
  2309. const NoErrorMessages: Boolean);
  2310. var
  2311. NeedToRetry: Boolean;
  2312. begin
  2313. repeat
  2314. if Is64Bit then
  2315. LogFmt('Registering 64-bit type library: %s', [Filename])
  2316. else
  2317. LogFmt('Registering 32-bit type library: %s', [Filename]);
  2318. NeedToRetry := False;
  2319. try
  2320. if Is64Bit then
  2321. HelperRegisterTypeLibrary(False, Filename)
  2322. else
  2323. RegisterTypeLibrary(Filename);
  2324. Log('Registration successful.');
  2325. except
  2326. Log('Registration failed:' + SNewLine + GetExceptMessage);
  2327. if not NoErrorMessages then
  2328. if not AbortRetryIgnoreTaskDialogMsgBox(
  2329. Filename + SNewLine2 + FmtSetupMessage1(msgErrorRegisterTypeLib, GetExceptMessage),
  2330. [SetupMessages[msgAbortRetryIgnoreRetry], SetupMessages[msgFileAbortRetryIgnoreIgnoreNotRecommended], SetupMessages[msgAbortRetryIgnoreCancel]]) then
  2331. NeedToRetry := True;
  2332. end;
  2333. until not NeedToRetry;
  2334. end;
  2335. begin
  2336. if not NeedsRestart then
  2337. for var I := 0 to RegisterFilesList.Count-1 do begin
  2338. with PRegisterFilesListRec(RegisterFilesList[I])^ do
  2339. if not TypeLib then
  2340. RegisterSvr(Is64Bit, Filename, NoErrorMessages)
  2341. else
  2342. RegisterTLib(Is64Bit, Filename, NoErrorMessages);
  2343. end
  2344. else begin
  2345. { When a restart is needed, all "regserver" & "regtypelib" files will get
  2346. registered on the next logon }
  2347. Log('Delaying registration of all files until the next logon since a restart is needed.');
  2348. try
  2349. RegisterServersOnRestart;
  2350. except
  2351. Application.HandleException(nil);
  2352. end;
  2353. end;
  2354. end;
  2355. procedure RecordUninstallDeleteEntries(const UninstLog: TUninstallLog);
  2356. const
  2357. DefFlags: array[TSetupDeleteType] of Longint = (
  2358. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles,
  2359. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_DeleteFiles or
  2360. utDeleteDirOrFiles_DeleteSubdirsAlso,
  2361. utDeleteDirOrFiles_Extra or utDeleteDirOrFiles_IsDir);
  2362. begin
  2363. for var I := Entries[seUninstallDelete].Count-1 downto 0 do
  2364. { ^ process backwards so the uninstaller will process them in the order
  2365. they appear in the script }
  2366. with PSetupDeleteEntry(Entries[seUninstallDelete][I])^ do
  2367. if ShouldProcessEntry(WizardComponents, WizardTasks, Components, Tasks, Languages, Check) then begin
  2368. DebugNotifyEntry(seUninstallDelete, I);
  2369. NotifyBeforeInstallEntry(BeforeInstall);
  2370. var Flags := DefFlags[DeleteType];
  2371. if InstallDefaultDisableFsRedir then
  2372. Flags := Flags or utDeleteDirOrFiles_DisableFsRedir;
  2373. UninstLog.Add(utDeleteDirOrFiles, [ExpandConst(Name)], Flags);
  2374. NotifyAfterInstallEntry(AfterInstall);
  2375. end;
  2376. end;
  2377. procedure RecordUninstallRunEntries(const UninstLog: TUninstallLog);
  2378. var
  2379. RunEntry: PSetupRunEntry;
  2380. begin
  2381. for var I := Entries[seUninstallRun].Count-1 downto 0 do begin
  2382. { ^ process backwards so the uninstaller will process them in the order
  2383. they appear in the script }
  2384. RunEntry := PSetupRunEntry(Entries[seUninstallRun][I]);
  2385. if ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components,
  2386. RunEntry.Tasks, RunEntry.Languages, RunEntry.Check) then begin
  2387. DebugNotifyEntry(seUninstallRun, I);
  2388. NotifyBeforeInstallEntry(RunEntry.BeforeInstall);
  2389. var Flags := 0;
  2390. case RunEntry.Wait of
  2391. rwNoWait: Flags := Flags or utRun_NoWait;
  2392. rwWaitUntilIdle: Flags := Flags or utRun_WaitUntilIdle;
  2393. end;
  2394. if roShellExec in RunEntry.Options then
  2395. Flags := Flags or (utRun_ShellExec or utRun_ShellExecRespectWaitFlags)
  2396. else begin
  2397. if ShouldDisableFsRedirForRunEntry(RunEntry) then
  2398. Flags := Flags or utRun_DisableFsRedir;
  2399. end;
  2400. if roSkipIfDoesntExist in RunEntry.Options then
  2401. Flags := Flags or utRun_SkipIfDoesntExist;
  2402. case RunEntry.ShowCmd of
  2403. SW_SHOWMINNOACTIVE: Flags := Flags or utRun_RunMinimized;
  2404. SW_SHOWMAXIMIZED: Flags := Flags or utRun_RunMaximized;
  2405. SW_HIDE: Flags := Flags or utRun_RunHidden;
  2406. end;
  2407. if roDontLogParameters in RunEntry.Options then
  2408. Flags := Flags or utRun_DontLogParameters;
  2409. if roLogOutput in RunEntry.Options then
  2410. Flags := Flags or utRun_LogOutput;
  2411. UninstLog.Add(utRun, [ExpandConst(RunEntry.Name),
  2412. ExpandConst(RunEntry.Parameters), ExpandConst(RunEntry.WorkingDir),
  2413. ExpandConst(RunEntry.RunOnceId), ExpandConst(RunEntry.Verb)],
  2414. Flags);
  2415. NotifyAfterInstallEntry(RunEntry.AfterInstall);
  2416. end;
  2417. end;
  2418. end;
  2419. procedure GenerateUninstallInfoFilename(const UninstLog: TUninstallLog;
  2420. var UninstallDataFilename, UninstallMsgFilename: String;
  2421. var UninstallDataCreated, AppendUninstallData: Boolean);
  2422. procedure FindFiles(const BaseDir: String; var ExistingFiles: array of Boolean);
  2423. var
  2424. H: THandle;
  2425. FindData: TWin32FindData;
  2426. S: String;
  2427. begin
  2428. H := FindFirstFile(PChar(AddBackslash(BaseDir) + 'unins???.*'),
  2429. FindData);
  2430. if H <> INVALID_HANDLE_VALUE then begin
  2431. repeat
  2432. S := FindData.cFilename;
  2433. if (Length(S) >= 9) and (CompareText(Copy(S, 1, 5), 'unins') = 0) and
  2434. CharInSet(S[6], ['0'..'9']) and CharInSet(S[7], ['0'..'9']) and CharInSet(S[8], ['0'..'9']) and
  2435. (S[9] = '.') then
  2436. ExistingFiles[StrToInt(Copy(S, 6, 3))] := True;
  2437. until not FindNextFile(H, FindData);
  2438. Windows.FindClose(H);
  2439. end;
  2440. end;
  2441. procedure GenerateFilenames(const BaseDir: String; const I: Integer);
  2442. var
  2443. BaseFilename: String;
  2444. begin
  2445. BaseFilename := AddBackslash(BaseDir) + Format('unins%.3d', [I]);
  2446. UninstallExeFilename := BaseFilename + '.exe'; { UninstallExeFilename is a global }
  2447. UninstallDataFilename := BaseFilename + '.dat';
  2448. UninstallMsgFilename := BaseFilename + '.msg';
  2449. end;
  2450. procedure ReserveDataFile;
  2451. var
  2452. H: THandle;
  2453. begin
  2454. { Create an empty .dat file to reserve the filename. }
  2455. H := CreateFile(PChar(UninstallDataFilename), GENERIC_READ or GENERIC_WRITE,
  2456. 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
  2457. if H = INVALID_HANDLE_VALUE then
  2458. Win32ErrorMsg('CreateFile');
  2459. CloseHandle(H);
  2460. UninstallDataCreated := True;
  2461. end;
  2462. var
  2463. ExistingFiles: array[0..999] of Boolean;
  2464. begin
  2465. { Note: We never disable FS redirection when writing to UninstallFilesDir.
  2466. If someone sets UninstallFilesDir to "sys", we can't place a 32-bit
  2467. uninstaller in the 64-bit system directory, because it wouldn't see its
  2468. .dat file -- it would try to open 'windows\system32\unins???.dat' but
  2469. fail because system32 maps to syswow64 by default.
  2470. Not to mention, 32-bit EXEs really have no business being in the 64-bit
  2471. system directory, and vice versa. Might result in undefined behavior? }
  2472. { Because we don't disable FS redirection, we have to change any system32
  2473. to syswow64, otherwise Add/Remove Programs would look for the
  2474. UninstallString executable in the 64-bit system directory (at least
  2475. when using a 64-bit Uninstall key) }
  2476. const BaseDir = ReplaceSystemDirWithSysWow64(PathExpand(ExpandConst(SetupHeader.UninstallFilesDir)));
  2477. LogFmt('Directory for uninstall files: %s', [BaseDir]);
  2478. MakeDir(UninstLog, False, BaseDir, []);
  2479. FillChar(ExistingFiles, SizeOf(ExistingFiles), 0); { set all to False }
  2480. FindFiles(BaseDir, ExistingFiles);
  2481. { Look for an existing .dat file to append to or overwrite }
  2482. if SetupHeader.UninstallLogMode <> lmNew then
  2483. for var I := 0 to 999 do
  2484. if ExistingFiles[I] then begin
  2485. GenerateFilenames(BaseDir, I);
  2486. if NewFileExists(UninstallDataFilename) and
  2487. UninstLog.CanAppend(UninstallDataFilename) then begin
  2488. if SetupHeader.UninstallLogMode = lmAppend then begin
  2489. LogFmt('Will append to existing uninstall log: %s', [UninstallDataFilename]);
  2490. AppendUninstallData := True;
  2491. end
  2492. else
  2493. LogFmt('Will overwrite existing uninstall log: %s', [UninstallDataFilename]);
  2494. Exit;
  2495. end;
  2496. end;
  2497. { None found; use a new .dat file }
  2498. for var I := 0 to 999 do
  2499. if not ExistingFiles[I] then begin
  2500. GenerateFilenames(BaseDir, I);
  2501. LogFmt('Creating new uninstall log: %s', [UninstallDataFilename]);
  2502. ReserveDataFile;
  2503. Exit;
  2504. end;
  2505. raise Exception.Create(FmtSetupMessage1(msgErrorTooManyFilesInDir,
  2506. BaseDir));
  2507. end;
  2508. procedure RenameUninstallExe(var UninstallTempExeFilename: String);
  2509. begin
  2510. { If the uninstall EXE wasn't extracted to a .tmp file because it isn't
  2511. replacing an existing uninstall EXE, exit. }
  2512. if UninstallTempExeFilename = '' then
  2513. Exit;
  2514. Log('Renaming uninstaller.');
  2515. var Timer: TOneShotTimer;
  2516. const CapturableUninstallTempExeFilename = UninstallTempExeFilename;
  2517. PerformFileOperationWithRetries(4, False,
  2518. function(out LastError: Cardinal): Boolean
  2519. begin
  2520. Timer.Start(1000);
  2521. Result := MoveFileReplace(CapturableUninstallTempExeFilename, UninstallExeFilename);
  2522. if not Result then
  2523. LastError := GetLastError;
  2524. end,
  2525. procedure(const LastError: Cardinal)
  2526. begin
  2527. LogFmt('The existing file appears to be in use (%d). ' +
  2528. 'Retrying.', [LastError]);
  2529. Timer.SleepUntilExpired;
  2530. ProcessEvents;
  2531. end,
  2532. procedure(const LastError: Cardinal; var TryOnceMore: Boolean)
  2533. begin
  2534. const LastOperation = SetupMessages[msgErrorReplacingExistingFile];
  2535. const Failed = AddPeriod(FmtSetupMessage(msgErrorFunctionFailedWithMessage,
  2536. ['MoveFileEx', IntToStr(LastError), Win32ErrorString(LastError)]));
  2537. const Text = UninstallExeFilename + SNewLine2 + LastOperation + SNewLine + Failed;
  2538. case LoggedTaskDialogMsgBox('', SetupMessages[msgRetryCancelSelectAction], Text, '',
  2539. mbError, MB_RETRYCANCEL, [SetupMessages[msgRetryCancelRetry], SetupMessages[msgRetryCancelCancel]],
  2540. 0, True, IDCANCEL) of
  2541. IDRETRY: TryOnceMore := True;
  2542. IDCANCEL: Abort;
  2543. else
  2544. Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Cancel.');
  2545. Abort;
  2546. end;
  2547. end);
  2548. UninstallTempExeFilename := '';
  2549. end;
  2550. function CreateUninstallMsgFile(const UninstallExeCreated: TUninstallExeCreated;
  2551. const UninstallMsgFilename: String): Boolean;
  2552. { If the uninstaller EXE has a digital signature, or if Setup was started
  2553. with /DETACHEDMSG, create the unins???.msg file }
  2554. var
  2555. F: TFile;
  2556. begin
  2557. { If this installation didn't create or replace an unins???.exe file,
  2558. do nothing }
  2559. Result := False;
  2560. if (UninstallExeCreated <> ueNone) and
  2561. ((shSignedUninstaller in SetupHeader.Options) or DetachedUninstMsgFile) then begin
  2562. LogFmt('Writing uninstaller messages: %s', [UninstallMsgFilename]);
  2563. F := TFile.Create(UninstallMsgFilename, fdCreateAlways, faWrite, fsNone);
  2564. try
  2565. if UninstallExeCreated = ueNew then
  2566. Result := True;
  2567. WriteMsgData(F);
  2568. finally
  2569. F.Free;
  2570. end;
  2571. end;
  2572. end;
  2573. procedure PerformInstall(var Succeeded: Boolean; const ChangesEnvironment,
  2574. ChangesAssociations: Boolean);
  2575. begin
  2576. Succeeded := False;
  2577. Log('Starting the installation process.');
  2578. SetCurrentDir(WinSystemDir);
  2579. var InstallFilesSize, AfterInstallFilesSize: Int64;
  2580. CalcFilesSize(InstallFilesSize, AfterInstallFilesSize);
  2581. InitProgressGauge(InstallFilesSize);
  2582. var RegisterFilesList: TList := nil;
  2583. const UninstLog = TSetupUninstallLog.Create;
  2584. try
  2585. var UninstallExeCreated := ueNone;
  2586. var UninstallDataCreated := False;
  2587. var UninstallMsgCreated := False;
  2588. var UninstLogCleared := False;
  2589. var UninstallTempExeFilename, UninstallDataFilename, UninstallMsgFilename: String; { There's also UninstallExeFilename but it's a global }
  2590. try
  2591. { Get AppId, UninstallRegKeyBaseName, and Uninstallable now so the user
  2592. can't change them while we're installing }
  2593. const ExpandedAppId = ExpandConst(SetupHeader.AppId);
  2594. if ExpandedAppId = '' then
  2595. InternalError('Failed to get a non empty installation "AppId"');
  2596. if TUninstallLog.WriteSafeHeaderString(nil, ExpandedAppId, 0) > 128 then
  2597. InternalError('"AppId" cannot exceed 128 bytes (encoded)');
  2598. const UninstallRegKeyBaseName = GetUninstallRegKeyBaseName(ExpandedAppId);
  2599. const Uninstallable = EvalDirectiveCheck(SetupHeader.Uninstallable);
  2600. { Init }
  2601. UninstLog.InstallMode64Bit := Is64BitInstallMode;
  2602. UninstLog.AppName := ExpandedAppName;
  2603. UninstLog.AppId := ExpandedAppId;
  2604. if IsAdminInstallMode then
  2605. Include(UninstLog.Flags, ufAdminInstallMode);
  2606. if IsWin64 then
  2607. Include(UninstLog.Flags, ufWin64);
  2608. if IsAdmin then { Setup or [Code] might have done administrative actions, even if IsAdminInstallMode is False }
  2609. Include(UninstLog.Flags, ufAdminInstalled)
  2610. else if IsPowerUserOrAdmin then
  2611. { Note: This flag is only set in 5.1.9 and later }
  2612. Include(UninstLog.Flags, ufPowerUserInstalled);
  2613. if shUninstallRestartComputer in SetupHeader.Options then
  2614. Include(UninstLog.Flags, ufAlwaysRestart);
  2615. if ChangesEnvironment then
  2616. Include(UninstLog.Flags, ufChangesEnvironment);
  2617. if RedirectionGuardEnabled then
  2618. Include(UninstLog.Flags, ufRedirectionGuard);
  2619. RecordStartInstall(UninstLog);
  2620. RecordCompiledCode(UninstLog);
  2621. RegisterFilesList := TList.Create;
  2622. { Process Component entries, if any }
  2623. ProcessComponentEntries;
  2624. ProcessEvents;
  2625. { Process Tasks entries, if any }
  2626. ProcessTasksEntries;
  2627. ProcessEvents;
  2628. { Shutdown applications, if any }
  2629. if RmSessionStarted and RmFoundApplications then begin
  2630. if WizardPreparingYesRadio then begin
  2631. SetStatusLabelText(SetupMessages[msgStatusClosingApplications]);
  2632. ShutdownApplications;
  2633. ProcessEvents;
  2634. end else
  2635. Log('User chose not to shutdown applications using our files.');
  2636. end;
  2637. { Process InstallDelete entries, if any }
  2638. ProcessInstallDeleteEntries;
  2639. ProcessEvents;
  2640. if ExpandedAppMutex <> '' then
  2641. UninstLog.Add(utMutexCheck, [ExpandedAppMutex], 0);
  2642. if ChangesAssociations then
  2643. UninstLog.Add(utRefreshFileAssoc, [''], 0);
  2644. { Record UninstallDelete entries, if any }
  2645. RecordUninstallDeleteEntries(UninstLog);
  2646. ProcessEvents;
  2647. { Create the application directory and extra dirs }
  2648. SetStatusLabelText(SetupMessages[msgStatusCreateDirs]);
  2649. CreateDirs(UninstLog);
  2650. ProcessEvents;
  2651. var AppendUninstallData := False;
  2652. if Uninstallable then begin
  2653. { Generate the filenam(UninstLog)es for the uninstall info in the application
  2654. directory }
  2655. SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
  2656. GenerateUninstallInfoFilename(UninstLog, UninstallDataFilename, UninstallMsgFilename,
  2657. UninstallDataCreated, AppendUninstallData);
  2658. end;
  2659. { Copy the files }
  2660. SetStatusLabelText(SetupMessages[msgStatusExtractFiles]);
  2661. CopyFiles(UninstLog, ExpandedAppId, RegisterFilesList, Uninstallable,
  2662. UninstallTempExeFilename, UninstallExeCreated);
  2663. ProcessEvents;
  2664. { Create program icons, if any }
  2665. if HasIcons then begin
  2666. SetStatusLabelText(SetupMessages[msgStatusCreateIcons]);
  2667. CreateIcons(UninstLog);
  2668. ProcessEvents;
  2669. end;
  2670. { Create INI entries, if any }
  2671. if Entries[seIni].Count <> 0 then begin
  2672. SetStatusLabelText(SetupMessages[msgStatusCreateIniEntries]);
  2673. CreateIniEntries(UninstLog);
  2674. ProcessEvents;
  2675. end;
  2676. { Create registry entries, if any }
  2677. if Entries[seRegistry].Count <> 0 then begin
  2678. SetStatusLabelText(SetupMessages[msgStatusCreateRegistryEntries]);
  2679. CreateRegistryEntries(UninstLog);
  2680. ProcessEvents;
  2681. end;
  2682. { Call the NeedRestart event function now.
  2683. Note: This can't be done after RegisterFiles, since RegisterFiles
  2684. relies on the setting of the NeedsRestart variable. }
  2685. SetStatusLabelText('');
  2686. ProcessNeedRestartEvent;
  2687. ProcessEvents;
  2688. { Register files, if any }
  2689. if RegisterFilesList.Count <> 0 then begin
  2690. SetStatusLabelText(SetupMessages[msgStatusRegisterFiles]);
  2691. RegisterFiles(RegisterFilesList);
  2692. ProcessEvents;
  2693. end;
  2694. { Save uninstall information. After uninstall info is saved, you cannot
  2695. make any more modifications to the user's system. Any additional
  2696. modifications you want to add must be done before this is called. }
  2697. if Uninstallable then begin
  2698. SetStatusLabelText(SetupMessages[msgStatusSavingUninstall]);
  2699. Log('Saving uninstall information.');
  2700. RenameUninstallExe(UninstallTempExeFilename);
  2701. UninstallMsgCreated := CreateUninstallMsgFile(UninstallExeCreated, UninstallMsgFilename);
  2702. { Register uninstall information so the program can be uninstalled
  2703. through the Add/Remove Programs Control Panel applet. This is done
  2704. on NT 3.51 too, so that the uninstall entry for the app will appear
  2705. if the user later upgrades to NT 4.0+. }
  2706. if EvalDirectiveCheck(SetupHeader.CreateUninstallRegKey) then
  2707. RegisterUninstallInfo(UninstLog, UninstallRegKeyBaseName, AfterInstallFilesSize);
  2708. RecordUninstallRunEntries(UninstLog);
  2709. UninstLog.Add(utEndInstall, [GetLocalTimeAsStr], 0);
  2710. UninstLog.Save(UninstallDataFilename, AppendUninstallData,
  2711. shUpdateUninstallLogAppName in SetupHeader.Options);
  2712. if Debugging then
  2713. DebugNotifyUninstExe(UninstallExeFileName);
  2714. end;
  2715. SetStatusLabelText('');
  2716. UninstLogCleared := True;
  2717. UninstLog.Clear;
  2718. except
  2719. try
  2720. { Show error message, if any, and set the exit code we'll be returning }
  2721. if not(ExceptObject is EAbort) then begin
  2722. Log(Format('Fatal exception during installation process (%s):' + SNewLine,
  2723. [ExceptObject.ClassName]) + GetExceptMessage);
  2724. SetupExitCode := ecInstallationError;
  2725. Application.HandleException(nil);
  2726. LoggedMsgBox(SetupMessages[msgSetupAborted], '', mbCriticalError, MB_OK, True, IDOK);
  2727. end
  2728. else begin
  2729. Log('User canceled the installation process.');
  2730. SetupExitCode := ecInstallationCancelled;
  2731. end;
  2732. { Undo any changes it's made so far }
  2733. if not UninstLogCleared then begin
  2734. Log('Rolling back changes.');
  2735. try
  2736. SetStatusLabelText(SetupMessages[msgStatusRollback]);
  2737. WizardForm.ProgressGauge.Visible := False;
  2738. FinishProgressGauge(True);
  2739. WizardForm.CancelButton.Enabled := False;
  2740. WizardForm.Update;
  2741. except
  2742. { ignore any exceptions, just in case... }
  2743. end;
  2744. if UninstallTempExeFilename <> '' then
  2745. DeleteFile(UninstallTempExeFilename);
  2746. if UninstallExeCreated = ueNew then
  2747. DeleteFile(UninstallExeFilename);
  2748. if UninstallDataCreated then
  2749. DeleteFile(UninstallDataFilename);
  2750. if UninstallMsgCreated then
  2751. DeleteFile(UninstallMsgFilename);
  2752. UninstLog.PerformUninstall(False, nil);
  2753. { Sleep for a bit so that the user has time to read the "Rolling
  2754. back changes" message }
  2755. if WizardForm.Visible then
  2756. Sleep(1500);
  2757. end;
  2758. except
  2759. { No exception should be generated by the above code, but just in
  2760. case, handle any exception now so that Application.Terminate is
  2761. always called below.
  2762. Note that we can't just put Application.Terminate in a finally
  2763. section, because it would prevent the display of an exception
  2764. message box later (MessageBox() dislikes WM_QUIT). }
  2765. Application.HandleException(nil);
  2766. end;
  2767. Exit;
  2768. end;
  2769. finally
  2770. if Assigned(RegisterFilesList) then begin
  2771. for var I := RegisterFilesList.Count-1 downto 0 do
  2772. Dispose(PRegisterFilesListRec(RegisterFilesList[I]));
  2773. RegisterFilesList.Free;
  2774. end;
  2775. UninstLog.Free;
  2776. FinishProgressGauge(False);
  2777. end;
  2778. Log('Installation process succeeded.');
  2779. Succeeded := True;
  2780. end;
  2781. end.