分享
 
 
 

基于ADSI的NT帐号及Exchange Server帐号申请及验证模块源代码

王朝other·作者佚名  2008-05-30
窄屏简体版  字體: |||超大  

1.安装ADSI2.5

2.创建一个新的ActiveX DLL工程,工程名:RbsBoxGen,类名:NTUserManager

3.执行工程-引用将下列库选上:

Active DS Type Library

Microsoft Active Server Pages Object Library

4.添加一个模块,代码如下:

'模块

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''

'' ADSI Sample to create and delete Exchange 5.5 Mailboxes

''

'' Richard Ault, Jean-Philippe Balivet, Neil Wemple -- 1998

''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

' Mailbox property settings

Public Const LOGON_CMD = "logon.cmd"

Public Const INCOMING_MESSAGE_LIMIT = 1000

Public Const OUTGOING_MESSAGE_LIMIT = 1000

Public Const WARNING_STORAGE_LIMIT = 8000

Public Const SEND_STORAGE_LIMIT = 12000

Public Const REPLICATION_SENSITIVITY = 20

Public Const COUNTRY = "US"

' Mailbox rights for Exchange security descriptor (home made)

Public Const RIGHT_MODIFY_USER_ATTRIBUTES = %26amp;H2

Public Const RIGHT_MODIFY_ADMIN_ATTRIBUTES = %26amp;H4

Public Const RIGHT_SEND_AS = %26amp;H8

Public Const RIGHT_MAILBOX_OWNER = %26amp;H10

Public Const RIGHT_MODIFY_PERMISSIONS = %26amp;H80

Public Const RIGHT_SEARCH = %26amp;H100

' win32 constants for security descriptors (from VB5 API viewer)

Public Const ACL_REVISION = (2)

Public Const SECURITY_DESCRIPTOR_REVISION = (1)

Public Const SidTypeUser = 1

Type ACL

AclRevision As Byte

Sbz1 As Byte

AclSize As Integer

AceCount As Integer

Sbz2 As Integer

End Type

Type ACE_HEADER

AceType As Byte

AceFlags As Byte

AceSize As Long

End Type

Type ACCESS_ALLOWED_ACE

Header As ACE_HEADER

Mask As Long

SidStart As Long

End Type

Type SECURITY_DESCRIPTOR

Revision As Byte

Sbz1 As Byte

Control As Long

Owner As Long

Group As Long

Sacl As ACL

Dacl As ACL

End Type

' Just an help to allocate the 2dim dynamic array

Private Type mySID

x() As Byte

End Type

' Declares : modified from VB5 API viewer

Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" _

(pSecurityDescriptor As SECURITY_DESCRIPTOR, _

ByVal dwRevision As Long) As Long

Declare Function SetSecurityDescriptorOwner Lib "advapi32.dll" _

(pSecurityDescriptor As SECURITY_DESCRIPTOR, _

pOwner As Byte, _

ByVal bOwnerDefaulted As Long) As Long

Declare Function SetSecurityDescriptorGroup Lib "advapi32.dll" _

(pSecurityDescriptor As SECURITY_DESCRIPTOR, _

pGroup As Byte, _

ByVal bGroupDefaulted As Long) As Long

Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" _

(pSecurityDescriptor As SECURITY_DESCRIPTOR, _

ByVal bDaclPresent As Long, _

pDacl As Byte, _

ByVal bDaclDefaulted As Long) As Long

Declare Function SetSecurityDescriptorSacl Lib "advapi32.dll" _

(pSecurityDescriptor As SECURITY_DESCRIPTOR, _

ByVal bSaclPresent As Long, _

pSacl As Byte, _

ByVal bSaclDefaulted As Long) As Long

Declare Function MakeSelfRelativeSD Lib "advapi32.dll" _

(pAbsoluteSecurityDescriptor As SECURITY_DESCRIPTOR, _

pSelfRelativeSecurityDescriptor As Byte, _

ByRef lpdwBufferLength As Long) As Long

Declare Function GetSecurityDescriptorLength Lib "advapi32.dll" _

(pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long

Declare Function IsValidSecurityDescriptor Lib "advapi32.dll" _

(pSecurityDescriptor As Byte) As Long

Declare Function InitializeAcl Lib "advapi32.dll" _

(pACL As Byte, _

ByVal nAclLength As Long, _

ByVal dwAclRevision As Long) As Long

Declare Function AddAccessAllowedAce Lib "advapi32.dll" _

(pACL As Byte, _

ByVal dwAceRevision As Long, _

ByVal AccessMask As Long, _

pSid As Byte) As Long

Declare Function IsValidAcl Lib "advapi32.dll" _

(pACL As Byte) As Long

Declare Function GetLastError Lib "kernel32" _

() As Long

Declare Function LookupAccountName Lib "advapi32.dll" _

Alias "LookupAccountNameA" _

(ByVal IpSystemName As String, _

ByVal IpAccountName As String, _

pSid As Byte, _

cbSid As Long, _

ByVal ReferencedDomainName As String, _

cbReferencedDomainName As Long, _

peUse As Integer) As Long

Declare Function NetGetDCName Lib "NETAPI32.DLL" _

(ServerName As Byte, _

DomainName As Byte, _

DCNPtr As Long) As Long

Declare Function NetApiBufferFree Lib "NETAPI32.DLL" _

(ByVal Ptr As Long) As Long

Declare Function PtrToStr Lib "kernel32" _

Alias "lstrcpyW" (RetVal As Byte, ByVal Ptr As Long) As Long

Declare Function GetLengthSid Lib "advapi32.dll" _

(pSid As Byte) As Long

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''

'' Create_NT_Account() -- creates an NT user account

''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function Create_NT_Account(strDomain As String, _

strAdmin As String, _

strPassword As String, _

UserName As String, _

FullName As String, _

NTServer As String, _

strPwd As String, _

strRealName As String) As Boolean

Dim oNS As IADsOpenDSObject

Dim User As IADsUser

Dim Domain As IADsDomain

On Error GoTo Create_NT_Account_Error

Create_NT_Account = False

If (strPassword = "") Then

strPassword = ""

End If

Set oNS = GetObject("WinNT:")

Set Domain = oNS.OpenDSObject("WinNT://" %26amp; strDomain, strDomain %26amp; "\" %26amp; strAdmin, strPassword, 0)

Set User = Domain.Create("User", UserName)

With User

.Description = "ADSI 创建的用户"

.FullName = strRealName 'FullName

'.HomeDirectory = "\\" %26amp; NTServer %26amp; "\" %26amp; UserName

'.LoginScript = LOGON_CMD

.SetInfo

' First password = username

.SetPassword strPwd

End With

Debug.Print "Successfully created NT Account for user " %26amp; UserName

Create_NT_Account = True

Exit Function

Create_NT_Account_Error:

Create_NT_Account = False

Debug.Print "Error 0x" %26amp; CStr(Hex(Err.Number)) %26amp; " occurred creating NT account for user " %26amp; UserName

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''

'' Delete_NT_Account() -- deletes an NT user account

''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function Delete_NT_Account(strDomain As String, _

strAdmin As String, _

strPassword As String, _

UserName As String _

) As Boolean

Dim Domain As IADsDomain

Dim oNS As IADsOpenDSObject

On Error GoTo Delete_NT_Account_Error

Delete_NT_Account = False

If (strPassword = "") Then

strPassword = ""

End If

Set oNS = GetObject("WinNT:")

Set Domain = oNS.OpenDSObject("WinNT://" %26amp; strDomain, strDomain %26amp; "\" %26amp; strAdmin, strPassword, 0)

Domain.Delete "User", UserName

Debug.Print "Successfully deleted NT Account for user " %26amp; UserName

Delete_NT_Account = True

Exit Function

Delete_NT_Account_Error:

Debug.Print "Error 0x" %26amp; CStr(Hex(Err.Number)) %26amp; " occurred deleting NT account for user " %26amp; UserName

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''

'' Create_Exchange_Mailbox() -- creates an Exchange mailbox, sets mailbox

'' properties and and associates the mailbox with

'' an existing NT user account

''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function Create_Exchange_MailBox( _

IsRemote As Boolean, _

strServer As String, _

strDomain As String, _

strAdmin As String, _

strPassword As String, _

UserName As String, _

EmailAddress As String, _

strFirstName As String, _

strLastName As String, _

ExchangeServer As String, _

ExchangeSite As String, _

ExchangeOrganization As String, _

strPwd As String, _

strRealName As String) As Boolean

Dim Container As IADsContainer

Dim strRecipContainer As String

Dim Mailbox As IADs

Dim rbSID(1024) As Byte

Dim OtherMailBox() As Variant

Dim sSelfSD() As Byte

Dim encodedSD() As Byte

Dim I As Integer

Dim oNS As IADsOpenDSObject

On Error GoTo Create_Exchange_MailBox_Error

Create_Exchange_MailBox = False

If (strPassword = "") Then

strPassword = ""

End If

' Recipients container for this server

strRecipContainer = "LDAP://" %26amp; ExchangeServer %26amp; _

"/CN=Recipients,OU=" %26amp; ExchangeSite %26amp; _

",O=" %26amp; ExchangeOrganization

Set oNS = GetObject("LDAP:")

Set Container = oNS.OpenDSObject(strRecipContainer, "cn=" %26amp; strAdmin %26amp; ",dc=" %26amp; strDomain, strPassword, 0)

' This creates both mailboxes or remote dir entries

If IsRemote Then

Set Mailbox = Container.Create("Remote-Address", "CN=" %26amp; UserName)

Mailbox.Put "Target-Address", EmailAddress

Else

Set Mailbox = Container.Create("OrganizationalPerson", "CN=" %26amp; UserName) '

Mailbox.Put "MailPreferenceOption", 0

End If

With Mailbox

.SetInfo

' As an example two other addresses

ReDim OtherMailBox(1)

OtherMailBox(0) = "MS$" %26amp; ExchangeOrganization %26amp; _

"/" %26amp; ExchangeSite %26amp; _

"/" %26amp; UserName

OtherMailBox(1) = "CCMAIL$" %26amp; UserName %26amp; _

" at " %26amp; ExchangeSite

If Not (IsRemote) Then

' Get the SID of the previously created NT user

Get_Exchange_Sid strDomain, UserName, rbSID

.Put "Assoc-NT-Account", rbSID

' This line also initialize the "Home Server" parameter of the Exchange admin

.Put "Home-MTA", "cn=Microsoft MTA,cn=" %26amp; ExchangeServer %26amp; ",cn=Servers,cn=Configuration,ou=" %26amp; ExchangeSite %26amp; ", o = " %26amp; ExchangeOrganization

.Put "Home-MDB", "cn=Microsoft Private MDB,cn=" %26amp; ExchangeServer %26amp; ",cn=Servers,cn=Configuration,ou=" %26amp; ExchangeSite %26amp; ",o=" %26amp; ExchangeOrganization

.Put "Submission-Cont-Length", OUTGOING_MESSAGE_LIMIT

.Put "MDB-Use-Defaults", False

.Put "MDB-Storage-Quota", WARNING_STORAGE_LIMIT

.Put "MDB-Over-Quota-Limit", SEND_STORAGE_LIMIT

.Put "MAPI-Recipient", True

' Security descriptor

' The rights choosen make a normal user role

' The other user is optionnal, delegate for ex.

Call MakeSelfSD(sSelfSD, _

strServer, _

strDomain, _

UserName, _

UserName, _

RIGHT_MAILBOX_OWNER + RIGHT_SEND_AS + _

RIGHT_MODIFY_USER_ATTRIBUTES _

)

ReDim encodedSD(2 * UBound(sSelfSD) + 1)

For I = 0 To UBound(sSelfSD) - 1

encodedSD(2 * I) = AscB(Hex$(sSelfSD(I) \ %26amp;H10))

encodedSD(2 * I + 1) = AscB(Hex$(sSelfSD(I) Mod %26amp;H10))

Next I

.Put "NT-Security-Descriptor", encodedSD

Else

ReDim Preserve OtherMailBox(2)

OtherMailBox(2) = EmailAddress

.Put "MAPI-Recipient", False

End If

' Usng PutEx for array properties

.PutEx ADS_PROPERTY_UPDATE, "otherMailBox", OtherMailBox

.Put "Deliv-Cont-Length", INCOMING_MESSAGE_LIMIT

' i : initials

.Put "TextEncodedORaddress", "c=" %26amp; COUNTRY %26amp; _

";a= " %26amp; _

";p=" %26amp; ExchangeOrganization %26amp; _

";o=" %26amp; ExchangeSite %26amp; _

";s=" %26amp; strLastName %26amp; _

";g=" %26amp; strFirstName %26amp; _

";i=" %26amp; Mid(strFirstName, 1, 1) %26amp; Mid(strLastName, 1, 1) %26amp; ";"

.Put "rfc822MailBox", UserName %26amp; "@" %26amp; ExchangeSite %26amp; "." %26amp; ExchangeOrganization %26amp; ".com"

.Put "Replication-Sensitivity", REPLICATION_SENSITIVITY

.Put "uid", UserName

.Put "name", UserName

' .Put "GivenName", strFirstName

' .Put "Sn", strLastName

.Put "Cn", strRealName 'strFirstName %26amp; " " %26amp; UserName 'strLastName

' .Put "Initials", Mid(strFirstName, 1, 1) %26amp; Mid(strLastName, 1, 1)

' Any of these fields are simply descriptive and optional, not included in

' this sample and there are many other fields in the mailbox

.Put "Mail", EmailAddress

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

'If 0

.SetInfo

End With

Debug.Print "Successfully created mailbox for user " %26amp; UserName

Create_Exchange_MailBox = True

Exit Function

Create_Exchange_MailBox_Error:

Create_Exchange_MailBox = False

Debug.Print "Error 0x" %26amp; CStr(Hex(Err.Number)) %26amp; " occurred creating Mailbox for user " %26amp; UserName

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''

'' Delete_Exchange_Mailbox() -- deletes an Exchange mailbox

''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function Delete_Exchange_Mailbox( _

IsRemote As Boolean, _

strDomain As String, _

strAdmin As String, _

strPassword As String, _

UserName As String, _

ExchangeServer As String, _

ExchangeSite As String, _

ExchangeOrganization As String _

) As Boolean

Dim strRecipContainer As String

Dim Container As IADsContainer

Dim oNS As IADsOpenDSObject

If (strPassword = "") Then

strPassword = ""

End If

On Error GoTo Delete_Exchange_MailBox_Error

Delete_Exchange_Mailbox = False

' Recipients container for this server

strRecipContainer = "LDAP://" %26amp; ExchangeServer %26amp; _

"/CN=Recipients,OU=" %26amp; ExchangeSite %26amp; _

",O=" %26amp; ExchangeOrganization

Set oNS = GetObject("LDAP:")

Set Container = oNS.OpenDSObject(strRecipContainer, "cn=" %26amp; strAdmin %26amp; ",dc=" %26amp; strDomain, strPassword, 0)

If Not (IsRemote) Then

Container.Delete "OrganizationalPerson", "CN=" %26amp; UserName

Else

Container.Delete "Remote-Address", "CN=" %26amp; UserName

End If

Container.SetInfo

Debug.Print "Successfully deleted mailbox for user " %26amp; UserName

Delete_Exchange_Mailbox = True

Exit Function

Delete_Exchange_MailBox_Error:

Debug.Print "Error 0x" %26amp; CStr(Hex(Err.Number)) %26amp; " occurred deleting Mailbox for user " %26amp; UserName

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''

'' MakeSelfSD -- builds a self-relative Security Descriptor suitable for ADSI

''

'' Return code : 1 = OK

'' 0 = error

'' In sSelfSD dynamic byte array, size 0

'' sServer DC for the domain

'' sDomain Domain name

'' sAssocUser Primary NT account for the mail box (SD owner)

'' paramarray Authorized accounts

'' This is an array of (userid, role, userid, role...)

'' where role is a combination of rights (cf RIGHTxxx constants)

'' Out sSelfSD Self relative SD allocated and initalized

''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function MakeSelfSD(sSelfSD() As Byte, _

sServer As String, sDomain As String, _

sAssocUSer As String, _

ParamArray ACEList() As Variant) As Long

Dim SecDesc As SECURITY_DESCRIPTOR

Dim I As Integer

Dim tACL As ACL

Dim tACCESS_ALLOWED_ACE As ACCESS_ALLOWED_ACE

Dim pSid() As Byte

Dim pACL() As Byte

Dim pACESID() As mySID

Dim Longueur As Long

Dim rc As Long

On Error GoTo SDError

' Initializing abolute SD

rc = InitializeSecurityDescriptor(SecDesc, SECURITY_DESCRIPTOR_REVISION)

If (rc 1) Then

Err.Raise -12, , "InitializeSecurityDescriptor"

End If

rc = GetSID(sServer, sDomain, sAssocUSer, pSid)

If (rc 1) Then

Err.Raise -12, , "GetSID"

End If

rc = SetSecurityDescriptorOwner(SecDesc, pSid(0), 0)

If (rc 1) Then

Err.Raise -12, , "SetSecurityDescriptorOwner"

End If

' I don't know why we had to do this one, but it works for us

rc = SetSecurityDescriptorGroup(SecDesc, pSid(0), 0)

If (rc 1) Then

Err.Raise -12, , "SetSecurityDescriptorGroup"

End If

' Getting SIDs for all the other users, and computing of total ACL length

' (famous formula from MSDN)

Longueur = Len(tACL)

ReDim Preserve pACESID((UBound(ACEList) - 1) / 2)

For I = 0 To UBound(pACESID)

If 1 GetSID(sServer, sDomain, CStr(ACEList(2 * I)), pACESID(I).x) Then Err.Raise -12, , "GetSID"

Longueur = Longueur + GetLengthSid(pACESID(I).x(0)) + Len(tACCESS_ALLOWED_ACE) - 4

Next I

' Initalizing ACL, and adding one ACE for each user

ReDim pACL(Longueur)

If 1 InitializeAcl(pACL(0), Longueur, ACL_REVISION) Then Err.Raise -12, , "InitializeAcl"

For I = 0 To UBound(pACESID)

If 1 AddAccessAllowedAce(pACL(0), ACL_REVISION, CLng(ACEList(2 * I + 1)), pACESID(I).x(0)) Then Err.Raise -12, , "AddAccessAllowedAce"

Next I

If 1 SetSecurityDescriptorDacl(SecDesc, 1, pACL(0), 0) Then Err.Raise -12, , "SetSecurityDescriptorDacl"

' Allocation and conversion in the self relative SD

Longueur = GetSecurityDescriptorLength(SecDesc)

ReDim sSelfSD(Longueur)

If 1 MakeSelfRelativeSD(SecDesc, sSelfSD(0), Longueur) Then Err.Raise -12, , "MakeSelfRelativeSD"

MakeSelfSD = 1

Exit Function

SDError:

MakeSelfSD = 0

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''

'' GetSID -- gets the Security IDentifier for the specified account name

''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function GetSID(sServer As String, sDomain As String, sUserID As String, pSid() As Byte) As Long

Dim rc As Long

Dim pDomain() As Byte

Dim lSID As Long, lDomain As Long

Dim sSystem As String, sAccount As String

On Error GoTo SIDError

ReDim pSid(0)

ReDim pDomain(0)

lSID = 0

lDomain = 0

sSystem = "\\" %26amp; sServer

sAccount = sDomain %26amp; "\" %26amp; 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 %26amp; vbNullChar

DNArray = DName %26amp; 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) \ %26amp;H10))

