使用ASP在IIS创建WEB站点的函数

=============================================================
"       感谢您使用ASP001工作室开发的实用函数程序
"               HTTP://WWW.ASP001.NET
"=============================================================
"ASP001工作室为您提供订制程序开发、企业互联网拓展服务
"QQ：1974229
"E-Mail：Shenyangchuqi@tom.com
"更多程序下载请到HTTP://WWW.ASP001.NET
"=============================================================
"函数介绍：创建WebSite
"本函数使用ADSI，需要Administrators组用户权限
"函数名称：CreateWebSite（Computer,IPAddr,PortNum,HostName,WebSiteDirectory,LogDirectory,WebSiteInfo,GuestUserName,GuestUserPass,StartOrStop）
"程序开发：ASP001工作室 ChuQi
"用法：CreateWebSite 计算机名（一搬为LocalHost或127.0.0.1）,站点IP地址,端口号,主机名,站点根目录,,LOG文件的目录站点说明,网站访问时所使用的帐号,网站访问时所用帐号的口令,是否启动站点
"例：CreateWebSite "LocalHost","127.0.0.123","80","www.test.net","E:UserDataUserNum001","E:UserDataUserNum001LogFiles","wwwtest.net","IUSR_Num001_test.net","abc888",True
"=============================================================

Function CreateWebSite（Computer,IPAddr,PortNum,HostName,WebSiteDirectory,LogDirectory,WebSiteInfo,GuestUserName,GuestUserPass,StartOrStop）
Dim w3svc, WebServer, NewWebServer, NewDir
Dim Bindings, BindingString, NewBindings, SiteNum, SiteObj, bDone
On Error Resume Next
Err.Clear
"检测是否能够加载W3SVC服务（即WEB服务）
Set w3svc = GetObject（"IIS://" & Computer & "/w3svc"）
If Err.Number <> 0 Then "显示错误提示
response.write "无法打开: "&"IIS://" & Computer & "/w3svc"
response.end
End If

"检测是否有设定相同IP地址、端口及主机名的站点存在
BindingString = IPAddr & ":" & PortNum & ":" & HostName
For Each WebServer in w3svc
If WebServer.Class = "IIsWebServer" Then
Bindings = WebServer.ServerBindings
If BindingString = Bindings（0） Then
response.write "IP地址冲突:" & IPAddr & ",请检测IP地址！."
Exit Function
End If
End If
Next

"确定一个不存在的站点编号做为新建站点编号，系统默认WebSite站点编号为1，因此从2开始
SiteNum=2
bDone = False

While （Not bDone）
Err.Clear
Set SiteObj = GetObject（"IIS://"&Computer&"/w3svc/"&SiteNum）         "加载指定站点
If （Err.Number = 0） Then
"response.write " Step_1站点"&SiteNum&"存在 "
SiteNum = SiteNum + 1
Else
"response.write " Step_1站点"&SiteNum&"不存在 "
Err.Clear
Set NewWebServer = w3svc.Create（"IIsWebServer",SiteNum）              "创建指定站点
   If （Err.Number <> 0） Then
   "response.write " Step_2站点"&SiteNum&"创建失败 "
   SiteNum = SiteNum + 1
   Else
   "response.write " Step_2站点"&SiteNum&"创建成功 "
   bDone = True
   End If
End If

If （SiteNum > 50） Then  "服务器最大创建站点数
response.write "超出服务器最大创建站点数，正在创建的站点的序号为： "&SiteNum&"."
response.end
End If
Wend

"进行站点基本配置
NewBindings = Array（0）
NewBindings（0） = BindingString
NewWebServer.ServerBindings = NewBindings
NewWebServer.ServerComment= WebSiteInfo
NewWebServer.AnonymousUserName= GuestUserName
NewWebServer.AnonymousUserPass= GuestUserPass
NewWebServer.KeyType = "IIsWebServer"
NewWebServer.FrontPageWeb = True
NewWebServer.EnableDefaultDoc = True
NewWebServer.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp"
NewWebServer.LogFileDirectory= LogDirectory
NewWebServer.SetInfo

Set NewDir = NewWebServer.Create（"IIsWebVirtualDir", "ROOT"）
NewDir.Path = WebSiteDirectory
NewDir.AccessRead = true
NewDir.AppFriendlyName = "应用程序" & WebSiteInfo
NewDir.AppCreate True
NewDir.AccessScript = True
Err.Clear
NewDir.SetInfo
If （Err.Number = 0） Then
Else
response.write "主目录创建时出错."
response.end
End If

If StartOrStop = True Then
Err.Clear
Set NewWebServer = GetObject（"IIS://" & Computer & "/w3svc/" & SiteNum）
NewWebServer.Start
If Err.Number <> 0 Then
response.write "启动站点时出错！"
response.end
Err.Clear
Else
End If
End If
response.write "站点创建成功，站点编号为："& SiteNum &" ，域名为："& HostName
End Function