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

大鸟，飞起来 · 发表于 2006-4-12 02:10:31

<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> </TD></TR></TABLE> 本讲将使用到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 下面函数创建ＦＴＰ站点： 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 </TD></TR></TABLE>

[此贴子已经被作者于2006-4-11 18:11:15编辑过]

click19012 · 发表于 2007-9-29 09:34:39

支持。。收藏个

香耐儿 · 发表于 2009-4-10 09:29:09

楼主你太有才了......

古之立大事者，不惟有超世之才，亦必有坚忍不拔之志。---魔兽剑圣异界纵横
小游戏极品家丁龙蛇演义恶魔法则飞升之后异界枪神凡人修仙传魔兽领主超级农民成人小游戏极品公子

账号		自动登录	找回密码
密码			入学