'//////////////////////////////////////////////////////////////////////////////
'
' 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