rbSID(2 * I + 1) = AscB(Hex$(pSid(I) Mod %26amp;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 %26amp; 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://" %26amp; txtDomain %26amp; "/" %26amp; 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://" %26amp; txtDomain %26amp; "/" %26amp; UID %26amp; ",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://" %26amp; txtDomain %26amp; "/" %26amp; UID %26amp; ",user", txtAdmin, txtPassword, 1)

nPwd = Pwd %26amp; "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

New Page 1

帐号

密码

姓名

b响应文件UserAdd.asp

' Variables

dim rbox

set rbox = Server.CreateObject("RbsBoxGen.NTUserManager")

'以下如果已在DLL的初始化事件中设置正确则无须设置,可提高安全性

'rbox.Domain="yourdomain"

'rbox.Admin="administrator"

'rbox.password="XXXXXX"

'rbox.Ntserver="yonrntserver"

'rbox.EmailAddress="@Xxx.xxx"

'rbox.ExchServer="yourExchangeServerName"

'rbox.ExchSite="yourExchangeSiteName"

'rbox.ExchOrganization="yourExchangeOrganizationName"

rbox.getuserinfo

rbox.CreateUser

'rbox.DeleteUser

if rbox.isok then

set rbox = nothing

response.write "注册成功!"

else

set rbox = nothing

response.write "该用户名已被使用,请换一个名字再试!"

end if

%

2修改密码:

a.密码修改页面CHPWD.htm

New Page 1

旧 密 码:

新 密 码:

确认密码:

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有