一个使用web安装盘的install(nextinstaller)vbs脚本

'//
'                                                                           
'  IIIIIII    A                                                           
'    II      A A                        InstallAide (R)                 
'    II     A   A      (c) 2000-2005, InstallAide Software
'    II     AAAAA      Amethyst  
'  IIIIIII AA   AA                       
'                                                                                                                                                  '
'//
Dim  BACKSTEP
Dim  NEXTSTEP
Dim  EXITSTEP
Dim  strStep
Dim  IAParam
Dim  strTemp
Dim  strSetupImage
Dim  strSupportDir
Dim  nState
Dim  strTargetDir
Public strWebSite
Public szGlobalPath
Public szExepath
Public szGlobal
Public g_szAMDBSvr,g_szAMSvr,g_szAMDB,g_szAMPort
Public g_szAPMDB,g_szAPMSvr
Public g_szDbUser
Public g_szDbUserPsw
Public g_szAPMSite
Public g_ErrorCode
Public g_ErrorInfo

BACKSTEP  = 1
NEXTSTEP  = 2
EXITSTEP  = 3

SM_MODIFY = 1
SM_RESTORE  = 2
SM_REMOVE = 3

Set IAParam  = Install.CreateIAParam()

WriteConfig()

If Install.IsInstalled() Then
 OnModify
Else
 OnInstall
End If 

Set IAParam = Nothing

'--------------------------------------------
' 修改安装
'--------------------------------------------
Sub OnModify()
 strStep   = "SetModifyType"
 Do While strStep <> "Exit"
  Select Case strStep
   Case "SetModifyType" 
    nState = Install.SdModifySetup( IAParam )
    If nState = NEXTSTEP Then
     If Install.SetupMode = SM_MODIFY Then
      strStep = "SdComponent"
     ElseIf Install.SetupMode = SM_RESTORE Then
      strStep = "SdCopyFile"
     ElseIf Install.SetupMode = SM_REMOVE Then
      Install.UnInstall
      strStep = "Exit"
     Else
      strStep = "Exit"
     End If
    Else
     strStep = "Exit"
    End If
    
   Case "SdComponent"
       nState = Install.SdComponent( IAParam )
    If nState = BACKSTEP Then
     strStep = "SetModifyType"
    ElseIf nState = NEXTSTEP Then
     strStep = "SdCopyFile"
    Else
     strStep = "Exit"
    End If
    
   Case "SdCopyFile" 
       nState = Install.SdCopyFile( IAParam )
    If nState = BACKSTEP Then
     If Install.SetupTypeName = "_Custom" Then
      strStep = "SdComponent"
     Else
      strStep = "SdSetupType"
     End If
    Else
     strStep = "SdFinish"
    End If
       
      Case "SdFinish" 
       Install.SdFinish( IAParam )
    strStep = "Exit"
    
     Case Else
         strStep = "Exit"
  End Select
 Loop 
