高分寻求asp创建站点的写法...

[chenjf2k]

我在网上找到这么一篇文章，可是运行后提示“权限不足”，请高手帮忙，感激不尽
------------------------------------------------------------
<%
siteid = ASTCreateWebSite("10.1.3.122","d:\userdata\user1","www_user1","","80","LocalHost",True,"IUSR_user1","8iui%#","D:\Logfiles")

Function ASTCreateWebSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computer, Start,AnonymousUserName,AnonymousUserPass,LogFileDirectory)
Dim w3svc, WebServer, NewWebServer, NewDir
Dim Bindings, BindingString, NewBindings, Index, SiteObj, bDone
On Error Resume Next
Err.Clear
Set w3svc = GetObject("IIS://" & Computer & "/w3svc")
If Err.Number <> 0 Then
WScript.Echo "无法打开: "&"IIS://" & Computer & "/w3svc" & VbCrlf & "程序将退出."
WScript.Quit (1)
End If

BindingString = IpAddress & ":" & PortNum & ":" & HostName
For Each WebServer in w3svc
If WebServer.Class = "IIsWebServer" Then
Bindings = WebServer.ServerBindings
If BindingString = Bindings(0) Then
WScript.Echo "IP地址冲突:" & IpAddress & ",请检测IP地址！." & VbCrlf & "取消创建本站点。"
Exit Function
End If
End If
Next

Index = 1
bDone = False

While (Not bDone)
Err.Clear
Set SiteObj = GetObject("IIS://"&Computer&"/w3svc/" & Index)
If (Err.Number = 0) Then
Index = Index + 1
Else
Err.Clear
Set NewWebServer = w3svc.Create("IIsWebServer", Index)
If (Err.Number <> 0) Then
Index = Index + 1
Else
Err.Clear
Set SiteObj = GetObject("IIS://"&Computer&"/w3svc/" & Index)
If (Err.Number = 0) Then
bDone = True
Else
Index = Index + 1
End If
End If
End If

If (Index > 10000) Then
WScript.Echo "看起来不能创建站点，正在创建的站点的序号为： "&Index&"." & VbCrlf & "取消创建本站点。"
Exit Function
End If
Wend

NewBindings = Array(0)
NewBindings(0) = BindingString
NewWebServer.ServerBindings = NewBindings
NewWebServer.ServerComment = ServerComment
NewWebServer.AnonymousUserName = AnonymousUserName
NewWebServer.AnonymousUserPass = AnonymousUserPass
NewWebServer.KeyType = "IIsWebServer"
NewWebServer.FrontPageWeb = True
NewWebServer.EnableDefaultDoc = True
NewWebServer.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp"
NewWebServer.LogFileDirectory = LogFileDirectory
NewWebServer.SetInfo

Set NewDir = NewWebServer.Create("IIsWebVirtualDir", "ROOT")
NewDir.Path = RootDirectory
NewDir.AccessRead = true
NewDir.AppFriendlyName = "应用程序" & ServerComment
NewDir.AppCreate True
NewDir.AccessScript = True
Err.Clear
NewDir.SetInfo
If (Err.Number = 0) Then
Else
WScript.Echo "主目录创建时出错."
End If

If Start = True Then
Err.Clear
Set NewWebServer = GetObject("IIS://" & Computer & "/w3svc/" & Index)
NewWebServer.Start
If Err.Number <> 0 Then
WScript.Echo "启动站点时出错!"
Err.Clear
Else
End If
End If
ASTCreateWebSite = Index
End Function

%>

[chenjf2k]

加至100分，高手帮忙，如有更简洁写法500重谢

[chenjf2k]

请帮我！

[wxf0104]

楼主好富哦，哪来那么多分的？

[wxf0104]

在系统中加上那个要创建站点的目录读写权限呢？

[chenjf2k]

下面语句需要管理员权限
----------------------------
Set w3svc = GetObject("IIS://" & Computer & "/w3svc")


如果跳过？急！！！！

感谢先

[aspme]

你把全部的代码都贴上来了吗？应该只是一部分吧？

[injoo]

vDirName = "cntcourse" ' 虚拟目录名
folderName = "medinfo" ' 所在文件夹名

Set shell = Wscript.CreateObject( "WScript.Shell" )

' 获得当前目录
Set fso = WScript.CreateObject( "Scripting.FileSystemObject" )
vDirPath = fso.GetFolder( ".\" & folderName ).Path


On Error Resume Next
Set objIIS = GetObject( "IIS://localhost/W3SVC/1/Root/" & vDirName )
If Err.Number = 0 Then
DeleteVirtualDirectory vDirName
End If

'使用 IIS Administration 对象， 打开 script/execute 允许。
Set objIIS = GetObject( "IIS://localhost/W3SVC/1/Root" )
Set vDirObj = objIIS.Create( "IISWebVirtualDir", vDirName )

vDirObj.Path = vDirPath
vDirObj.AuthBasic = True
vDirObj.AccessRead = True
vDirObj.AccessWrite = True
vDirObj.AccessScript = True
vDirObj.AccessExecute = True
vDirObj.AuthAnonymous = True
'vDirObj.AnonymousUserName = owner
vDirObj.AnonymousPasswordSync = True
vDirObj.AppCreate True
vDirObj.SetInfo


' 用 CACLS.exe 改变必须的目录访问授权。
aclCmd = "cmd /c echo y| CACLS "
aclCmd = aclCmd & """" & vDirPath & """"
aclCmd = aclCmd & " /E /G Everyone:C"
rtc = shell.Run( aclCmd , 0, True )


If Err.Number > 0 Then
shell.Popup Err.Description, 0, "错误", 16 ' 16 = Stop
WScript.Quit
Else
shell.Popup "安装完成。" , 0, "完成", 64 ' 64 = Information
End If


Sub DeleteVirtualDirectory( NameOfVdir )

Set iis = GetObject("IIS://localhost/W3SVC/1/Root")
iis.Delete "IISWebVirtualDir", vDirName

If Err.Number = 0 Then
Else
shell.Popup Err.Description, 0, "错误", 16 ' 16 = Stop
End If
End Sub

[hzw66]

必须有管理员权限才可以，没有的话没戏