IIS自动开通组件编程

领测软件测试网

　　 
　　'' 创建一个WebServer
　　'' 必须参数：WRoot,为创建站点的物理目录；WComment为站点说明；WPort为站点端口；ServerRun为是否自动运行&n
　　bsp;
　　'' 当创建成功时返回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
　　''**************************************
　　
　　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&"！
　　"
　　CreateWebServer=2
　　Exit Function
　　End If
　　End If
　　Set VDirObj=Nothing
　　Set ServerObj=Nothing
　　Set ServiceObj=Nothing
　　CreateWebServer=1
　　End Function

文章来源于领测软件测试网 https://www.ltesting.net/