-
=============================================================
-
' 感谢您使用ASPKU工作室开发的实用函数程序
-
' HTTP:
-
'=============================================================
-
'ASPKU工作室为您提供订制程序开发、企业互联网拓展服务
-
'QQ:
-
'E-Mail:
-
'更多程序下载请到HTTP:
-
'=============================================================
-
'函数介绍:创建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