[转帖]asp创建用户、目录和站点(转)
<TABLE cellSpacing=0 cellPadding=3 width="100%" align=center border=0><TR>
<TD class=showTitle align=middle>asp创建用户、目录和站点(转)</TD></TR>
<TR>
<TD>
<TABLE cellSpacing=0 cellPadding=0 align=left border=0>
<TR>
<TD><br></TD></TR></TABLE> 本讲将使用到ADSI，即活动目录服务接口.可以到15Seconds.com找到一些相关的资料.<br><br>1.创建用户<br> 下面这段代码在独立服务器white上创建用户user1,初始口令user1,用到了ADSI.<br> Dim Username,UserPass<br> Dim oDomain,oUser<br> Username = "user1"<br> UserPass = "user1"<br> Set oDomain = GetObject("WinNT://white")<br> Set oUser = oDomain.Create ("user", UserName)<br> If (err.number = 0) Then<br> oUser.SetInfo<br> oUser.SetPassword UserPass<br> oUser.SetInfo<br> Else<br> WScript.Echo "创建用户" & UserName & "出错！"<br> End If<br> Set oUser = Nothing<br> Set oDomain = Nothing<br><br>2.创建目录<br> 使用FileSystemObject创建目录:<br> Dim FsObject<br> Dim tmpFolder<br> Set FsObject = WScript.CreateObject("Scripting.FileSystemObject")<br> tmpFolder = "D:\userdate\user1"<br> If Not FsObject.FolderExists(tmpFolder) Then<br> FsObject.CreateFolder(tmpFolder)<br> If Err.Number<>0 Then<br> WScript.Echo "创建目录" & tmpFolder & "失败！"<br> End If<br> End If<br> 注意在创建目录前,先检查了目录是否存在,如果存在,则不用创建了.<br><br>3.创建站点<br> 下面这个子程序负责创建一个WWW站点,各个参数的意义为：站点IP地址,站点根目录,站点说明,主机名,端口号,计算机名(一搬为LOCALHOST),是否立即启动,匿名访问时所使用的帐号,匿名访问时所用帐号的口令,LOG文件的目录.<br> 函数返回所建站点在IIS中的序号(在IIS中,所有站点依次编号,第一个为1).<br> 一个调用示例：siteid = ASTCreateWebSite("10.1.3.122","d:\userdata\user1","www_user1","","80","LocalHost",True,"IUSR_user1","8iui%#","D:\Logfiles")<br><br>Function ASTCreateWebSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computer, Start,AnonymousUserName,AnonymousUserPass,LogFileDirectory)<br> Dim w3svc, WebServer, NewWebServer, NewDir<br> Dim Bindings, BindingString, NewBindings, Index, SiteObj, bDone<br> On Error Resume Next<br> Err.Clear<br> Set w3svc = GetObject("IIS://" & Computer & "/w3svc")<br> If Err.Number <> 0 Then<br> WScript.Echo "无法打开: "&"IIS://" & Computer & "/w3svc" & VbCrlf & "程序将退出."<br> WScript.Quit (1)<br> End If<br><br> BindingString = IpAddress & ":" & PortNum & ":" & HostName<br> For Each WebServer in w3svc<br> If WebServer.Class = "IIsWebServer" Then<br> Bindings = WebServer.ServerBindings<br> If BindingString = Bindings(0) Then<br> WScript.Echo "IP地址冲突:" & IpAddress & ",请检测IP地址！." & VbCrlf & "取消创建本站点。"<br> Exit Function<br> End If<br> End If<br> Next<br><br> Index = 1<br> bDone = False<br><br> While (Not bDone)<br> Err.Clear<br> Set SiteObj = GetObject("IIS://"&Computer&"/w3svc/" & Index)<br> If (Err.Number = 0) Then<br> Index = Index + 1<br> Else<br> Err.Clear<br> Set NewWebServer = w3svc.Create("IIsWebServer", Index)<br> If (Err.Number <> 0) Then<br> Index = Index + 1<br> Else<br> Err.Clear<br> Set SiteObj = GetObject("IIS://"&Computer&"/w3svc/" & Index)<br> If (Err.Number = 0) Then<br> bDone = True<br> Else<br> Index = Index + 1<br> End If<br> End If<br> End If<br><br> If (Index > 10000) Then<br> WScript.Echo "看起来不能创建站点，正在创建的站点的序号为： "&Index&"." & VbCrlf & "取消创建本站点。"<br> Exit Function<br> End If<br> Wend<br><br> NewBindings = Array(0)<br> NewBindings(0) = BindingString<br> NewWebServer.ServerBindings = NewBindings<br> NewWebServer.ServerComment = ServerComment<br> NewWebServer.AnonymousUserName = AnonymousUserName<br> NewWebServer.AnonymousUserPass = AnonymousUserPass<br> NewWebServer.KeyType = "IIsWebServer"<br> NewWebServer.FrontPageWeb = True<br> NewWebServer.EnableDefaultDoc = True<br> NewWebServer.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp"<br> NewWebServer.LogFileDirectory = LogFileDirectory<br> NewWebServer.SetInfo<br><br> Set NewDir = NewWebServer.Create("IIsWebVirtualDir", "ROOT")<br> NewDir.Path = RootDirectory<br> NewDir.AccessRead = true<br> NewDir.AppFriendlyName = "应用程序" & ServerComment<br> NewDir.AppCreate True<br> NewDir.AccessScript = True<br> Err.Clear<br> NewDir.SetInfo<br> If (Err.Number = 0) Then<br> Else<br> WScript.Echo "主目录创建时出错."<br> End If<br> <br> If Start = True Then<br> Err.Clear<br> Set NewWebServer = GetObject("IIS://" & Computer & "/w3svc/" & Index)<br> NewWebServer.Start<br> If Err.Number <> 0 Then<br> WScript.Echo "启动站点时出错!"<br> Err.Clear<br> Else<br> End If<br> End If <br> ASTCreateWebSite = Index<br>End Function<br><br> 下面函数创建ＦＴＰ站点：<br>Function ASTCreateFtpSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computer, Start,LogFileDirectory)<br> Dim MSFTPSVC, FtpServer, NewFtpServer, NewDir<br> Dim Bindings, BindingString, NewBindings, Index, SiteObj, bDone<br> On Error Resume Next<br> Err.Clear<br> Set MSFTPSVC = GetObject("IIS://" & Computer & "/MSFTPSVC")<br> If Err.Number <> 0 Then<br> WScript.Echo "无法打开: "&"IIS://" & Computer & "/MSFTPSVC" & VbCrlf & "程序将退出."<br> WScript.Quit (1)<br> End If<br><br> BindingString = IpAddress & ":" & PortNum & ":" & HostName<br> For Each FtpServer in MSFTPSVC<br> If FtpServer.Class="IIsFtpServer" Then<br> Bindings = FtpServer.ServerBindings<br> If BindingString = Bindings(0) Then<br> WScript.Echo "IP地址冲突:" & IpAddress & ",请检测IP地址！." & VbCrlf & "取消创建本站点。"<br> Exit Function<br> End If<br> End If<br> Next<br><br> Index = 1<br> bDone = False<br><br> While (Not bDone)<br> Err.Clear<br> Set SiteObj = GetObject("IIS://"&Computer&"/MSFTPSVC/" & Index)<br> If (Err.Number = 0) Then<br> Index = Index + 1<br> Else<br> Err.Clear<br> Set NewFtpServer = MSFTPSVC.Create("IIsFtpServer", Index)<br> If (Err.Number <> 0) Then<br> Index = Index + 1<br> Else<br> Err.Clear<br> Set SiteObj = GetObject("IIS://"&Computer&"/MSFTPSVC/" & Index)<br> If (Err.Number = 0) Then<br> bDone = True<br> Else<br> Index = Index + 1<br> End If<br> End If<br> End If<br><br> If (Index > 10000) Then<br> WScript.Echo "看起来不能创建站点，正在创建的站点的序号为： "&Index&"." & VbCrlf & "取消创建本站点。"<br> Exit Function<br> End If<br> Wend<br><br> NewBindings = Array(0)<br> NewBindings(0) = BindingString<br> NewFtpServer.ServerBindings = NewBindings<br> NewFtpServer.ServerComment = ServerComment<br> NewFtpServer.AllowAnonymous = False<br> NewFtpServer.AccessWrite = True<br> NewFtpServer.AccessRead = True<br> NewFtpServer.DontLog = False<br> NewFtpServer.LogFileDirectory = LogFileDirectory<br> NewFtpServer.SetInfo<br><br> Set NewDir = NewFtpServer.Create("IIsFtpVirtualDir", "ROOT")<br> NewDir.Path = RootDirectory<br> NewDir.AccessRead = true<br> Err.Clear<br> NewDir.SetInfo<br> If (Err.Number = 0) Then<br> Else<br> WScript.Echo "主目录创建时出错."<br> End If<br> <br> If Start = True Then<br> Err.Clear<br> Set NewFtpServer = GetObject("IIS://" & Computer & "/MSFTPSVC/" & Index)<br> NewFtpServer.Start<br> If Err.Number <> 0 Then<br> WScript.Echo "启动站点时出错!"<br> Err.Clear<br> Else<br> End If<br> End If <br> ASTCreateFtpSite = Index<br>End Function<br></TD></TR></TABLE>
[此贴子已经被作者于2006-4-11 18:11:15编辑过]
:lol 支持。。收藏个
楼主你太有才了......
楼主你太有才了......http://www.domain.cn/club/images/default/sigline.gif
古之立大事者，不惟有超世之才，亦必有坚忍不拔之志。---魔兽剑圣异界纵横
小游戏 极品家丁 龙蛇演义 恶魔法则 飞升之后 异界枪神 凡人修仙传 魔兽领主 超级农民 成人小游戏 极品公子
页:
[1]