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

=============================================================  
'     感谢您使用ASPKU工作室开发的实用函数程序  
'         HTTP://WWW.ASPKU.NET  
'=============================================================     
'ASPKU工作室为您提供订制程序开发、企业互联网拓展服务  
'QQ：
'E-Mail：
'更多程序下载请到HTTP://WWW.ASPKU.NET  
'=============================================================     
'函数介绍：创建WebSite  
'本函数使用ADSI，需要Administrators组用户权限  
'函数名称：CreateWebSite(Computer,IPAddr,PortNum,HostName,WebSiteDirectory,LogDirectory,WebSiteInfo,GuestUserName,GuestUserPass,StartOrStop)  
'程序开发：ASPKU工作室 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