'**********************************************************************************
' 創建一個WebServer
' 必須參數：WRoot,為創建站點的物理目錄；WComment為站點說明；WPort為站點端口；ServerRun為是否自動運行
' 當創建成功時返回1，失敗時提示退出并返回0，當創建站點成功但啟動失敗時返回2
'**********************************************************************************
' 　
'******************注意：WPort為List類型，意為服務器端口，***************
'　　本函數在IIS5.0上通過，＊＊必須以管理員身份登錄＊＊
' 端口舉例：
' Dim WPort,bindlists,createflag,oComputer
' oComputer="LocalHost"
' binglists=Array(0)
' binglists(0)=":80:"'端口號為80
' WPort=binglists
' createflag=CreateWebServer("D:\myweb","我的家園",WPort,False)'調用建站函數
'　　If creatflag=0 Then
' Response.Write "創建站點失敗！請確定是否有權限"
' ElseIf createflag=1 Then
' Response.Write "創建站點成功！"
' ElseIf createflag=2 Then
' Response.Write "創建站點成功，但啟動站點失敗，可能端口沖突！"
' End If
'********************************************************************************
'關于Ftp站點的創建我已發表在asp版，請有興趣的朋友自己去查看
'如有問題，歡迎跟我聯系:[email protected]

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

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)' 然后創建一個WEB服務器

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

' 接著配置服務器
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' 是否出錯
'Response.Write "錯誤: 創建虛擬目錄的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="默認應用程序"
VDirObj.SetInfo

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