home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / CHIPCD_9_99.iso / software / uaktualnienia / OptionPackPL / iis4_07.cab / Packages.bas < prev    next >
BASIC Source File  |  1998-04-27  |  5KB  |  181 lines
  1. Attribute VB_Name = "Packages"
  2. Option Explicit
  3.  
  4. Declare Sub Sleep Lib "kernel32" (ByVal dwDelay As Long)
  5.  
  6. Sub InstallAllPackages(strDir As String)
  7.     ' Try and stop any MTS packages
  8.     On Error Resume Next
  9.     Dim varRetVal
  10.     varRetVal = Shell("mtxstop", vbMinimizedNoFocus)
  11.     PauseALittle
  12.     
  13.     ' Now install each package
  14.     Install strDir, "ExAir", "ExAir.pak"
  15.     Install strDir, "Benefit", "Benefit.pak"
  16.     Install strDir, "Flight", "Flight.pak"
  17.     Install strDir, "TakeANumber", "TakeANumber.pak"
  18. End Sub
  19.  
  20. Sub Install(strDir As String, strPackageName As String, strPackageFile As String)
  21.     
  22.     On Error GoTo ErrorHandler
  23.     
  24.     Dim strPackagePath As String
  25.     strPackagePath = strDir
  26.     
  27.     ' Append a '\' to the path if it's missing
  28.     If Right$(strPackagePath, 1) <> "\" Then strPackagePath = strPackagePath & "\"
  29.     
  30.     strPackageFile = strPackagePath & strPackageFile
  31.     
  32.     Dim objCatalog As New MTSAdmin.Catalog
  33.     Dim objPackageColl As Object
  34.     
  35.     ' Get the package collection
  36.     Set objPackageColl = objCatalog.GetCollection("Packages")
  37.     objPackageColl.Populate
  38.     
  39.     ' Delete the Package if already installed
  40.     Dim n As Integer
  41.     Dim i As Integer
  42.     n = objPackageColl.Count
  43.     For i = n - 1 To 0 Step -1
  44.         If UCase(objPackageColl.Item(i).Value("Name")) = UCase(strPackageName) Then
  45.             objPackageColl.Remove (i)
  46.         End If
  47.     Next
  48.     ' Save the changes if any
  49.     objPackageColl.SaveChanges
  50.     
  51.     ' Add the Package
  52.     Dim objPackage As MTSAdmin.PackageUtil
  53.     Set objPackage = objPackageColl.GetUtilInterface
  54.     objPackage.InstallPackage strPackageFile, "", 0
  55.     objPackageColl.SaveChanges
  56.     
  57.     Exit Sub
  58.     
  59. ErrorHandler:
  60.     MsgBox "An error occured while installing package '" & strPackageName _
  61.         & "'. The error is: " & mapError(Err.Number), vbOKOnly + vbExclamation, "ExAir Error"
  62.  
  63. End Sub
  64.  
  65. Sub UninstallAllPackages()
  66.     ' Try and stop any MTS packages
  67.     On Error Resume Next
  68.     Dim varRetVal
  69.     varRetVal = Shell("mtxstop", vbMinimizedNoFocus)
  70.     PauseALittle
  71.     
  72.     Uninstall "ExAir"
  73.     Uninstall "Benefit"
  74.     Uninstall "Flight"
  75.     Uninstall "TakeANumber"
  76. End Sub
  77.  
  78. Sub Uninstall(strPackageName As String)
  79.    
  80.     On Error Resume Next
  81.     
  82.     Dim objCatalog As New MTSAdmin.Catalog
  83.     Dim objPackageColl As Object
  84.     
  85.     ' Get the package collection
  86.     Set objPackageColl = objCatalog.GetCollection("Packages")
  87.     objPackageColl.Populate
  88.     
  89.     ' Delete the package if already installed
  90.     Dim n As Integer
  91.     Dim i As Integer
  92.     n = objPackageColl.Count
  93.     For i = n - 1 To 0 Step -1
  94.         If UCase(objPackageColl.Item(i).Value("Name")) = UCase(strPackageName) Then
  95.             objPackageColl.Remove (i)
  96.         End If
  97.     Next
  98.     ' Save the changes if any
  99.     objPackageColl.SaveChanges
  100.  
  101. End Sub
  102.  
  103. Public Function mapError(errorCode As Long) As String
  104.     Select Case errorCode
  105.     
  106.     Case mtsErrPDFReadFail
  107.         mapError = "Unable to locate Package File"
  108.         
  109.     Case mtsErrObjectErrors
  110.         mapError = "mtsErrObjectErrors - see ErrorInfo collection"
  111.         
  112.     Case mtsErrObjectErrors
  113.         mapError = "mtsErrObjectErrors"
  114.  
  115.     Case mtsErrObjectInvalid
  116.         mapError = "mtsErrObjectInvalid"
  117.  
  118.     Case mtsErrKeyMissing
  119.         mapError = "mtsErrKeyMissing"
  120.  
  121.     Case mtsErrAlreadyInstalled
  122.         mapError = "Package is already installed"
  123.  
  124.     Case mtsErrCoReqCompInstalled
  125.         mapError = "mtsErrCoReqCompInstalled"
  126.  
  127.     Case mtsErrBadPath
  128.         mapError = "mtsErrBadPath"
  129.  
  130.     Case mtsErrPackageExists
  131.         mapError = "Package already exists"
  132.  
  133.     Case mtsErrRemoteInterface
  134.         mapError = "mtsErrRemoteInterface"
  135.  
  136.     Case mtsErrCantCopyFile
  137.         mapError = "Cannot copy file"
  138.  
  139.     Case mtsErrNoTypeLib
  140.         mapError = "TypeLib does not exist"
  141.     
  142.     Case mtsErrNoUser
  143.         mapError = "No User defined"
  144.  
  145.     Case mtsErrInvalidUserids
  146.         mapError = "Invalid User IDs"
  147.  
  148.     Case mtsErrUserPasswdNotValid
  149.         mapError = "User Password is Invalid"
  150.     
  151.     Case mtsErrNoServerShare
  152.         mapError = "mtsErrNoServerShare"
  153.  
  154.     Case mtsErrPackDirNotFound
  155.         mapError = "Package Directory Not Found"
  156.         
  157.     Case mtsErrCompFileNotInstallable
  158.         mapError = "mtsCompFileNotInstallable"
  159.         
  160.     Case mtsErrNotDeletable
  161.         mapError = "mtsErrNotDeleteable"
  162.         
  163.     Case mtsErrNotChangeable
  164.         mapError = "mtsErrNotChangeable"
  165.         
  166.     Case mtsErrSession
  167.         mapError = "mtsErrSession"
  168.         
  169.     Case Else
  170.         mapError = "Unknown error: " & Hex(errorCode)
  171.     End Select
  172.   
  173. End Function
  174.  
  175. Private Sub PauseALittle()
  176.     Sleep 2000
  177. End Sub
  178.  
  179.  
  180.  
  181.