100分求助，局域网域用户批量创建，有程序，有问题求助

mohaixin 2009-04-20 11:35:39

最近用VB搞了个小软件，是局域网中可视化批量创建域用户及权限，现在出现了点问题，我在windows 2000可以顺利创建，但是在2003就创建不到了，找不到原因，估计是哪里调用WIDOWS函数错误或者权限问题，希望各位大虾帮助一下小弟，不胜感激。只要能在2003运行到就好了。

软件运行前先配置活动目录，然后新建一个admin和teacher组，
在D盘存放一个TXT文件 D:\add_user\usertest.txt
在C盘新建一个test文件夹 c:\test

启动VB，创建标准EXE

界面插不到图片，郁闷，大概是一下这样子吧，希望大虾们能开懂
－－－－－－－－－－－－－－－－－－－－－－－－－－
－－
－－－－－－－－－－－－
－选择名单（.txt文档）－－－
－－－－－－－－－－－ -
－－
－ .................... －
－选择存放路径 . . －
－ .................... －
－－
－－
－ ..................... -
－共享名 . . -
－ ..................... -
－－
－ ---------------- －
- - 开始创建 - （这个是按钮，程序就在这按钮）－
－ ---------------- －
－－－－－－－－－－－－－－－－－－－－－－－－－－
声明Windows API函数：将下面的代码放入到通用声明里面。
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib _
"IMAGEHLP.DLL" (ByVal DirPath As String) As Long
//创建一个新文件夹，可以利用一个很少有人知道的API：MakeSureDirectoryPathExists。它有一个路径名作为参数，顾名思义，这个API检查参数中的所有的目录是否都存在，如果不存在就创建它们

//5.2.2判断文件夹路径函数
Private Function CreatePath(NewPath) As Boolean
Dim sPath As String
sPath = NewPath & IIf(Right$(NewPath, 1) = "\", "", "\")
//判断路径末端是否有加“\”，没有则加上
If MakeSureDirectoryPathExists(sPath) <> 0 Then ＇调用API函数
CreatePath = True ＇若没错，则返回True
End If
End Function
//5.2.3创建文件夹函数
Public Function MakeFolder(ByVal pathToCreate As String) _
As Boolean
Dim sSomePath As String
Dim bAns As Boolean
sSomePath = pathToCreate
If CreatePath(sSomePath) = True Then //调用CreatePath函数
bAns = True
Else
bAns = False
End If
MakeFolder = bAns
End Function

//5.2.4添加用户函数
Public Function AddUser(UserName As String, Password As _
String, Optional GroupName = "Domain Users", _
Optional FullName As String) As Boolean
Dim oContainer As IADsContainer
//接口类型变量，用来保存返回的接口变量
//利用包容器对象的IADsContainer接口的方法,可以很方便地增加或者删除目录对象
Dim oUser As IADsUser
Dim oGroup As IADsGroup
Dim oSysInfo As New WinNTSystemInfo
//用WinNTSystemInfo取得目前登入使用者的详細资料
Dim oRoot As IADs
Dim oDomain As IADsDomain
Dim sDomain As String

On Error GoTo ErrHandler
//为新用户创建帐户
sDomain = oSysInfo.DomainName
Set oContainer = GetObject("WinNT://" & sDomain)
Set oUser = oContainer.Create("User", UserName)

If FullName <> "" Then oUser.FullName = FullName
oUser.SetInfo
oUser.SetPassword Password

Set oGroup = GetObject("WinNT://" & sDomain & "/" & GroupName)
oGroup.Add "WinNT://" & sDomain & "/" & UserName
oGroup.SetInfo
AddUser = True

ErrHandler:
Set oContainer = Nothing
Set oUser = Nothing
Set oGroup = Nothing
End Function

//5.2.5 主函数
Private Sub Command1_Click()
Dim x As Boolean
Dim fnum As Integer
Dim i As Integer
Dim value As String
Dim l As Boolean
Dim b As Boolean
Dim s As String
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim s4 As String
s = Text1.Text
s1 = Text2.Text
s4 = Text3.Text
s2 = "echo y|cacls " & Text1.Text & " /g administrators:f admin:r everyone:r" & Chr$(13) + Chr$(10) & "@exit"
//[administrators:]f表示完全控制，r表示只读
Open "folder.bat" For Output As #1
//创建一个批文件,因为 vb的shell函数不支持dos的内部内函数(echo)
Print #1, s2
Close #1
b = MakeFolder(s) ＇调用MakeFolder函数创建文件夹
Shell ("net share " + (s1) + "=" + (s) + " /USERS:100")
//调用Win API函数”net share”设置文件夹共享
Shell "folder.bat", vbHide
//运行批文件，设置文件夹的权限
//打开存放有所有用户名的txt文件，各用户名独自一行
On Error GoTo LoadError
fnum = FreeFile
Open s4 For Input As fnum
//用循环独行创建用户及其权限文件夹,以txt文件中各行用户名命名用户及其文件夹
Do While Not EOF(1)
Input #fnum, value
x = AddUser(value, "")
l = MakeFolder(s & "\" & value)
s3 = "echo y|cacls " & s & "\" & value & " /g administrators:f admin:r " & value & ":f" & Chr$(13) + Chr$(10) & "@exit"
Open "students.bat" For Output As #3
Print #3, s3
Close #3
Shell "students.bat", vbHide
Loop
' Close the file.
Close fnum
Exit Sub

LoadError:
MsgBox "Error" & Str$(Err.Number) & _
" loading data." & vbCrLf & _
Err.Description
End Sub

...全文