ReDim pSid(0)
ReDim pDomain(0)
lSID = 0
lDomain = 0
sSystem = "\\" & sServer
sAccount = sDomain & "\" & sUserID
rc = LookupAccountName(sSystem, sAccount, pSid(0), lSID, pDomain(0), lDomain, SidTypeUser)
If (rc = 0) Then
ReDim pSid(lSID)
ReDim pDomain(lDomain + 1)
rc = LookupAccountName(sSystem, sAccount, pSid(0), lSID, pDomain(0), lDomain, SidTypeUser)
If (rc = 0) Then
GoTo SIDError
End If
End If
GetSID = 1
Exit Function
SIDError:
GetSID = 0
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Get_Primary_DCName -- gets the name of the Primary Domain Controller for
'' the NT domain
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Get_Primary_DCName(ByVal MName As String, ByVal DName As String) As String
Dim Result As Long
Dim DCName As String
Dim DCNPtr As Long
Dim DNArray() As Byte
Dim MNArray() As Byte
Dim DCNArray(100) As Byte
MNArray = MName & vbNullChar
DNArray = DName & vbNullChar
Result = NetGetDCName(MNArray(0), DNArray(0), DCNPtr)
If Result <> 0 Then
Exit Function
End If
Result = PtrToStr(DCNArray(0), DCNPtr)
Result = NetApiBufferFree(DCNPtr)
DCName = DCNArray()
Get_Primary_DCName = DCName
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Get_Exchange_Sid -- gets the NT user's Security IDentifier for Exchange
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Get_Exchange_Sid(strNTDomain As String, strNTAccount As String, rbSID() As Byte)
Dim pSid(512) As Byte
Dim pDomain(512) As Byte
Dim IReturn As Long
Dim I As Integer
Dim NtDomain As String
NtDomain = strNTDomain
IReturn = LookupAccountName(Get_Primary_DCName("", NtDomain), strNTAccount, pSid(0), 512, pDomain, 512, 1)
For I = 0 To GetLengthSid(pSid(0)) - 1
rbSID(2 * I) = AscB(Hex$(pSid(I) \ &H10))
rbSID(2 * I + 1) = AscB(Hex$(pSid(I) Mod &H10))
Next I
End Sub
5.将下列代码粘贴到NTUserManager类模块,注意修改默认属性
'类名:NTUserManager
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' DECLARE VARIABLES
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private MyScriptingContext As ScriptingContext
Private MyRequest As Request
Private MyResponse As Response
Private MyServer As Server
Dim txtDomain As String, txtAdmin As String
Dim txtPassword As String, txtUserName As String
Dim txtFirstName As String, txtLastName As String
Dim txtNTServer As String
Dim txtEMailAddress As String, txtExchServer As String
Dim txtExchSite As String, txtExchOrganization As String
Dim txtPwd As String, txtRealName As String
Dim bIsOk As Boolean
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' OnStartPage
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)
Set MyScriptingContext = PassedScriptingContext
Set MyRequest = MyScriptingContext.Request
Set MyResponse = MyScriptingContext.Response
Set MyServer = MyScriptingContext.Server
End Sub
Public Sub GetUserInfo()
'~~~~~~~~~~~~~~~~~~ ERROR CODE ~~~~~~~~~~~~~~~~
' On Error GoTo ErrorCode
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
txtUserName = MyRequest.Form("UID")
txtPwd = MyRequest.Form("PWD")
txtRealName = MyRequest.Form("Name")
End Sub
Public Sub DeleteUser()
Call Delete_Exchange_Mailbox(False, txtDomain, txtAdmin, _
txtPassword, txtUserName, txtExchServer, _
txtExchSite, txtExchOrganization)
Call Delete_NT_Account(txtDomain, txtAdmin, txtPassword, txtUserName)
End Sub
Public Sub CreateUser()
bIsOk = Create_NT_Account(txtDomain, txtAdmin, txtPassword, _
txtUserName, txtFirstName & txtLastName, _
txtNTServer, txtPwd, txtRealName)
If Not bIsOk Then Exit Sub
bIsOk = Create_Exchange_MailBox(False, txtNTServer, txtDomain, txtAdmin, _
txtPassword, txtUserName, txtEMailAddress, _
txtFirstName, txtLastName, txtExchServer, _
txtExchSite, txtExchOrganization, txtPwd, txtRealName)
If Not bIsOk Then Exit Sub
End Sub
Public Property Let Domain(ByVal vNewValue As Variant)
txtDomain = vNewValue
End Property
Public Property Let Admin(ByVal vNewValue As Variant)
txtAdmin = vNewValue
End Property
Public Property Let Password(ByVal vNewValue As Variant)
txtPassword = vNewValue
End Property
Public Property Let NTServer(ByVal vNewValue As Variant)
txtNTServer = vNewValue
End Property
Public Property Let EmailAddress(ByVal vNewValue As Variant)
txtEMailAddress = vNewValue
End Property
Public Property Let ExchServer(ByVal vNewValue As Variant)
txtExchServer = vNewValue
End Property
Public Property Let ExchSite(ByVal vNewValue As Variant)
txtExchSite = vNewValue
End Property
Public Property Let ExchOrganization(ByVal vNewValue As Variant)
txtExchOrganization = vNewValue
End Property
Private Sub Class_Initialize()
txtDomain = "XX" '此处该为主域名
txtAdmin = "administrator" '超级管理员帐号
txtPassword = "" '超级管理员密码
txtNTServer = "XXserver" '主域控制器主机名
txtEMailAddress = "@sina.net" '邮件服务器域名
txtExchServer = "XXserver" 'Exchange服务器的主机名
txtExchSite = "XX" 'Exchange站点名称
txtExchOrganization = "xxx" 'Exchange组织名称
bIsOk = True
End Sub
Public Property Get IsOK() As Variant
IsOK = bIsOk
End Property
Public Sub ChangePwd(ByVal UID As String, ByVal oPwd As String, ByVal nPwd As String)
Dim o As IADsOpenDSObject
Dim usr As IADsUser
On Error GoTo ErrMsg
Set o = GetObject("WinNT:")
Set usr = o.OpenDSObject("WinNT://" & txtDomain & "/" & UID, UID, oPwd, 1)
usr.ChangePassword oPwd, nPwd
bIsOk = True
Exit Sub
ErrMsg:
bIsOk = False
End Sub
Public Sub ResetPwd(ByVal UID As String, ByVal nPwd As String)
Dim o As IADsOpenDSObject
Dim usr As IADsUser
On Error GoTo ErrMsg
Set o = GetObject("WinNT:")
Set usr = o.OpenDSObject("WinNT://" & txtDomain & "/" & UID & ",user", txtAdmin, txtPassword, 1)
usr.SetPassword nPwd
bIsOk = True
Exit Sub
ErrMsg:
bIsOk = False
End Sub
Public Sub Login(ByVal UID As String, ByVal Pwd As String)
Dim o As IADsOpenDSObject
Dim usr As IADsUser
Dim nPwd As String
On Error GoTo ErrMsg
Set o = GetObject("WinNT:")
Set usr = o.OpenDSObject("WinNT://" & txtDomain & "/" & UID & ",user", txtAdmin, txtPassword, 1)
nPwd = Pwd & "X"
usr.ChangePassword Pwd, nPwd
usr.SetPassword Pwd
bIsOk = True
Exit Sub
ErrMsg:
bIsOk = False
End Sub
6.编译工程
7.注册RbsBoxGen.dll或在Mts中注册
注:本单位主域控制器与Exchange服务器及WEB服务器为同一机器.
附:ASB示例
1申请邮箱
a>申请页面:UserAdd.htm
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title>New Page 1</title>
<meta name="Microsoft Theme" content="mstheme1530 1111, default">
</head>
<body>
<form method="POST" action="UserAdd.asp" onsubmit="return FrontPage_Form1_Validator(this)" name="FrontPage_Form1">
<p>帐号<input type="text" name="UID" size="20"></p>
<p>密码<input type="text" name="PWD" size="20"></p>
<p>姓名<input type="text" name="Name" size="20"&上一页 [1] [2] [3] [4] [5] 下一页
|
评论
收藏
分享
打印
