'' 創(chuàng)建一個(gè)WebServer
'' 必須參數(shù)：WRoot,為創(chuàng)建站點(diǎn)的物理目錄；WComment為站點(diǎn)說明；WPort為站點(diǎn)端口；ServerRun為是否自動(dòng)運(yùn)行&n
bsp;
'' 當(dāng)創(chuàng)建成功時(shí)返回1，失敗時(shí)提示退出并返回0，當(dāng)創(chuàng)建站點(diǎn)成功但啟動(dòng)失敗時(shí)返回2
''**********************************************************************************
'' 　
''******************注意：WPort為List類型，意為服務(wù)器端口，***************
''　　本函數(shù)在IIS5.0上通過，＊＊必須以管理員身份登錄＊＊
'' 端口舉例：
'' Dim WPort,bindlists,createflag,oComputer
'' oComputer="LocalHost"
'' binglists=Array(0)
'' binglists(0)=":80:"''端口號(hào)為80
'' WPort=binglists
'' createflag=CreateWebServer("D:\myweb","我的家園",WPort,False)''調(diào)用建站函數(shù)
''　　If creatflag=0 Then
'' Response.Write "創(chuàng)建站點(diǎn)失��！請確定是否有權(quán)限"
'' ElseIf createflag=1 Then
'' Response.Write "創(chuàng)建站點(diǎn)成功！"
'' ElseIf createflag=2 Then
'' Response.Write "創(chuàng)建站點(diǎn)成功，但啟動(dòng)站點(diǎn)失敗，可能端口沖突！"
'' End If
''******************************************************************************

Function CreateWebServer(WRoot,WComment,WPort,ServerRun)
On Error Resume Next
Dim ServiceObj,ServerObj,VDirObj
Set ServiceObj = GetObject("IIS://"&oComputer&"/W3SVC")'' 首先創(chuàng)建一個(gè)服務(wù)實(shí)例

WNumber=1
Do While IsObject(ServiceObj.GetObject("IIsWebServer",WNumber))
If Err.number<>0 Then
Err.Clear()
Exit Do
End If
WNumber=WNumber+1
Loop

Set ServerObj = ServiceObj.Create("IIsWebServer", WNumber)'' 然后創(chuàng)建一個(gè)Web服務(wù)器

If (Err.Number <> 0) Then'' 是否出錯(cuò)
''Response.Write "錯(cuò)誤: 創(chuàng)建Web服務(wù)器的ADSI操作失敗！"
CreateWebServer=0
Exit Function
End If

'' 接著配置服務(wù)器
ServerObj.ServerSize = 1 '' 中型大小
ServerObj.ServerComment = WComment ''說明
ServerObj.ServerBindings = WPort ''端口
ServerObj.EnableDefaultDoc=True

'' 提交信息
ServerObj.SetInfo

'' 最后，建立虛擬目錄
Set VDirObj = ServerObj.Create("IIsWebVirtualDir", "ROOT")

If (Err.Number <> 0) Then'' 是否出錯(cuò)
''Response.Write "錯(cuò)誤: 創(chuàng)建虛擬目錄的ADSI操作失�。�"
CreateWebServer=0
Exit Function
End If

'' 配置虛擬目錄
VDirObj.Path = WRoot
VDirObj.AccessRead = True
VDirObj.AccessWrite = True
VDirObj.EnableDirBrowsing = False
VDirObj.EnableDefaultDoc=True
VDirObj.AccessScript=True
VDirObj.AppCreate2 2
VDirObj.AppFriendlyName="默認(rèn)應(yīng)用程序"
VDirObj.SetInfo

If ServerRun = True Then
ServerObj.Start
If (Err.Number <> 0) Then '' Error！
''Response.Write "錯(cuò)誤: 起動(dòng)服務(wù)器時(shí)出錯(cuò)！請手動(dòng)啟動(dòng)WebServer "&WComment&"！
"
CreateWebServer=2
Exit Function
End If
End If
Set VDirObj=Nothing
Set ServerObj=Nothing
Set ServiceObj=Nothing
CreateWebServer=1
End Function