|            
本讲将使用到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.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 
  下面函数创建FTP站点:  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  
 |