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