关于ADSI,请高手指点.(含代码)

gzhoney 2005-08-21 12:06:13
'=============================================================
'函数介绍:创建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

在网上找到段代码?于量把他放在VB的类中,写成个DLL。
首先我VB里调用,调用时在:
Set SiteObj = GetObject("IIS://" & Computer & "/w3svc/" & SiteNum) '加载指定站点
这句提示"自动化错误",如果用On Error Resume Next强制运行,则可以在IIS里创建一站点只是没有创建到相应的文件夹。

如果在ASP里调用那DLL,则不能创建站点,同样,相应文件夹也没有创建。

请问这是什么原因?代码错在哪里?

...全文
192 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
jim.ma 2005-09-09
  • 打赏
  • 举报
回复
先检查站点是否有有这么高的权限 默认是最低的用户权限不可能允许创建的。
另外站点指定的目录是否存在。
moeryang 2005-09-08
  • 打赏
  • 举报
回复
首先确定你运行程序的账号有没有Administrators组用户权限
asp运行的账号是IUser_机器名,肯定不是Administrators组,不能运行不奇怪;
至于vb应该是无法初始化Com
试下判断SiteObj是否为nothing
凯晰叶子 2005-09-08
  • 打赏
  • 举报
回复
这些问题,很少有人会说的!
gzhoney 2005-09-01
  • 打赏
  • 举报
回复
..

8,327

社区成员

发帖
与我相关
我的任务
社区描述
Web 开发 IIS
社区管理员
  • IIS
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