End Sub
 
 
'--------------------------------------------
' 安装系统
'--------------------------------------------
Sub OnInstall()
 strStep   = "SdWelCom"

 Do While strStep <> "Exit"
  Select Case strStep
  
   Case "SdWelCom"
    nState = Install.SdWelcome(IAParam)
    If nState = BACKSTEP Then
     strStep = "SdWelCom"
    ElseIf nState = NEXTSTEP Then
     strStep = "SdLicense"
    Else
     strStep = "Exit"
    End If
      
      Case "SdLicense" 
       nState = Install.SdLicense(IAParam)
    If nState = BACKSTEP Then
     strStep = "SdWelCom"
    ElseIf nState = NEXTSTEP Then
     strStep = "SdSetDestPath"
    Else
     strStep = "Exit"
    End If
       
      Case "SdSetDestPath"
       nState = Install.SdSetDestPath(IAParam)
    If nState = BACKSTEP Then
     strStep = "SdLicense"
    ElseIf nState= NEXTSTEP Then
     strStep = "SetAMDB"
    Else
     strStep = "Exit"
    End If
    
   Case "SetAMDB"
      IAParam.SetPrompt "设置ActiveMessenger信息"
    IAParam.SetItemCount 4
    IAParam.SetItemPrompt 1, "am数据库服务："
    IAParam.SetItemData 1 , g_szAMDBSvr
    IAParam.SetItemPrompt 2, "am数据库名称："
    IAParam.SetItemData 2 , g_szAMDB
    IAParam.SetItemPrompt 3, "am服务器端口"
    IAParam.SetItemData 3 , g_szAMSvr
    IAParam.SetItemPrompt 4, "am服务器："
    IAParam.SetItemData 4 , g_szAMPort
    
    nState = Install.SdEdit(IAParam)
    g_szAMDBSvr =  IAParam.GetItemData(1)
    g_szAMDB =  IAParam.GetItemData(2)
    g_szAMSvr =  IAParam.GetItemData(3)
    g_szAMPort =  IAParam.GetItemData(4)
    
    If nState = BACKSTEP Then
     strStep = "SdSetDestPath"
    ElseIf nState= NEXTSTEP Then
     strStep = "SetAPMdb"
    Else
     strStep = "SdFinish"
    End If
    
   Case "SetAPMdb"
       IAParam.SetPrompt "设置apm信息"
    IAParam.SetItemCount 3
    IAParam.SetItemPrompt 1, "APM数据库服务："
    IAParam.SetItemData 1 , g_szAPMSvr
    IAParam.SetItemPrompt 2, "APM数据库名称："
    IAParam.SetItemData 2 , g_szAPMDB

    nState = Install.SdEdit(IAParam)
    If nState = BACKSTEP Then
     strStep = "SdSetDestPath"
    ElseIf nState= NEXTSTEP Then
     strStep = "SetWebSite"
    Else
     strStep = "SdFinish"
    End If
    
   Case "SetWebSite"
    IAParam.SetPrompt "设置站点名称"
    IAParam.SetItemCount 1
    IAParam.SetItemPrompt 1, "站点："
    IAParam.SetItemData 1 , "APM"
   
    nState = Install.SdEdit(IAParam)
    If nState = BACKSTEP Then
     strStep = "SetAPMdb"
    ElseIf nState= NEXTSTEP Then
     strStep = "SdCopyFile"
    Else
     strStep = "SdFinish"
    End If
    
    strWebSite =  IAParam.GetItemData(1)
    StartServer()
    g_szAPMSite = strWebSite 
    
    strOSName = CommObj.GetCurOSName()
    If strOSName  = "Windows2003" Then
     SetIISInfo
    End If
    
     ValidateWebSite strWebSite, "1"
     If g_ErrorCode = 0 Then
      szErrInfo= "安装程序发现站点 " + g_szAPMSite + " 已存在，若直接覆盖点击‘确定’，若要重新命名站点，点击‘取消’按钮！"
      nReturn = MsgBox( szErrInfo , 1+48+256, "确认覆盖" )
      If nReturn = 1 Then
       DeleteWebSite  g_szAPMSite,"1"
      Else
       strStep = "SetWebSite"
     End If
     End If
    
   Case "SdCopyFile" 
       nState = Install.SdCopyFile( IAParam )
    If nState = BACKSTEP Then
     strStep = "SetWebSite"
    ElseIf nState= NEXTSTEP Then
     strStep = "SetVirtualDir"
    Else
     strStep = "SdFinish"
    End If
  
       
      Case "SetVirtualDir" 
       IAParam.SetPrompt "Creating WirtualDir ..."
       IAParam.SetAttrib "ShowDialog" , "TRUE"
       Install.SdWaiting IAParam
       
       MakeWebSite strWebSite
       If g_ErrorCode <> 0 Then
        Install.SetSetupError 1
       End If
       
       IAParam.SetAttrib "ShowDialog" , "FALSE"
       Install.SdWaiting IAParam
    strStep = "SdFinish"
    
      Case "SdFinish" 
       Install.SdFinish IAParam
    strStep = "Exit"
    
     Case Else
         strStep = "Exit"
  End Select
 Loop
