asp创建用户、目录和站点(转)

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

  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:\userdate\user1"
    If Not FsObject.FolderExists(tmpFolder) Then
        FsObject.CreateFolder(tmpFolder)
        If Err.Number<>0 Then
            WScript.Echo "创建目录" & tmpFolder & "失败！"
        End If
    End If
    注意在创建目录前,先检查了目录是否存在,如果存在,则不用创建了.

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

原文转自：http://www.ltesting.net