home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / Darice.110 / Binary.ice61.vbs < prev    next >
Text File  |  2000-10-05  |  11KB  |  229 lines
  1.  
  2. Function ICE61()
  3. Const UPGRADE_ATTRIBUTE_DETECTONLY = 2
  4. Const colUpgradeCode = 1
  5. Const colVersionMin = 2
  6. Const colVersionMax = 3
  7. Const colLanguage = 4
  8. Const colAttributes = 5
  9. Const colRemove = 6
  10. Const colActionProperty = 7
  11. On Error Resume Next
  12.  
  13. ICE61 = 1
  14. 'Give creation data
  15. Set recinfo = installer.createrecord(1)
  16. recinfo.StringData(0) = "ICE61" & Chr(9) & "3" & Chr(9) & "Created 05/03/1999. Last Modified 05/11/1999"
  17. 'Debug.Print recinfo.formattext
  18. Message &H3000000, recinfo
  19.  
  20. 'Give description of test
  21. recinfo.StringData(0) = "ICE61" & Chr(9) & "3" & Chr(9) & "Verifies various elements of the Upgrade table"
  22. 'Debug.Print recinfo.formattext
  23. Message &H3000000, recinfo
  24.  
  25. 'Is there a Upgrade table in the database?
  26. iStat = Database.TablePersistent("Upgrade")
  27. If 1 <> iStat Then
  28.     recinfo.StringData(0) = "ICE61" & Chr(9) & "3" & Chr(9) & "Table: 'Upgrade' missing. This product is not enabled for upgrading so ICE61 is not necessary."
  29.     'Debug.Print recinfo.formattext
  30.     Message &H3000000, recinfo
  31.     ICE61 = 1
  32.     Exit Function
  33. End If
  34.  
  35. 'Is there a Property table in the database?
  36. iStat = Database.TablePersistent("Property")
  37. If 1 <> iStat Then
  38.     recinfo.StringData(0) = "ICE61" & Chr(9) & "2" & Chr(9) & "Table: 'Property' missing. ICE61 cannot continue its validation."
  39.     'Debug.Print recinfo.formattext
  40.     Message &H3000000, recinfo
  41.     ICE61 = 1
  42.     Exit Function
  43. End If
  44.  
  45. 'process Upgrade table
  46. Set View = Database.OpenView("SELECT * FROM `Upgrade`")
  47. View.Execute
  48. Set recinfo = View.Fetch
  49. If recinfo Is Nothing Then
  50.     Set recinfo = installer.createrecord(1)
  51.     recinfo.StringData(0) = "ICE61" & Chr(9) & "3" & Chr(9) & "Table: 'Upgrade' is empty. This database will not upgrade any product."
  52.     'Debug.Print recinfo.formattext
  53.     Message &H3000000, recinfo
  54.     ICE61 = 1
  55.     Exit Function
  56. End If
  57.  
  58. 'verify that all ActionProperty properties are not pre-authored
  59. Set View = Database.OpenView("SELECT * FROM `Upgrade`, `Property` WHERE `ActionProperty`= `Property`")
  60. View.Execute
  61. Set recinfo = View.Fetch
  62. While Not recinfo Is Nothing
  63.     recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "Upgrade.ActionProperty [7] cannot be authored in the Property table." _
  64.                     & Chr(9) & Chr(9) & "Upgrade" & Chr(9) & "ActionProperty" & Chr(9) & recinfo.StringData(colUpgradeCode) _
  65.                     & Chr(9) & recinfo.StringData(colVersionMin) & Chr(9) & recinfo.StringData(colVersionMax) _
  66.                     & Chr(9) & recinfo.StringData(colLanguage) & Chr(9) & recinfo.StringData(colAttributes)
  67.     'Debug.Print recinfo.formattext
  68.     Message &H3000000, recinfo
  69.     ICE61 = 1
  70.     Set recinfo = View.Fetch
  71. Wend
  72.  
  73. 'verify that all ActionProperty properties are Public Properties
  74. Set View = Database.OpenView("SELECT * FROM `Upgrade`")
  75. View.Execute
  76. Set recinfo = View.Fetch
  77. While Not recinfo Is Nothing
  78.     If recinfo.StringData(colActionProperty) <> UCase(recinfo.StringData(colActionProperty)) Then
  79.         recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "Upgrade.ActionProperty [7] must not contain lowercase letters." _
  80.                     & Chr(9) & Chr(9) & "Upgrade" & Chr(9) & "ActionProperty" & Chr(9) & recinfo.StringData(colUpgradeCode) _
  81.                     & Chr(9) & recinfo.StringData(colVersionMin) & Chr(9) & recinfo.StringData(colVersionMax) _
  82.                     & Chr(9) & recinfo.StringData(colLanguage) & Chr(9) & recinfo.StringData(colAttributes)
  83.         'Debug.Print recinfo.formattext
  84.         Message &H3000000, recinfo
  85.         ICE61 = 1
  86.     End If
  87.     Set recinfo = View.Fetch
  88. Wend
  89.  
  90. 'verify that all ActionProperty properties are included in the SecureCustomProperties value
  91. Set View = Database.OpenView("SELECT  `Value` FROM `Property` WHERE `Property`= 'SecureCustomProperties'")
  92. View.Execute
  93. Set recinfo = View.Fetch
  94. If recinfo Is Nothing Then
  95.     sSecureCustomProperties = ""
  96. Else
  97.     sSecureCustomProperties = ";" & recinfo.StringData(1) & ";"
  98. End If
  99. Set View = Database.OpenView("SELECT * FROM `Upgrade`")
  100. View.Execute
  101. Set recinfo = View.Fetch
  102. While Not recinfo Is Nothing
  103. If InStr(sSecureCustomProperties, ";" & recinfo.StringData(colActionProperty) & ";") = 0 Then
  104.     recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "Upgrade.ActionProperty [7] must added to the SecureCustomProperties property." _
  105.                     & Chr(9) & Chr(9) & "Upgrade" & Chr(9) & "ActionProperty" & Chr(9) & recinfo.StringData(colUpgradeCode) _
  106.                     & Chr(9) & recinfo.StringData(colVersionMin) & Chr(9) & recinfo.StringData(colVersionMax) _
  107.                     & Chr(9) & recinfo.StringData(colLanguage) & Chr(9) & recinfo.StringData(colAttributes)
  108.     'Debug.Print recinfo.formattext
  109.     Message &H3000000, recinfo
  110.     ICE61 = 1
  111. End If
  112. Set recinfo = View.Fetch
  113. Wend
  114.  
  115. 'verify that all ActionProperty properties are only used once
  116. Set View = Database.OpenView("SELECT * FROM `Upgrade` ORDER BY `ActionProperty`")
  117. View.Execute
  118. sTestString = ""
  119. Set recinfo = View.Fetch
  120. While Not recinfo Is Nothing
  121.     If sTestString = recinfo.StringData(colActionProperty) Then
  122.         recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "Upgrade.ActionProperty [7] may be used in only one record of the Upgrade table." _
  123.                     & Chr(9) & Chr(9) & "Upgrade" & Chr(9) & "ActionProperty" & Chr(9) & recinfo.StringData(colUpgradeCode) _
  124.                     & Chr(9) & recinfo.StringData(colVersionMin) & Chr(9) & recinfo.StringData(colVersionMax) _
  125.                     & Chr(9) & recinfo.StringData(colLanguage) & Chr(9) & recinfo.StringData(colAttributes)
  126.         'Debug.Print recinfo.formattext
  127.         Message &H3000000, recinfo
  128.         ICE61 = 1
  129.     End If
  130.     sTestString = recinfo.StringData(colActionProperty)
  131.     Set recinfo = View.Fetch
  132. Wend
  133.  
  134. 'verify that all MinVersions are less than MaxVersions
  135. Set View = Database.OpenView("SELECT * FROM `Upgrade`")
  136. View.Execute
  137. Set recinfo = View.Fetch
  138. While Not recinfo Is Nothing
  139.     If Len(recinfo.StringData(colVersionMax)) And Len(recinfo.StringData(colVersionMin)) Then
  140.         If VersionStringToLong(recinfo.StringData(colVersionMax)) < VersionStringToLong(recinfo.StringData(colVersionMin)) Then
  141.             recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "Upgrade.VersionMax cannot be less than Upgrade.VersionMin. ([7])" _
  142.                     & Chr(9) & Chr(9) & "Upgrade" & Chr(9) & "VersionMin" & Chr(9) & recinfo.StringData(colUpgradeCode) _
  143.                     & Chr(9) & recinfo.StringData(colVersionMin) & Chr(9) & recinfo.StringData(colVersionMax) _
  144.                     & Chr(9) & recinfo.StringData(colLanguage) & Chr(9) & recinfo.StringData(colAttributes)
  145.             'Debug.Print recinfo.formattext
  146.             Message &H3000000, recinfo
  147.             ICE61 = 1
  148.         End If
  149.     End If
  150.     Set recinfo = View.Fetch
  151. Wend
  152.  
  153. 'verify that no attemp is made to uninstall a newer product
  154. sUC = "": sPV = "": lPV = 0
  155. Set View = Database.OpenView("SELECT  `Value` FROM `Property` WHERE `Property`= 'UpgradeCode'")
  156. View.Execute
  157. Set recinfo = View.Fetch
  158. If recinfo Is Nothing Then
  159.     recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "Property: An UpgradeCode must be authored in the Property table." _
  160.             & Chr(9) & Chr(9) & "Property" & Chr(9) & "Value" & Chr(9) & "UpgradeCode"
  161.     'Debug.Print recinfo.formattext
  162.     Message &H3000000, recinfo
  163.     ICE61 = 1
  164. Else
  165.     sUC = recinfo.StringData(1)
  166. End If
  167. Set View = Database.OpenView("SELECT  `Value` FROM `Property` WHERE `Property`= 'ProductVersion'")
  168. View.Execute
  169. Set recinfo = View.Fetch
  170. If recinfo Is Nothing Then
  171.     recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "Property: A ProductVersion must be authored in the Property table." _
  172.             & Chr(9) & Chr(9) & "Property" & Chr(9) & "Value" & Chr(9) & "ProductVersion"
  173.     'Debug.Print recinfo.formattext
  174.     Message &H3000000, recinfo
  175.     ICE61 = 1
  176. Else
  177.     sPV = recinfo.StringData(1): lPV = VersionStringToLong(sPV)
  178. End If
  179. Set View = Database.OpenView("SELECT * FROM `Upgrade` WHERE `UpgradeCode`= '" & sUC & "'")
  180. View.Execute
  181. Set recinfo = View.Fetch
  182. While Not recinfo Is Nothing
  183.     If Not ((recinfo.integerdata(colAttributes) And UPGRADE_ATTRIBUTE_DETECTONLY) = UPGRADE_ATTRIBUTE_DETECTONLY) Then
  184.         If Len(recinfo.StringData(colVersionMax)) Then
  185.             If VersionStringToLong(recinfo.StringData(colVersionMax)) >= lPV Then
  186.                 recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "This product should remove only older versions of itself. The Maximum version is not less than the current product. ([3] " & sPV & ")" _
  187.                         & Chr(9) & Chr(9) & "Upgrade" & Chr(9) & "Attributes" & Chr(9) & recinfo.StringData(colUpgradeCode) _
  188.                         & Chr(9) & recinfo.StringData(colVersionMin) & Chr(9) & recinfo.StringData(colVersionMax) _
  189.                         & Chr(9) & recinfo.StringData(colLanguage) & Chr(9) & recinfo.StringData(colAttributes)
  190.                 'Debug.Print recinfo.formattext
  191.                 Message &H3000000, recinfo
  192.                 ICE61 = 1
  193.             End If
  194.         Else
  195.             recinfo.StringData(0) = "ICE61" & Chr(9) & "1" & Chr(9) & "This product should remove only older versions of itself. No Maximum version was detected for the current product. ([7])" _
  196.                     & Chr(9) & Chr(9) & "Upgrade" & Chr(9) & "Attributes" & Chr(9) & recinfo.StringData(colUpgradeCode) _
  197.                     & Chr(9) & recinfo.StringData(colVersionMin) & Chr(9) & recinfo.StringData(colVersionMax) _
  198.                     & Chr(9) & recinfo.StringData(colLanguage) & Chr(9) & recinfo.StringData(colAttributes)
  199.             'Debug.Print recinfo.formattext
  200.             Message &H3000000, recinfo
  201.             ICE61 = 1
  202.         End If
  203.     End If
  204.     
  205.     Set recinfo = View.Fetch
  206. Wend
  207.  
  208. End Function
  209.  
  210. Function VersionStringToLong(strng)
  211. Dim i, iPos, sAccum, sTemp
  212. On Error Resume Next
  213.   sTemp = strng
  214.   iPos = InStr(sTemp & ".", ".")
  215.   sAccum = "&H" & Right("00" & Hex(CInt(Left(sTemp, iPos - 1))), 2)
  216.   If Err.Number > 0 Then VersionStringToLong = 0: Exit Function
  217.   sTemp = Mid(sTemp & ".", iPos + 1)
  218.   iPos = InStr(sTemp & ".", ".")
  219.   sAccum = sAccum & Right("00" & Hex(CInt(Left(sTemp, iPos - 1))), 2)
  220.   If Err.Number > 0 Then VersionStringToLong = 0: Exit Function
  221.   sTemp = Mid(sTemp & ".", iPos + 1)
  222.   iPos = InStr(sTemp & ".", ".")
  223.   sAccum = sAccum & Right("0000" & Hex(CInt(Left(sTemp, iPos - 1))), 4)
  224.   If Err.Number > 0 Then VersionStringToLong = 0: Exit Function
  225.   VersionStringToLong = CLng(sAccum)
  226.   Exit Function
  227. End Function
  228.  
  229.