End Sub 

'//
'
' Fuction List
'
'//

Function MakeWebSite( strWebSite )
 sSitePath = Install.GetPath( "PATH_S_TARGETDIR" )
 CreateWebSite strWebSite, "1", sSitePath
 If g_ErrorCode <> 0 Then
  msgbox g_ErrorInfo
  Exit Function
 End If
                                   
  szWebPath = "IIS://localHost/W3Svc/1/Root/" + g_szAPMSite
 SetDefaultDoc szWebPath, "Login.aspx"
  If g_ErrorCode <> 0 Then
  msgbox g_ErrorInfo
  Exit Function
 End If
   
 CreateApp szWebPath, g_szAPMSite
    If g_ErrorCode <> 0 Then
  msgbox g_ErrorInfo
  Exit Function
 End If
   
    WriteConfig
End Function
 
Function WriteConfig()
 szGlobalPath = Install.GetPath("PATH_S_TARGETDIR") + "/Web.config"
' szExepath = Install.GetPath("PATH_S_SUPPORTDIR") + "/RpFileString.exe"
'   szGlobal="/"+szGlobalPath+",<<APMDB>>="+g_szAPMDB+",<<APMSVR>>="+g_szAPMSvr+",<<AMDBSVR>>="+g_szAMDBSvr+",<<AMSVR>>="+g_szAMSvr+",<<AMDB>>="+g_szAMDB
'    szGlobal = szGlobal+",<<AMDBUSER>>="+g_szDbUser+",<<AMDBUSERPSW>>="+g_szDbUserPsw+",<<AMPORT>>="+g_szAMPort+",<<AMLOGIN>>="+g_szLogin+",<<AMLOGINPSW>>="+g_szLoginPsw+"/"
   
 CommObj.ReplaceTextFileData szGlobalPath , "<<APMDB>>" , g_szAPMDB
 CommObj.ReplaceTextFileData szGlobalPath , "<<APMSVR>>" , g_szAPMSvr
 CommObj.ReplaceTextFileData szGlobalPath , "<<AMDBSVR>>" , g_szAMDBSvr
 CommObj.ReplaceTextFileData szGlobalPath , "<<AMSVR>>" , g_szAMSvr
 CommObj.ReplaceTextFileData szGlobalPath , "<<AMDB>>" , g_szAMDB
 CommObj.ReplaceTextFileData szGlobalPath , "<<AMDBUSER>>" , g_szDbUser
 CommObj.ReplaceTextFileData szGlobalPath , "<<AMDBUSERPSW>>" , g_szDbUserPsw
 CommObj.ReplaceTextFileData szGlobalPath , "<<AMPORT>>" , g_szAMPort
 CommObj.ReplaceTextFileData szGlobalPath , "<<AMLOGIN>>" , g_szLogin
 CommObj.ReplaceTextFileData szGlobalPath , "<<AMLOGINPSW>>" , g_szLoginPsw
 
'  Exit Function
'   nResult=Install.ShellExec( szExepath,szGlobal,1,"")
'     If nResult < 0 Then
'      Msgbox "设置站点文件 Web.config 时出错！"
'      return -1
'     End If
End Function

