'************************************************* ****
' 建立一個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