Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

830 lines
31 KiB

  1. <job id='wi_link'>
  2. <!-- includes for constants definitions -->
  3. <script language='VBScript' src='.\vbsconst.inc'></script>
  4. <script language='VBScript' src='.\wiconst.inc'></script>
  5. <!-- includes for function declarations -->
  6. <script language='VBScript' src='.\widir.inc'></script>
  7. <script language='VBScript' src='.\wixerror.inc'></script>
  8. <!-- main -->
  9. <script Language='VBScript'>
  10. Option Explicit
  11. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  12. ' main
  13. Public installer 'As Installer
  14. Public database 'As Database
  15. Public fso 'As FileSystemObject
  16. Public dictVars 'As Dictionary
  17. Public dictFiles 'As Dictionary
  18. Public dictModules 'As Dictionary
  19. Public dictSequences 'As Dictionary
  20. Public dictMergedFiles 'As Dictionary
  21. Public sTempDir 'As String
  22. Public vInstallerVer
  23. Public fHelp, fNoOnError, fNoCab, fNoRedist, fNoTidy, fVerbose, fGenerateRandomDir
  24. Public sOriginalManifest
  25. Public fModule ' if linking a Merge Module
  26. Public fMediaFinal ' assumes Media information is final
  27. Public sDatabasePath, sOutputPath, sTempDb
  28. Public g_sBaseDir ' base directory used for update and CAB'ing
  29. Public aSumInfo(19), i
  30. Dim openMode
  31. Dim si
  32. ' connect to Windows Installer, create dictionaries for modules and files
  33. Set installer = Nothing
  34. Set installer = WScript.CreateObject("WindowsInstaller.Installer")
  35. Set fso = WScript.CreateObject("Scripting.FileSystemObject") : CheckError
  36. Set dictVars = WScript.CreateObject("Scripting.Dictionary") : CheckError
  37. Set dictFiles = WScript.CreateObject("Scripting.Dictionary")
  38. Set dictModules = WScript.CreateObject("Scripting.Dictionary")
  39. Set dictSequences = WScript.CreateObject("Scripting.Dictionary")
  40. Set dictMergedFiles = WScript.CreateObject("Scripting.Dictionary")
  41. Dim sInstallerVer : sInstallerVer = installer.Version
  42. Dim nDot : nDot = InStr(sInstallerVer, ".")
  43. vInstallerVer = CInt(Left(sInstallerVer, nDot - 1)) * 100
  44. vInstallerVer = vInstallerVer + CInt(Mid(sInstallerVer, nDot + 1, InStr(nDot + 1, sInstallerVer, ".") - nDot))
  45. sTempDir = installer.Environment("TMP")
  46. If Len(sTempDir) = 0 Then sTempDir = installer.Environment("TEMP")
  47. sTempDb = sTempDir & "\" & fso.GetTempName
  48. ParseCommandLine
  49. If Not fNoOnError Then On Error Resume Next
  50. If fHelp Or IsEmpty(sDatabasePath) Then
  51. ShowHelp
  52. WScript.Quit 1
  53. End If
  54. ' open the object file
  55. Set database = installer.OpenDatabase(sDatabasePath, sTempDb) : CheckError
  56. ' remember summary information for later
  57. Set si = database.SummaryInformation(0)
  58. For i = 0 To 19
  59. aSumInfo(i) = si.Property(i)
  60. Next
  61. Set si = Nothing
  62. If Not fMediaFinal Then
  63. ReadLinkerInfo
  64. ProcessFilesAndModules
  65. End If
  66. ' close the database and merge all the modules into the temp db
  67. database.Commit
  68. Set database = Nothing
  69. If Not fModule Then MergeModules sTempDb
  70. ' if an output path wasn't provided generate one
  71. If IsEmpty(sOutputPath) Then
  72. If ".wixobj" = Right(sDatabasePath, 7) Then
  73. ' put on the correct extension
  74. sOutputPath = Left(sDatabasePath, Len(sDatabasePath) - 7)
  75. If fModule Then sOutputPath = sOutputPath & ".msm" Else sOutputPath = sOutputPath & ".msi"
  76. Else
  77. sOutputPath = sDatabasePath
  78. End If
  79. End If
  80. ' reopen the temp db to the targetdb
  81. Set database = installer.OpenDatabase(sTempDb, sOutputPath) : CheckError
  82. If Not fNoCab Then
  83. If fModule Then
  84. CABFiles "MergeModule.CABinet", 0, 0, True
  85. Else
  86. ProcessMediaTable
  87. End If
  88. End If
  89. ' write the redist information
  90. If Not fNoRedist Then ProcessRedistInfo sOutputPath & ".redist"
  91. ' clean up the final MSI/MSM
  92. If Not fNoTidy Then
  93. If 1 = database.TablePersistent("candle_Info") Then database.OpenView("DROP TABLE `candle_Info`").Execute
  94. If 1 = database.TablePersistent("candle_DiskInfo") Then database.OpenView("DROP TABLE `candle_DiskInfo`").Execute
  95. If 1 = database.TablePersistent("candle_Files") Then database.OpenView("DROP TABLE `candle_Files`").Execute
  96. If 1 = database.TablePersistent("candle_Modules") Then database.OpenView("DROP TABLE `candle_Modules`").Execute
  97. If 1 = database.TablePersistent("redist_Info") Then database.OpenView("DROP TABLE `redist_Info`").Execute
  98. If 1 = database.TablePersistent("redist_Keywords") Then database.OpenView("DROP TABLE `redist_Keywords`").Execute
  99. If 1 = database.TablePersistent("redist_Contacts") Then database.OpenView("DROP TABLE `redist_Contacts`").Execute
  100. If 1 = database.TablePersistent("redist_Perminssions") Then database.OpenView("DROP TABLE `redist_Perminssions`").Execute
  101. If 1 = database.TablePersistent("redist_Os") Then database.OpenView("DROP TABLE `redist_Os`").Execute
  102. End If
  103. database.Commit
  104. Set database = Nothing
  105. ' write summary information back
  106. Set si = installer.SummaryInformation(sOutputPath, 20)
  107. For i = 1 To 19
  108. If Not IsEmpty(aSumInfo(i)) Then si.Property(i) = aSumInfo(i)
  109. Next
  110. si.Persist
  111. Set si = Nothing
  112. Set installer = Nothing
  113. fso.DeleteFile sTempDb ' clean
  114. WScript.Quit 0
  115. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  116. ' Error handling and command-line parsing routines
  117. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' robmen ''
  118. ' ParseCommandLine
  119. Function ParseCommandLine()
  120. Dim arg, argIndex
  121. Dim chFlag
  122. fGenerateRandomDir = False
  123. If 0 = WScript.Arguments.Count Then fHelp = True : Exit Function
  124. For argIndex = 0 To WScript.Arguments.Count - 1
  125. arg = WScript.Arguments(argIndex)
  126. chFlag = AscW(arg)
  127. ' if this a variable
  128. If InStr(arg, "=") Then
  129. Dim expr : expr = Split(arg, "=")
  130. If IsNumeric(expr(1)) Then expr(1) = CLng(expr(1))
  131. dictVars.Item(expr(0)) = expr(1)
  132. ' command line parameter
  133. ElseIf (chFlag = AscW("/")) Or (chFlag = AscW("-")) Then
  134. chFlag = LCase(Mid(arg, 2))
  135. Select Case chFlag
  136. Case "b" ' base directory
  137. argIndex = argIndex + 1
  138. g_sBaseDir = WScript.Arguments(argIndex)
  139. Case "o" ' database to create
  140. argIndex = argIndex + 1
  141. sOutputPath = WScript.Arguments(argIndex)
  142. If fso.FileExists(sOutputPath) Then WScript.Echo "Warning, overwriting database: " & sOutputPath
  143. Case "m" : fMediaFinal = True
  144. Case "sc" : fNoCab = True
  145. Case "sr" : fNoRedist = True
  146. Case "st" : fNoTidy = True
  147. Case "v" : fVerbose = True
  148. Case "e" : fNoOnError = True
  149. Case "?" : fHelp = True
  150. Case "r" : fGenerateRandomDir = True
  151. Case Else : Fail "Invalid option flag: " & arg
  152. End Select
  153. ' must be the database to link
  154. Else
  155. If Not IsEmpty(sDatabasePath) Then Fail "Cannot specify two databases to link"
  156. sDatabasePath = arg
  157. End If
  158. Next
  159. End Function ' ParseCommandLine
  160. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' robmen ''
  161. ' ShowHelp
  162. Sub ShowHelp()
  163. Dim sHelp
  164. sHelp = "light - 'links' Files and Merge Modules in a Windows Installer Database created" & vbCrLf & _
  165. " by candle.wsf" & vbCrLf & _
  166. vbCrLf & _
  167. "light.wsf [-?] [-sc] [-sr] [-st] [-b basedir] [-m] [-o destfile] [-v] [-e] linkme.wixobj" & vbCrLf & _
  168. vbCrLf & _
  169. " -b base directory to locate Files" & vbCrLf & _
  170. " -e errors crash linker, useful for debugging compiler" & vbCrLf & _
  171. " -i include paths to search (not yet implemented!)" & vbCrLf & _
  172. " -l log all operations, useful for debugging" & vbCrLf & _
  173. " -m assumes Media information is final" & vbCrLf & _
  174. " -o output to new database instead of updating this one [will overwrite]" & vbCrLf & _
  175. " -sb suppress processing of Binary-encoded data" & vbCrLf & _
  176. " -sc suppress CAB'ing process" & vbCrLf & _
  177. " -sr suppress .redist generation" & vbCrLf & _
  178. " -st suppress tidy'ing [leave linker tables]" & vbCrLf & _
  179. " -v verbose output, useful for debugging" & vbCrLf & _
  180. " -? this help information" & vbCrLf & _
  181. vbCrLf & _
  182. "For more information see: http://compcat/wix"
  183. WScript.Echo sHelp
  184. End Sub ' ShowHelp
  185. Sub CheckError
  186. Dim message, errRec
  187. If Err = 0 Then Exit Sub
  188. message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  189. If Not installer Is Nothing Then
  190. Set errRec = installer.LastErrorRecord
  191. If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  192. End If
  193. Fail message
  194. End Sub
  195. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  196. ' BaseDir
  197. Function BaseDir(sPath)
  198. If IsEmpty(g_sBaseDir) Then g_sBaseDir = "."
  199. If "sourcedir\" = LCase(Left(sPath, 10)) Then
  200. BaseDir = g_sBaseDir & Mid(sPath, 10)
  201. Else
  202. BaseDir = sPath
  203. End If
  204. End Function ' BaseDir
  205. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  206. ' StripSourceDir
  207. Function StripSourceDir(sPath)
  208. If "sourcedir\" = LCase(Left(sPath, 10)) Then
  209. StripSourceDir = Mid(sPath, 10)
  210. Else
  211. StripSourceDir = sPath
  212. End If
  213. End Function ' StripSourceDir
  214. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  215. ' Linker information routines
  216. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  217. ' ReadLinkerInfo
  218. Sub ReadLinkerInfo
  219. Dim vw, rec
  220. If 2 = database.TablePersistent("candle_Info") Then Exit Sub
  221. Set vw = database.OpenView("SELECT `LinkProperty`, `Value` FROM `candle_Info`")
  222. vw.Execute
  223. Do
  224. Set rec = vw.Fetch
  225. If Not rec Is Nothing Then
  226. Select Case rec.StringData(1)
  227. Case "SourceFile" : sOriginalManifest = rec.StringData(2)
  228. Case "IsModule" : fModule = CBool(rec.IntegerData(2))
  229. Case Else : dictVars.Add rec.StringData(1), rec.StringData(2)
  230. End Select
  231. End If
  232. Loop Until rec Is Nothing
  233. ReadFileInfo
  234. ReadModuleInfo
  235. End Sub
  236. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  237. ' ReadFileInfo
  238. Sub ReadFileInfo
  239. Dim vw, rec
  240. If 2 = database.TablePersistent("candle_Files") Then Exit Sub
  241. Set vw = database.OpenView("SELECT `File_`, `Path` FROM `candle_Files`")
  242. vw.Execute
  243. Do
  244. Set rec = vw.Fetch
  245. If Not rec Is Nothing Then
  246. dictFiles.Add rec.StringData(1), rec.StringData(2)
  247. End If
  248. Loop Until rec Is Nothing
  249. End Sub ' ReadFileInfo
  250. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  251. ' ReadModuleInfo
  252. Sub ReadModuleInfo
  253. Dim vw, rec
  254. Dim aData(6)
  255. If 2 = database.TablePersistent("candle_Modules") Then Exit Sub
  256. Set vw = database.OpenView("SELECT `Module`, `Path`, `Language`, `PrimaryFeature_`, `ConnectFeatures_`, `RedirectDirectory_` FROM `candle_Modules`")
  257. vw.Execute
  258. Do
  259. Set rec = vw.Fetch
  260. If Not rec Is Nothing Then
  261. aData(0) = rec.StringData(2)
  262. aData(1) = rec.IntegerData(3)
  263. aData(2) = rec.StringData(4)
  264. aData(3) = rec.StringData(5)
  265. aData(4) = rec.StringData(6)
  266. dictModules.Add rec.StringData(1), aData
  267. End If
  268. Loop Until rec Is Nothing
  269. End Sub ' ReadModuleInfo
  270. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  271. ' Linker work routines
  272. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  273. ' ProcessFilesAndModules
  274. Sub ProcessFilesAndModules
  275. Dim vwFiles, vwModules
  276. Dim recFile, recModule
  277. Dim vwDisk, recDisk
  278. Dim vwFileUpdate, vwMediaUpdate, vwFileHash
  279. Dim recFileUpdate, recMediaUpdate, recFileHash
  280. Dim nDiskId, fIsModule, nLastSequence
  281. Dim sPath
  282. ' Dim merge, getFiles
  283. ' Set merge = WScript.CreateObject("Msm.Merge")
  284. ' Set getFiles = WScript.CreateObject("{7041AE26-2D78-11D2-888A-00A0C981B015}")
  285. Dim module, vw, rec
  286. nDiskId = 0
  287. nLastSequence = 0
  288. ' bail if disk information wasn't provided
  289. If 1 <> database.TablePersistent("candle_DiskInfo") Then Exit Sub
  290. Set vwDisk = database.OpenView("SELECT `Identifier`, `DiskId`, `IsModule` FROM `candle_DiskInfo` ORDER BY `DiskId`, `IsModule`")
  291. vwDisk.Execute
  292. If 1 = database.TablePersistent("File") Then
  293. Set vwFileUpdate = database.OpenView("SELECT `FileSize`, `Language`, `Version` FROM `File` WHERE `File`=?")
  294. Set recFileUpdate = installer.CreateRecord(4)
  295. End If
  296. If 1 = database.TablePersistent("Media") Then
  297. If fModule Then Fail "Modules cannot have a Media table"
  298. Set vwMediaUpdate = database.OpenView("SELECT `LastSequence` FROM `Media` WHERE `DiskId`=?")
  299. Set recMediaUpdate = installer.CreateRecord(1)
  300. End If
  301. If 1 = database.TablePersistent("MsiFileHash") Then
  302. Set vwFileHash = database.OpenView("SELECT `File_`, `Options`, `HashPart1`, `HashPart2`, `HashPart3`, `HashPart4` FROM `MsiFileHash`")
  303. Set recFileHash = installer.CreateRecord(6)
  304. End If
  305. Set recFile = Nothing
  306. Set recModule = Nothing
  307. Do
  308. Set recDisk = vwDisk.Fetch
  309. If Not recDisk Is Nothing Then
  310. fIsModule = recDisk.IntegerData(3)
  311. ' if the disk id has changed, update the Media table
  312. If 0 < nDiskId And nDiskId <> recDisk.IntegerData(2) Then
  313. recMediaUpdate.IntegerData(1) = nDiskId
  314. vwMediaUpdate.Execute recMediaUpdate
  315. Set recMediaUpdate = vwMediaUpdate.Fetch
  316. recMediaUpdate.IntegerData(1) = nLastSequence
  317. vwMediaUpdate.Modify msiViewModifyUpdate, recMediaUpdate
  318. nDiskId = recDisk.IntegerData(2) ' on to the next Media disk
  319. Else
  320. nDiskId = recDisk.IntegerData(2)
  321. End If
  322. If fModule and fIsModule Then Fail "Cannot merge a Merge Module into another Merge Module"
  323. If fIsModule Then ' merge the module
  324. Dim aData
  325. aData = dictModules.Item(recDisk.StringData(1))
  326. sPath = BaseDir(aData(0))
  327. If fso.FileExists(sPath) Then
  328. Set module = installer.OpenDatabase(sPath, msiOpenDatabaseModeReadOnly)
  329. If 1 = module.TablePersistent("File") Then
  330. Set vw = module.OpenView("SELECT `File` FROM `File`")
  331. vw.Execute
  332. Do
  333. Set rec = vw.Fetch
  334. If Not rec Is Nothing Then
  335. nLastSequence = nLastSequence + 1
  336. If dictSequences.Exists(rec.StringData(1)) Then Fail "File identifier duplicated: " & rec.StringData(1)
  337. dictSequences.Add rec.StringData(1), nLastSequence
  338. dictMergedFiles.Add rec.StringData(1), recDisk.StringData(1)
  339. End If
  340. Loop Until rec Is Nothing
  341. End If
  342. Else
  343. WScript.Echo "Link could not locate module: " & sPath
  344. End If
  345. Else ' update the file
  346. sPath = dictFiles.Item(recDisk.StringData(1))
  347. sPath = BaseDir(sPath)
  348. If fso.FileExists(sPath) Then
  349. vwFileUpdate.Execute recDisk
  350. Set recFileUpdate = vwFileUpdate.Fetch
  351. recFileUpdate.IntegerData(1) = installer.FileSize(sPath)
  352. recFileUpdate.StringData(2) = installer.FileVersion(sPath, True) ' version
  353. recFileUpdate.StringData(3) = installer.FileVersion(sPath, False) ' language
  354. vwFileUpdate.Modify msiViewModifyUpdate, recFileUpdate
  355. ' if the file has no version information add it to the hash table if Windows Installer 1.5 or better is on the machine
  356. If Not IsEmpty(vwFileHash) And "" = recFileUpdate.StringData(2) And vInstallerVer > 120 Then
  357. Dim recHash : Set recHash = installer.FileHash(sPath, 0)
  358. recFileHash.StringData(1) = recDisk.StringData(1) ' file id
  359. recFileHash.IntegerData(2) = 0 ' options are always 0
  360. recFileHash.IntegerData(3) = recHash.IntegerData(1)
  361. recFileHash.IntegerData(4) = recHash.IntegerData(2)
  362. recFileHash.IntegerData(5) = recHash.IntegerData(3)
  363. recFileHash.IntegerData(6) = recHash.IntegerData(4)
  364. vwFileHash.Modify msiViewModifyInsert, recFileHash
  365. End If
  366. nLastSequence = nLastSequence + 1
  367. dictSequences.Add recDisk.StringData(1), nLastSequence
  368. Else
  369. WScript.Echo "Link could not locate file: " & sPath
  370. End If
  371. End If
  372. End If
  373. Loop Until recDisk Is Nothing
  374. ' update the last Media entry
  375. If Not fModule Then
  376. recMediaUpdate.IntegerData(1) = nDiskId
  377. vwMediaUpdate.Execute recMediaUpdate
  378. Set recMediaUpdate = vwMediaUpdate.Fetch
  379. recMediaUpdate.IntegerData(1) = nLastSequence
  380. vwMediaUpdate.Modify msiViewModifyUpdate, recMediaUpdate
  381. End If
  382. End Sub ' ProcessFilesAndModules
  383. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  384. ' MergeModules
  385. Sub MergeModules(sDb)
  386. Dim merge
  387. Dim sModule, aData, sPath, sExtractPath
  388. Dim aFeatures, i
  389. Dim bFolderExists
  390. If 0 = dictModules.Count Then Exit Sub
  391. Set merge = WScript.CreateObject("Msm.Merge")
  392. merge.OpenLog "temp.log"
  393. merge.OpenDatabase sDb
  394. For Each sModule In dictModules
  395. aData = dictModules.Item(sModule) : CheckError
  396. sPath = BaseDir(aData(0))
  397. merge.OpenModule sPath, aData(1) : CheckError
  398. merge.Merge aData(2), aData(4) : CheckError
  399. aFeatures = Split(aData(3), ":")
  400. For i = 0 To UBound(aFeatures)
  401. merge.Connect aFeatures(i)
  402. Next
  403. If IsEmpty(g_sBaseDir) Then g_sBaseDir = "."
  404. sExtractPath = g_sBaseDir
  405. bFolderExists = True
  406. ' if user specified to extract each different merge modules into a separate random directory, do so here and append it to sExtractPath
  407. If fGenerateRandomDir = True Then
  408. Do While (bFolderExists = True)
  409. sExtractPath = g_sBaseDir & "\" & fso.GetTempName
  410. bFolderExists = fso.FolderExists(sExtractPath) : CheckError
  411. Loop
  412. fso.CreateFolder sExtractPath : CheckError
  413. aData(5) = sExtractpath ' store the new base path for this merge module in here for later use
  414. dictModules.Item(sModule) = aData : CheckError
  415. Else
  416. sExtractPath = g_sBaseDir
  417. End If
  418. merge.ExtractFiles sExtractPath
  419. merge.CloseModule
  420. Next
  421. merge.CloseDatabase True
  422. merge.CloseLog
  423. End Sub
  424. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  425. ' ProcessFileSequences ??? (robmen) - why does this function exist if it isn't used?
  426. Sub ProcessFileSequences
  427. Dim vw, rec
  428. Dim sFile, nSequence
  429. If 1 <> database.TablePersistent("File") Then Exit Sub
  430. Set vw = database.OpenView("SELECT `File`, `Sequence` FROM `File`")
  431. vw.Execute
  432. Do
  433. Set rec = vw.Fetch
  434. If Not rec Is Nothing Then
  435. sFile = rec.StringData(1)
  436. If dictSequences.Exists(sFile) Then
  437. nSequence = dictSequences.Item(sFile)
  438. rec.IntegerData(2) = CInt(nSequence) ' update the sequence
  439. vw.Modify msiViewModifyUpdate, rec
  440. Else
  441. WScript.Echo "Warning, unexpected file '" & sFile & "' has sequence: " & nSequence
  442. End If
  443. End If
  444. Loop Until rec Is Nothing
  445. End Sub ' ProcessFileSequences
  446. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  447. ' ProcessMediaTable
  448. Sub ProcessMediaTable
  449. Dim vw, rec
  450. Dim sCabinet, fEmbed
  451. Dim nBeginSequence, nEndSequence
  452. Dim nLastBackslash, sCabDir
  453. ' Check to see where CABs need to go
  454. nLastBackslash = InStrRev(sOutputPath, "\")
  455. If (nLastBackslash > 0) Then
  456. sCabDir = Left(sOutputPath, nLastBackslash)
  457. Else
  458. sCabDir = ".\"
  459. End If
  460. nBeginSequence = 0
  461. Set vw = database.OpenView("SELECT `LastSequence`, `Cabinet` FROM `Media` ORDER BY `LastSequence`")
  462. vw.Execute
  463. Do
  464. Set rec = vw.Fetch
  465. If Not rec Is Nothing Then
  466. nEndSequence = rec.IntegerData(1)
  467. sCabinet = rec.StringData(2)
  468. If 0 < Len(sCabinet) Then
  469. If "#" = Left(sCabinet, 1) Then
  470. sCabinet = Mid(sCabinet, 2)
  471. fEmbed = True
  472. Else
  473. sCabinet = sCabDir & sCabinet
  474. fEmbed = False
  475. End If
  476. CABFiles sCabinet, nBeginSequence, nEndSequence, fEmbed
  477. End If
  478. nBeginSequence = nEndSequence + 1
  479. End If
  480. Loop Until rec Is Nothing
  481. End Sub ' ProcessMediaTable
  482. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  483. ' CABFiles
  484. Sub CABFiles(sCabName, nMinSequence, nMaxSequence, fAsStream)
  485. Const sDDF = "$_candle.ddf"
  486. Const sCAB = "$_candle.cab"
  487. Const sINF = "$_candle.inf"
  488. Const sRPT = "$_candle.rpt"
  489. ' bail if there are no files
  490. If 1 <> database.TablePersistent("File") Then Exit Sub
  491. Dim sKey, sPath
  492. Dim sSql, vw, rec
  493. Dim tsDDF : Set tsDDF = fso.CreateTextFile(sDDF, OverwriteIfExist, OpenAsASCII) : CheckError
  494. Dim shell, cabStat
  495. Dim sModID, aData
  496. tsDDF.WriteLine "; Generated from " & sDatabasePath & " on " & Now
  497. tsDDF.WriteLine ".Set CabinetNameTemplate=candle*.CAB"
  498. tsDDF.WriteLine ".Set CabinetName1=" & sCAB
  499. tsDDF.WriteLine ".Set ReservePerCabinetSize=8"
  500. tsDDF.WriteLine ".Set MaxDiskSize=CDROM"
  501. tsDDF.WriteLine ".Set CompressionType=MSZIP"
  502. tsDDF.WriteLine ".Set InfFileLineFormat=(*disk#*) *file#*: *file* = *Size*"
  503. tsDDF.WriteLine ".Set InfFileName=" & sINF
  504. tsDDF.WriteLine ".Set RptFileName=" & sRPT
  505. tsDDF.WriteLine ".Set InfHeader="
  506. tsDDF.WriteLine ".Set InfFooter="
  507. tsDDF.WriteLine ".Set DiskDirectoryTemplate=."
  508. tsDDF.WriteLine ".Set Compress=ON"
  509. tsDDF.WriteLine ".Set Cabinet=ON"
  510. sSql = "SELECT `File` FROM `File`"
  511. If nMaxSequence > 0 Then
  512. sSql = sSql & " WHERE `Sequence`>=" & nMinSequence & " AND`Sequence`<=" & nMaxSequence
  513. End If
  514. sSql = sSql & " ORDER BY `Sequence`" ' ORDER BY must be at the end of the query
  515. If fVerbose Then WScript.Echo "Update Sql: " & sSql
  516. Set vw = database.OpenView(sSql)
  517. vw.Execute
  518. Do
  519. Set rec = vw.Fetch
  520. If rec Is Nothing Then Exit Do
  521. sKey = rec.StringData(1)
  522. If dictFiles.Exists(sKey) Then
  523. sPath = dictFiles.Item(sKey) : CheckError
  524. Else ' file came from a merge module so resolve it in the source
  525. If fGenerateRandomDir = True Then
  526. sModID = dictMergedFiles.item(sKey) : CheckError
  527. aData = dictModules.Item(sModID) : CheckError
  528. sPath = aData(5) & StripSourceDir(ResolveFileSourcePath(database, sKey, False))
  529. Else
  530. sPath = ResolveFileSourcePath(database, sKey, False)
  531. End If
  532. End If
  533. sPath = BaseDir(sPath)
  534. If fVerbose Then WScript.Echo "CAB'ing " & sPath & " for File key: " & sKey
  535. If fso.FileExists(sPath) Then
  536. tsDDF.WriteLine chr(34) & sPath & chr(34) & " " & sKey
  537. Else
  538. Fail "CAB'ing could not locate file: " & sPath
  539. End If
  540. Loop
  541. Set vw = Nothing
  542. tsDDF.Close
  543. Set shell = WScript.CreateObject("Wscript.Shell")
  544. cabStat = shell.Run("MakeCab.exe /f " & sDDF, 1, True)
  545. If cabStat <> 0 Then Fail "MAKECAB.EXE failed, possibly could not find source files, or invalid DDF format, see: " & sDDF
  546. ' add the stream to the database
  547. If fAsStream Then
  548. Set vw = database.OpenView("SELECT `Name`,`Data` FROM _Streams")
  549. vw.Execute
  550. Set rec = Installer.CreateRecord(2)
  551. rec.StringData(1) = sCabName
  552. rec.SetStream 2, sCAB : CheckError
  553. vw.Modify msiViewModifyAssign, rec 'replace any existing stream of that name
  554. Set vw = Nothing
  555. Set rec = Nothing
  556. Else
  557. If fso.FileExists(sCabName) Then fso.DeleteFile sCabName
  558. If fVerbose Then WScript.Echo "Renaming temp cab: " & sCAB & " to real cab: " & sCabName
  559. fso.MoveFile sCAB, sCabName ' rename the cab to whatever the user wanted
  560. End If
  561. ' clean up
  562. fso.DeleteFile sDDF
  563. If fAsStream Then fso.DeleteFile sCAB ' only delete if added to MSI
  564. fso.DeleteFile sINF
  565. fso.DeleteFile sRPT
  566. End Sub ' CABFiles
  567. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  568. ' ProcessRedistInfo
  569. Sub ProcessRedistInfo(sOutputPath)
  570. Dim vw, rec, n, sFormat, sLanguage, sDescription, sDistribution, sType
  571. If 2 = database.TablePersistent("redist_Info") Then Exit Sub
  572. If fModule Then sFormat = "msm" Else sFormat = "msi"
  573. sLanguage = aSumInfo(7)
  574. n = InStr(sLanguage, ";")
  575. If -1 <> n Then sLanguage = Mid(sLanguage, n + 1)
  576. If 0 = Len(LTrim(sLanguage)) Then sLanguage = 0
  577. Set vw = database.OpenView("SELECT `Description`, `Distribution`, `Type` FROM `redist_Info`")
  578. vw.Execute
  579. Set rec = vw.Fetch
  580. If Not rec Is Nothing Then
  581. sDescription = EscapeXml(rec.StringData(1), False)
  582. If 0 = rec.IntegerData(2) Then sDistribution = "internal" else sDistribution = "external"
  583. If 0 = rec.IntegerData(3) Then sType = "debug" else sType = "retail"
  584. Else
  585. Fail "redist_Info is malformed"
  586. End If
  587. Dim tsRedist
  588. Set tsRedist = fso.CreateTextFile(sOutputPath, OverwriteIfExist, OpenAsASCII)
  589. CheckError
  590. tsRedist.WriteLine "<RedistPack Format='" & sFormat & "' Type='" & sType & "' Language='" & sLanguage & "' Distribution='" & sDistribution & "'>"
  591. If 0 < Len(sDescription) Then tsRedist.WriteLine " <Description>" & sDescription & "</Description>"
  592. ProcessRedistKeywords(tsRedist)
  593. ProcessRedistContacts(tsRedist)
  594. ProcessRedistPermissions(tsRedist)
  595. ProcessRedistOs(tsRedist)
  596. tsRedist.WriteLine "</RedistPack>"
  597. End Sub
  598. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  599. ' ProcessRedistKeywords
  600. Sub ProcessRedistKeywords(tsRedist)
  601. Dim vw, rec, n, sKeyword, aKeywords
  602. aKeywords = Split(aSumInfo(5), ",")
  603. For n = 0 To UBound(aKeywords)
  604. sKeyword = EscapeXml(Trim(aKeywords(n)), False)
  605. tsRedist.WriteLine " <Keyword>" & sKeyword & "</Keyword>"
  606. Next
  607. ' If 2 = database.TablePersistent("redist_Keywords") Then Exit Sub
  608. ' Set vw = database.OpenView("SELECT `Keyword`FROM `redist_Keywords`")
  609. ' vw.Execute
  610. ' Do
  611. ' Set rec = vw.Fetch
  612. '
  613. ' If Not rec Is Nothing Then
  614. ' sKeyword = EscapeXml(rec.StringData(1), False)
  615. ' tsRedist.WriteLine " <Keyword>" & sKeyword & "</Keyword>"
  616. ' End If
  617. ' Loop Until rec Is Nothing
  618. End Sub
  619. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  620. ' ProcessRedistContacts
  621. Sub ProcessRedistContacts(tsRedist)
  622. Dim vw, rec, sContact
  623. If 2 = database.TablePersistent("redist_Contacts") Then Exit Sub
  624. Set vw = database.OpenView("SELECT `Contact`FROM `redist_Contacts`")
  625. vw.Execute
  626. Do
  627. Set rec = vw.Fetch
  628. If Not rec Is Nothing Then
  629. sContact = EscapeXml(rec.StringData(1), False)
  630. tsRedist.WriteLine " <Contact>" & sContact & "</Contact>"
  631. End If
  632. Loop Until rec Is Nothing
  633. End Sub
  634. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  635. ' ProcessRedistPermissions
  636. Sub ProcessRedistPermissions(tsRedist)
  637. Dim vw, rec, sDomain, sAlias
  638. If 2 = database.TablePersistent("redist_Permissions") Then Exit Sub
  639. Set vw = database.OpenView("SELECT `Domain`, `Alias` FROM `redist_Permissions`")
  640. vw.Execute
  641. Do
  642. Set rec = vw.Fetch
  643. If Not rec Is Nothing Then
  644. sDomain = EscapeXml(rec.StringData(1), True)
  645. sAlias = EscapeXml(rec.StringData(2), True)
  646. tsRedist.WriteLine " <Permission Domain='" & sDomain & "' Alias='" & sAlias &"'/>"
  647. End If
  648. Loop Until rec Is Nothing
  649. End Sub
  650. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  651. ' ProcessRedistOs
  652. Sub ProcessRedistOs(tsRedist)
  653. Dim vw, rec, n, sProc, sType, sFlavor, sLanguage, sMin, sMax
  654. If 2 = database.TablePersistent("redist_Os") Then Exit Sub
  655. sProc = aSumInfo(7)
  656. n = InStr(sProc, ";")
  657. If -1 <> n Then sProc = Left(sProc, n - 1) Else sProc = Empty
  658. If "Intel" = sProc Then sProc = "x86"
  659. If "Intel64" = sProc Then sProc = "ia64"
  660. If "Alpha" = sProc Then sProc = "axp64"
  661. Set vw = database.OpenView("SELECT `Type`, `Flavor`, `Language`, `MinVersion`, `MaxVersion` FROM `redist_Os`")
  662. vw.Execute
  663. Do
  664. Set rec = vw.Fetch
  665. If Not rec Is Nothing Then
  666. sType = rec.StringData(1)
  667. sFlavor = rec.StringData(2)
  668. sLanguage = rec.StringData(3)
  669. sMin = rec.StringData(4)
  670. sMax = rec.StringData(5)
  671. tsRedist.Write " <" & sType
  672. If 0 < Len(sProc) Then tsRedist.Write " Processor='" & sProc & "'"
  673. If 0 < Len(sFlavor) Then tsRedist.Write " Flavor='" & sFlavor & "'"
  674. If 0 < Len(sLanguage) Then tsRedist.Write " Language='" & sLanguage & "'"
  675. If 0 < Len(sMin) Then tsRedist.Write " MinVersion='" & sMin & "'"
  676. If 0 < Len(sMax) Then tsRedist.Write " MaxVersion='" & sMax & "'"
  677. tsRedist.WriteLine "/>"
  678. End If
  679. Loop Until rec Is Nothing
  680. End Sub
  681. Function EscapeXml(s, fStrict)
  682. s = Replace(s, "&", "&amp;")
  683. s = Replace(s, "<", "&gt;")
  684. s = Replace(s, ">", "&lt;")
  685. If fStrict Then
  686. s = Replace(s, "'", "&apos;")
  687. s = Replace(s, """", "&quot;")
  688. End If
  689. EscapeXml = s
  690. End Function
  691. </script>
  692. </job>