Function DeleteWebSite(sSiteName, sWebSiteIndex)
    On Error Resume Next
    Dim webSite, vRoot, vDir
   
    Set webSite = GetObject("IIS://LocalHost/W3svc/" & sWebSiteIndex)
    If Err.Number <> 0 Then
        SetErrInfo 1, "站点IIS://LocalhOST/W3SVC/" & sWebSiteIndex & "可能不存在。"
        Err.Clear
        Exit Function
    End If
   
    Set vDir = GetObject("IIS://LocalHost/W3svc/" & sWebSiteIndex & "/Root/" & sSiteName)
    If Err.Number <> 0 Then
        SetErrInfo 3, "目录Del IIS://LocalHost/W3svc/" & sWebSiteIndex & "/Root/" & sSiteName & "不存在"
        Err.Clear
        Exit Function
    End If
   
    Set vRoot = GetObject("IIS://LocalHost/W3svc/" & sWebSiteIndex & "/Root")
    If Err.Number <> 0 Then
        SetErrInfo 1, "站点IIS://LocalhOST/W3SVC/" & sWebSiteIndex & "可能不存在。"
        Err.Clear
        Exit Function
    End If
       
    vRoot.Delete "IIsWebVirtualDir", sSiteName
    If Err.Number <> 0 Then
        SetErrInfo 5, "删除虚拟目录时出错"
        Err.Clear
        Exit Function
    End If
   
    SetErrInfo 0, "删除虚拟目录成功"
End Function

'====================================================================
'这个函数在Web站点上创建一个虚拟目录，把虚拟目录的权限设为默认可读取、不可写、
'目录不可览、可执行脚本、不可执行程序。
'====================================================================
Function CreateWebSite(sSiteName, sWebSiteIndex, sSitePath)
    On Error Resume Next
    Dim webSite, vRoot, vDir
   
    If sSitePath = "" Then
        SetErrInfo 100, "参数 sSitePath 错误"
  Exit Function
    End If
       
    'Set error infomation first
    SetErrInfo 0, "程序发生了一个不明错误。"

    Set webSite = GetObject("IIS://localhost/W3svc/" & sWebSiteIndex)
    If Err.Number <> 0 Then
  SetErrInfo 1, "站点IIS://LocalhOST/W3SVC/" & sWebSiteIndex & "可能不存在。"
     Err.Clear
     Exit Function
    End If

    Set vDir = GetObject("IIS://Localhost/W3SVC/" & sWebSiteIndex & "/Root/" & sSiteName)
    If Err.Number <> 0 Then   'the site doesnt exist, so create it.
                Err.Clear
        Set vRoot = webSite.GetObject("IIsWebVirtualDir", "Root")
        Set vDir = vRoot.Create("IIsWebVirtualDir", sSiteName)
        If Err.Number <> 0 Then
            SetErrInfo 2, "创建虚拟目录时出错：" & sSiteName
            Err.Clear
            Exit Function
        End If
    End If
    vDir.Path = sSitePath
    vDir.AccessRead = True
    vDir.EnableDirBrowsing = False
    vDir.AccessExecute = False
    vDir.AccessWrite = False
    vDir.AccessScript = True
    vDir.SetInfo
   
    SetErrInfo 0, "创建站点成功"
End Function

Function SetWebSitePath(sWebPath, sPath)
    On Error Resume Next
    Dim webSite, vDir
   
    Set vDir = GetObject(sWebPath)
    If Err.Number <> 0 Then 'The site doesnt exist.
        SetErrInfo 2, "站点" & sWebPath & "不存在"
        Err.Clear
        Exit Function
    End If
    vDir.Path = sPath
    vDir.SetInfo
   
    SetErrInfo 0, "设置站点目录成功"
End Function

Function SetProperty(sWebPath, sPropertyName, sProperValue)
    On Error Resume Next
    Dim vDir
    GetWebDirectory sWebPath, vDir
    vDir.Put sPropertyName, sProperValue
    vDir.SetInfo
    If Err.Number <> 0 Then
        SetErrInfo 3, "目录Pro" & sWebPath & "不存在"
        Err.Clear
        Exit Function
    End If
   
    SetErrInfo 0, "属性设置成功"
End Function

