''*******************************************************
'' 創建一個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版,請有興趣的朋友自己去查看
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