用delphi编程创建nt账户(100分)

  • 主题发起人 主题发起人 OnlyD4
  • 开始时间 开始时间
O

OnlyD4

Unregistered / Unconfirmed
GUEST, unregistred user!
如何利用
1).创建用户、目录和站点
2).创建邮箱
3).配置目录权限....
我主要希望用asp+delphi automation实现用户信箱和个人网页的自动创建
另外一个问题是:nt里如何限制用户的目录使用的磁盘空间?
 
利用ADSI接口:
ADSI Section
ADSI abstracts the capabilities of directory services from different network providers to present a single set of directory service interfaces for accessing and managing network resources. Administrators and developers can use ADSI services to enumerate and manage resources in a directory service, no matter which network environment contains the resource. This can be an LDAP-based, NDS-based, or NTDS-based directory.
参见: http://www.15seconds.com/focus/ADSI.htm
 
有点控件,不知可否,如欲得之,来信索取
 
我有用vb6.0添加用户、目录和站点.
有用wsh(windows script host)创建邮箱.
要可给你.
 
CJCJC@ONLINE.SH.CN
 
wsh也是可以的:
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 "创建目录" &amp;
tmpFolder &amp;
"失败!"
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://" &amp;
Computer &amp;
"/w3svc")
If Err.Number <> 0 then
WScript.Echo "无法打开: "&amp;"IIS://" &amp;
Computer &amp;
"/w3svc" &amp;
VbCrlf &amp;
"程序将退出."
WScript.Quit (1)
End If
BindingString = IpAddress &amp;
":" &amp;
PortNum &amp;
":" &amp;
HostName
For Each WebServer in w3svc
If WebServer.Class = "IIsWebServer" then
Bindings = WebServer.ServerBindings
If BindingString = Bindings(0) then
WScript.Echo "IP地址冲突:" &amp;
IpAddress &amp;
",请检测IP地址!." &amp;
VbCrlf &amp;
"取消创建本站点。"
Exit Function
End If
End If
Next
Index = 1
bDone = False
While (Not bDone)
Err.Clear
Set SiteObj = GetObject("IIS://"&amp;Computer&amp;"/w3svc/" &amp;
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://"&amp;Computer&amp;"/w3svc/" &amp;
Index)
If (Err.Number = 0) then
bDone = True
else
Index = Index + 1
End If
End If
End If
If (Index > 10000) then
WScript.Echo "看起来不能创建站点,正在创建的站点的序号为: "&amp;Index&amp;"." &amp;
VbCrlf &amp;
"取消创建本站点。"
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 = "应用程序" &amp;
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://" &amp;
Computer &amp;
"/w3svc/" &amp;
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://" &amp;
Computer &amp;
"/MSFTPSVC")
If Err.Number <> 0 then
WScript.Echo "无法打开: "&amp;"IIS://" &amp;
Computer &amp;
"/MSFTPSVC" &amp;
VbCrlf &amp;
"程序将退出."
WScript.Quit (1)
End If
BindingString = IpAddress &amp;
":" &amp;
PortNum &amp;
":" &amp;
HostName
For Each FtpServer in MSFTPSVC
If FtpServer.Class="IIsFtpServer" then
Bindings = FtpServer.ServerBindings
If BindingString = Bindings(0) then
WScript.Echo "IP地址冲突:" &amp;
IpAddress &amp;
",请检测IP地址!." &amp;
VbCrlf &amp;
"取消创建本站点。"
Exit Function
End If
End If
Next
Index = 1
bDone = False
While (Not bDone)
Err.Clear
Set SiteObj = GetObject("IIS://"&amp;Computer&amp;"/MSFTPSVC/" &amp;
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://"&amp;Computer&amp;"/MSFTPSVC/" &amp;
Index)
If (Err.Number = 0) then
bDone = True
else
Index = Index + 1
End If
End If
End If
If (Index > 10000) then
WScript.Echo "看起来不能创建站点,正在创建的站点的序号为: "&amp;Index&amp;"." &amp;
VbCrlf &amp;
"取消创建本站点。"
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://" &amp;
Computer &amp;
"/MSFTPSVC/" &amp;
Index)
NewFtpServer.Start
If Err.Number <> 0 then
WScript.Echo "启动站点时出错!"
Err.Clear
else
End If
End If
ASTCreateFtpSite = Index
End Function
 
多人接受答案了。
 
后退
顶部