Function SetDefaultDoc(sWebPath, sDocName)
    On Error Resume Next
    Dim vDir
    GetWebDirectory sWebPath, vDir
    vDir.Put "EnableDefaultDoc", True
    vDir.Put "DefaultDoc", sDocName
    vDir.SetInfo
    If Err.Number <> 0 Then
        SetErrInfo 3, "目录Doc" & sWebPath & "不存在"
        Exit Function
    End If
   
    SetErrInfo 0, "设置默认文档成功"
End Function

Function CreateApp(sWebPath, sAppName)
    On Error Resume Next
    Dim vDir, oParentNode
    GetWebDirectory sWebPath, vDir
   
    vDir.AppCreate True
    If Err.Number <> 0 Then
        SetErrInfo 4, "创建Web应用程序时出错。"
        Exit Function
    End If
   
    vDir.AppFriendlyName = sAppName
    vDir.SetInfo
   
    SetErrInfo 0, "创建应用程序成功"
End Function

Sub SetErrInfo(nResult, sDesc)
    g_ErrorCode = nResult
    g_ErrorInfo = sDesc
End Sub

Function ValidateWebSite(sSiteName, sWebSiteIndex)
    On Error Resume Next
    Dim webSite, vDir
   
    Set webSite = GetObject("IIS://localhost/W3svc/" & sWebSiteIndex)
    If Err.Number <> 0 Then
  SetErrInfo 1 , "站点IIS://LocalhOST/W3SVC/" & sWebSiteIndex & "可能不存在。"
  ValidateWebSite = 1
  Exit Function
    End If
   
    Set vDir = GetObject("IIS://Localhost/W3SVC/" & sWebSiteIndex & "/Root/" & sSiteName)
    If Err.Number <> 0 Then   'the site doesnt exist, so create it.
        Err.Clear
        SetErrInfo 3, "虚拟目录：" & sSiteName & "不存在"
        ValidateWebSite = 3
        Exit Function
    End If

    SetErrInfo 0, ""
    ValidateWebSite = 0
End Function

Function GetWebDirectory(sWebPath, oDir)
    On Error Resume Next
    Dim nIdx, oNewNode
    If Len(sWebPath) <= 28 Then
        Set oDir = Nothing
        Exit Function
    End If
    Set oDir = GetObject(sWebPath)
    If Err.Number <> 0 Then
        Dim sParentPath, sBoyDir
        Err.Clear
        nIdx = InStrRev(sWebPath, "/")
        sParentPath = Left(sWebPath, nIdx - 1)
        sBoyDir = Mid(sWebPath, nIdx + 1)
        GetWebDirectory sParentPath, oNewNode
        Set oDir = oNewNode.Create("IIsWebDirectory", sBoyDir)
        If Err.Number <> 0 Then
            Set oDir = Norhing
        End If
    End If
End Function

Function SetIISInfo()
 Dim IIsWebServiceObj
 Set IIsWebServiceObj = GetObject("IIS://localhost/W3SVC")
 IIsWebServiceObj.EnableWebServiceExtension "ASP"
 IIsWebServiceObj.EnableWebServiceExtension "SSINC"
 IIsWebServiceObj.EnableWebServiceExtension "HTTPODBC"
 IIsWebServiceObj.EnableWebServiceExtension "WEBDAV"
 IIsWebServiceObj.EnableExtensionFile "*.exe"
 IIsWebServiceObj.AspEnableParentPaths = 1   'Enable parent paths
 IIsWebServiceObj.EnableWebServiceExtension "ASP.NET v1.1.4322"
 IIsWebServiceObj.SetInfo
 Set IIsWebServiceObj = nothing
End Function

'====================================================
' Start IIS Server
'====================================================
Private Function StartServer()
 Dim Fullpath,oServer
 Fullpath= "IIS://LocalHost/W3SVC/1"
 Set oServer = GetObject(fullpath)
 oServer.Start
 Set oServer = nothing
End Function