asp创建用户目录和站点

　　自：Super Hei Pig 文章中心邪恶八进制作者未知

　　本讲将使用到ADSI，即活动目录服务接口.可以到到一些相关的资料.

　　1.创建用户
下面这段代码在独立服务器white上创建用户user1,初始口令user1,用到了ADSI.
Dim Username,UserPass
Dim oDomain,oUser
Username = user1
UserPass = user1
Set oDomain = GetObject(WinNT://white)
Set oUser = oDomain.Create (user, UserName)
If (err.number = 0) Then
oUser.SetInfo
oUser.SetPassword UserPass
oUser.SetInfo
Else
WScript.Echo 创建用户 UserName 出错！
End If
Set oUser = Nothing
Set oDomain = Nothing

　　2.创建目录
使用FileSystemObject创建目录:
Dim FsObject
Dim tmpFolder
Set FsObject = WScript.CreateObject(Scripting.FileSystemObject)
tmpFolder = D:userdateuser1
If Not FsObject.FolderExists(tmpFolder) Then
FsObject.CreateFolder(tmpFolder)
If Err.Number<>0 Then
WScript.Echo 创建目录 tmpFolder 失败！
End If
End If
注意在创建目录前,先检查了目录是否存在,如果存在,则不用创建了.

　　3.创建站点
下面这个子程序负责创建一个点,各个参数的意义为：站点IP地址,站点根目录,站点说明,主机名,端口号,计算机名(一搬为LOCALHOST),是否立即启动,匿名访问时所使用的帐号,匿名访问时所用帐号的口令,LOG文件的目录.
函数返回所建站点在IIS中的序号(在IIS中,所有站点依次编号,第一个为1).
一个调用示例：siteid = ASTCreateWebSite(10.1.3.122,d:userdatauser1,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

　　下面函数创建ＦＴＰ站点：
Function ASTCreateFtpSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computer, Start,LogFileDirectory)
Dim MSFTPSVC, FtpServer, NewFtpServer, NewDir
Dim Bindings, BindingString, NewBindings, Index, SiteObj, bDone
On Error Resume Next
Err.Clear
Set MSFTPSVC = GetObject(IIS:// Computer /MSFTPSVC)
If Err.Number <> 0 Then
WScript.Echo 无法打开: IIS:// Computer /MSFTPSVC VbCrlf 程序将退出.
WScript.Quit (1)
End If

　　BindingString = IpAddress : PortNum : HostName
For Each FtpServer in MSFTPSVC
If FtpServer.Class=IIsFtpServer Then
Bindings = FtpServer.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/MSFTPSVC/ Index)
If (Err.Number = 0) Then
Index = Index + 1
Else
Err.Clear
Set NewFtpServer = MSFTPSVC.Create(IIsFtpServer, Index)
If (Err.Number <> 0) Then
Index = Index + 1
Else
Err.Clear
Set SiteObj = GetObject(IIS://Computer/MSFTPSVC/ 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
NewFtpServer.ServerBindings = NewBindings
NewFtpServer.ServerComment = ServerComment
NewFtpServer.AllowAnonymous = False
NewFtpServer.AccessWrite = True
NewFtpServer.AccessRead = True
NewFtpServer.DontLog = False
NewFtpServer.LogFileDirectory = LogFileDirectory
NewFtpServer.SetInfo

　　Set NewDir = NewFtpServer.Create(IIsFtpVirtualDir, ROOT)
NewDir.Path = RootDirectory
NewDir.AccessRead = true
Err.Clear
NewDir.SetInfo
If (Err.Number = 0) Then
Else
WScript.Echo 主目录创建时出错.
End If

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