使用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:\UserData\UserNum001","E:\UserData\UserNum001\LogFiles","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