'===============================================================
'函数名称:AddWebSiteHostName
'函数功能:在已存在的站点中主机头中添加新的主机头
' index 站点编号
' NewWebTop 主机头字符串
'开发成员:MMC(mmcgzs@hotmail.com)
'===============================================================
Public Function AddWebSiteHostName(index, NewWebTop)
On Error Resume Next
Dim tmpwebtop, ztop, oWebServer, tmpstring, Computer
Computer = "localhost"
Set oWebServer = GetObject("IIS://" & Computer & "/w3svc/" & index)
tmpwebtop = oWebServer.serverbindings '''获取原来的主机头
tmpstring = Join(tmpwebtop, "|||")
If InStr(tmpstring, "|||" & NewWebTop & "|||") Or InStr(tmpstring, "|||" & NewWebTop) Or InStr(tmpstring, NewWebTop & "|||") = 1 Then
oWebServer.serverbindings = tmpwebtop
Else
ReDim Preserve tmpwebtop(UBound(tmpwebtop) + 1)
tmpwebtop(UBound(tmpwebtop)) = NewWebTop
oWebServer.serverbindings = tmpwebtop
End If
oWebServer.SetInfo
If Err.Number <> 0 Then Call ErrMessage("发生意外错误,请和管理员联系。")
Err.Clear
End Function
'===============================================================
'函数名称:DelWebSiteHostName
'函数功能:在已存在的站点中主机头中删除一个主机头
' index 站点编号
' WebTop 主机头字符串
'开发成员:MMC(mmcgzs@hotmail.com)
'===============================================================
Public Function DelWebSiteHostName(index, WebTop)
On Error Resume Next
Dim tmpwebtop, ztop, oWebServer, tmpstring, Computer, i
Computer = "localhost"
Set oWebServer = GetObject("IIS://" & Computer & "/w3svc/" & index)
tmpwebtop = oWebServer.serverbindings '''获取原来的主机头
tmpstring = Join(tmpwebtop, "|||")
If InStr(tmpstring, "|||" & WebTop & "|||") Or InStr(tmpstring, "|||" & WebTop) Or InStr(tmpstring, WebTop & "|||") = 1 Then
For i = 0 To UBound(tmpwebtop)
If i > UBound(tmpwebtop) Then Exit For
If tmpwebtop(i) = WebTop Then
tmpwebtop(i) = tmpwebtop(UBound(tmpwebtop))
ReDim Preserve tmpwebtop(UBound(tmpwebtop) - 1)
End If
Next
oWebServer.serverbindings = tmpwebtop
End If
oWebServer.SetInfo
If Err.Number <> 0 Then Call ErrMessage("发生意外错误,请和管理员联系。")
Err.Clear
End Function