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

gzhoney 2005-08-21 12:07:03
'=============================================================
'函数介绍:创建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,则不能创建站点,同样,相应文件夹也没有创建。

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

...全文
143 点赞 收藏 1
写回复
1 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
zmy0611 2005-11-11
UP
回复
相关推荐
发帖
Web开发应用服务器
创建于2007-09-28

5596

社区成员

Web开发应用服务器相关讨论专区
申请成为版主
帖子事件
创建了帖子
2005-08-21 12:07
社区公告
暂无公告