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

时间:2022-01-15 23:08:15
  1. =============================================================  
  2. '       感谢您使用ASPKU工作室开发的实用函数程序  
  3. '               HTTP://WWW.ASPKU.NET  
  4. '=============================================================       
  5. 'ASPKU工作室为您提供订制程序开发、企业互联网拓展服务  
  6. 'QQ:
  7. 'E-Mail:
  8. '更多程序下载请到HTTP://WWW.ASPKU.NET  
  9. '=============================================================       
  10. '函数介绍:创建WebSite  
  11. '本函数使用ADSI,需要Administrators组用户权限  
  12. '函数名称:CreateWebSite(Computer,IPAddr,PortNum,HostName,WebSiteDirectory,LogDirectory,WebSiteInfo,GuestUserName,GuestUserPass,StartOrStop)  
  13. '程序开发:ASPKU工作室 ChuQi  
  14. '用法:CreateWebSite 计算机名(一搬为LocalHost或127.0.0.1),站点IP地址,端口号,主机名,站点根目录,,LOG文件的目录站点说明,网站访问时所使用的帐号,网站访问时所用帐号的口令,是否启动站点  
  15. '例: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  
  16. '=============================================================  
  17.  
  18. Function CreateWebSite(Computer,IPAddr,PortNum,HostName,WebSiteDirectory,LogDirectory,WebSiteInfo,GuestUserName,GuestUserPass,StartOrStop)  
  19. Dim w3svc, WebServer, NewWebServer, NewDir  
  20. Dim Bindings, BindingString, NewBindings, SiteNum, SiteObj, bDone  
  21. On Error Resume Next  
  22. Err.Clear  
  23. '检测是否能够加载W3SVC服务(即WEB服务)  
  24. Set w3svc = GetObject("IIS://" & Computer & "/w3svc")  
  25. If Err.Number <> 0 Then '显示错误提示  
  26. response.write "无法打开: "&"IIS://" & Computer & "/w3svc"  
  27. response.end  
  28. End If  
  29.  
  30. '检测是否有设定相同IP地址、端口及主机名的站点存在  
  31. BindingString = IPAddr & ":" & PortNum & ":" & HostName  
  32. For Each WebServer in w3svc  
  33. If WebServer.Class = "IIsWebServer" Then  
  34. Bindings = WebServer.ServerBindings  
  35. If BindingString = Bindings(0) Then  
  36. response.write "IP地址冲突:" & IPAddr & ",请检测IP地址!."  
  37. Exit Function  
  38. End If  
  39. End If  
  40. Next  
  41.  
  42. '确定一个不存在的站点编号做为新建站点编号,系统默认WebSite站点编号为1,因此从2开始  
  43. SiteNum=2  
  44. bDone = False  
  45.  
  46. While (Not bDone)  
  47. Err.Clear  
  48. Set SiteObj = GetObject("IIS://"&Computer&"/w3svc/"&SiteNum)         '加载指定站点  
  49. If (Err.Number = 0) Then  
  50. 'response.write " Step_1站点"&SiteNum&"存在 "  
  51. SiteNum = SiteNum + 1  
  52. Else  
  53. 'response.write " Step_1站点"&SiteNum&"不存在 "  
  54. Err.Clear  
  55. Set NewWebServer = w3svc.Create("IIsWebServer",SiteNum)              '创建指定站点  
  56.    If (Err.Number <> 0) Then  
  57.    'response.write " Step_2站点"&SiteNum&"创建失败 "  
  58.    SiteNum = SiteNum + 1  
  59.    Else  
  60.    'response.write " Step_2站点"&SiteNum&"创建成功 "  
  61.    bDone = True  
  62.    End If  
  63. End If  
  64.  
  65. If (SiteNum > 50) Then  '服务器最大创建站点数  
  66. response.write "超出服务器最大创建站点数,正在创建的站点的序号为: "&SiteNum&"."  
  67. response.end  
  68. End If  
  69. Wend  
  70.  
  71. '进行站点基本配置  
  72. NewBindings = Array(0)  
  73. NewBindings(0) = BindingString  
  74. NewWebServer.ServerBindings = NewBindings  
  75. NewWebServer.ServerComment= WebSiteInfo  
  76. NewWebServer.AnonymousUserName= GuestUserName  
  77. NewWebServer.AnonymousUserPass= GuestUserPass  
  78. NewWebServer.KeyType = "IIsWebServer"  
  79. NewWebServer.FrontPageWeb = True  
  80. NewWebServer.EnableDefaultDoc = True  
  81. NewWebServer.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp"  
  82. NewWebServer.LogFileDirectory= LogDirectory  
  83. NewWebServer.SetInfo  
  84.  
  85. Set NewDir = NewWebServer.Create("IIsWebVirtualDir""ROOT")  
  86. NewDir.Path = WebSiteDirectory  
  87. NewDir.AccessRead = true  
  88. NewDir.AppFriendlyName = "应用程序" & WebSiteInfo  
  89. NewDir.AppCreate True  
  90. NewDir.AccessScript = True  
  91. Err.Clear  
  92. NewDir.SetInfo  
  93. If (Err.Number = 0) Then  
  94. Else  
  95. response.write "主目录创建时出错."  
  96. response.end  
  97. End If  
  98.  
  99. If StartOrStop = True Then  
  100. Err.Clear  
  101. Set NewWebServer = GetObject("IIS://" & Computer & "/w3svc/" & SiteNum)  
  102. NewWebServer.Start  
  103. If Err.Number <> 0 Then  
  104. response.write "启动站点时出错!"  
  105. response.end  
  106. Err.Clear  
  107. Else  
  108. End If  
  109. End If   
  110. response.write "站点创建成功,站点编号为:"& SiteNum &" ,域名为:"& HostName  
  111. End Function