ADSI-based NT account and Exchange Server account application and verification module source code

ADSI-based NT account and Exchange Server account application and verification module source code

1. Install ADSI2.52. Create a new ActiveX DLL project, engineering name: Rbsboxgen, Class Name: NTUserManager3. Execution Project - Quote Set the following library: Active DS Type Library Microsoft Active Server Pages Object Library 4. Add a module The code is as follows: 'Module' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ADSI Sample To Create And Delete Exchange 5.5 Mailboxes' '' 'Richard AULT, JEAN-Philippe Balivet, Neil Wem - 1998' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' Mailbox Property Settingspublic const LOGON_CMD = "logon.cmd" Public const INCOMING_MESSAGE_LIMIT = 1000Public const OUTGOING_MESSAGE_LIMIT = 1000Public const WARNING_STORAGE_LIMIT = 8000Public const SEND_STORAGE_LIMIT = 12000Public const REPLICATION_SENSITIVITY = 20Public const COUNTRY = "US" 'Mailbox rights for Exchange security descriptor (home made) Public const RIGHT_MODIFY_USER_ATTRIBUTES = & H2PUBLIC const Right_Modify_admin_attributes = & h4public const right_send_as = & h8public const right_mailbox_owner = &

H10Public Const RIGHT_MODIFY_PERMISSIONS = & H80Public Const RIGHT_SEARCH = & H100 'win32 constants for security descriptors (from VB5 API viewer) Public Const ACL_REVISION = (2) Public Const SECURITY_DESCRIPTOR_REVISION = (1) Public Const SidTypeUser = 1Type ACL AclRevision As Byte Sbz1 As Byte AclSize As Integer AceCount As Integer Sbz2 As IntegerEnd TypeType ACE_HEADER AceType As Byte AceFlags As Byte AceSize As LongEnd TypeType ACCESS_ALLOWED_ACE Header As ACE_HEADER Mask As Long SidStart As LongEnd TypeType SECURITY_DESCRIPTOR Revision As Byte Sbz1 As Byte Control As Long Owner As Long Group As Long Sacl As ACL Dacl As ACLEnd Type 'Just an help to allocate the 2dim dynamic arrayPrivate Type mySID x () As ByteEnd Type' Declares: modified from VB5 API viewerDeclare Function InitializeSecurityDescriptor Lib "advapi32.dll" _ (pSecurityDescriptor As SECURIT Y_DESCRIPTOR, _ ByVal dwRevision As Long) As LongDeclare Function SetSecurityDescriptorOwner Lib "advapi32.dll" _ (pSecurityDescriptor As SECURITY_DESCRIPTOR, _ pOwner As Byte, _ ByVal bOwnerDefaulted As Long) As LongDeclare Function SetSecurityDescriptorGroup Lib "advapi32.dll" _ (pSecurityDescriptor As SECURITY_DESCRIPTOR , _ Pgroup as byte, _ byval bGroupDefaulted as long) AS LongdeClare Function SetSecurityDescriptOracl lib "advapi32.dll"

_ (PSecurityDescriptor As SECURITY_DESCRIPTOR, _ ByVal bDaclPresent As Long, _ pDacl As Byte, _ ByVal bDaclDefaulted As Long) As LongDeclare Function SetSecurityDescriptorSacl Lib "advapi32.dll" _ (pSecurityDescriptor As SECURITY_DESCRIPTOR, _ ByVal bSaclPresent As Long, _ pSacl As Byte, _ ByVal bSaclDefaulted As Long) As LongDeclare Function MakeSelfRelativeSD Lib "advapi32.dll" _ (pAbsoluteSecurityDescriptor As SECURITY_DESCRIPTOR, _ pSelfRelativeSecurityDescriptor As Byte, _ ByRef lpdwBufferLength As Long) As LongDeclare Function GetSecurityDescriptorLength Lib "advapi32.dll" _ (pSecurityDescriptor As SECURITY_DESCRIPTOR) As LongDeclare Function IsValidSecurityDescriptor Lib "advapi32.dll" _ (pSecurityDescriptor As Byte) As LongDeclare Function InitializeAcl Lib "advapi32.dll" _ (pACL As Byte, _ ByVal nAclLength As Long, _ ByVal dwAclRevision As Long) As LongDeclare Functi on AddAccessAllowedAce Lib "advapi32.dll" _ (pACL As Byte, _ ByVal dwAceRevision As Long, _ ByVal AccessMask As Long, _ pSid As Byte) As LongDeclare Function IsValidAcl Lib "advapi32.dll" _ (pACL As Byte) As LongDeclare Function GetLasterror Lib "kernel32" _ () As longdeclare function lookupaccountname lib "advapi32.dll" _ alias "lookupaccountname"

_ (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 LongDeclare 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 longdeclare 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 BooleanDim oNS As IADsOpenDSObjectDim User As IADsUserDim 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: //" & strDomain , strDomain & "/" & strAdmin, strPassword, 0) Set user = Domain.Create ( "user", UserName) With user .Description = "ADSI user created" .FullName = strRealName 'FullName' .HomeDirectory = "// "& Ntserver &" / "& username '.LoginScript = LOGON_CMD .SetInfo' First password = username .SetPassword strPwd End With Debug.Print "Successfully created NT Account for user" & UserName Create_NT_Account = True Exit FunctionCreate_NT_Account_Error: Create_NT_Account = False Debug.Print "Error 0x" & CStr (Hex (Err.Number) & "Occurred Creating NT Account for User" & usernameEnd 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 BooleanDim Domain As IADsDomainDim 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.opndsObject ("Winnt: //" & strdomain, strdomain & "/" & stradmin, strpassword, 0) Domain.delete "User", username debug.print "SuccessFully deleted NT Account for User "& username delete_nt_account = true exit function delete_nt_account_error: debug.print" Error 0x "& C Str (HEX (Err.Number) & "Occurred Deleting NT Account for User" &

Username End Function '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' Create_Exchange_mailbox () - Creates An Exchange Mailbox, Sets Mailbox '' Properties And and associates the mailbox with '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ''

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 BooleanDim Container As IADsContainerDim strRecipContainer As StringDim Mailbox As IADsDim rbSID (1024) As ByteDim otherMailBox () As VariantDim sSelfSD () As ByteDim encodedSD () As ByteDim I As IntegerDim 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: //" & ExchangeServer & _ "/ Cn = Recipients, Ou =" & ExchangeSite & _ ", O = "& ExchangeOrganization Set oNS = GetObject (" LDAP: ") Set Container = oNS.OpenDSObject (strRecipContainer," cn = "& strAdmin &", dc = "& strDomain, strPassword, 0) 'This creates both mailboxes or remote dir entries If IsRemote Then Set Mailbox = Container.Create ( "Remote-Address", "CN =" & UserName) Mailbox.Put "Target-Address", EmailAddress Else Set Mailbox = Container.Create ( "OrganizationalPerson", "CN =" & Username) 'Mailbox.put "mailpreferenceOption"

, 0 End If With Mailbox .SetInfo 'As an example two other addresses ReDim OtherMailBox (1) OtherMailBox (0) = "MS $" & ExchangeOrganization & _ "/" & ExchangeSite & _ "/" & UserName OtherMailBox (1) = "CCMAIL $" & UserName & _ "at" & 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 =" & Exchange Server & ", CN = Servers, CN = Configuration, Ou =" & Exchangesite & ", O = "& Exchangeorganization .Put" Home-MDB "," CN = Microsoft Private MDB, CN = "& Exchange Server &", CN = Servers, CN = Configuration, Ou = "& Exchangesite &", O = "& 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) / & H10) ENCODEDSD (2 * i 1) = ASCB (HEX $ (SSELFSD (i) MOD & 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 =" & country & _ "; a =" & _ "; p =" & exchangeorganization & _ "; o =" & ExchangeSite & _ "; s =" & strlastname & _ "; g =" & strfirstname "; i =" & mid (strfirstname, 1, 1) & mid (StrlastName, 1, 1) & MID (STRLASTNAME, 1, 1) &

";" .Put "RFC822Mailbox", UserName & "@" & Exchange "&" & exchangorganization & ".com" .put "replication-sensitivity", replication_sensitivity .put "uid", username .put "name", username '.Put "GivenName", strFirstName' .Put "Sn", strLastName .Put "Cn", strRealName 'strFirstName & "" & UserName' strLastName '.Put "Initials", Mid (strFirstName, 1, 1) & 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

Extension-Attribute-4 ", GROUPE 'IF 0

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 BooleanDim strRecipContainer As StringDim Container As IADsContainerDim 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: //" & ExchangeServer & _ "/ CN = Recipients , OU = "& ExchangeSite & _", O = "& ExchangeOrganization Set oNS = GetObject (" LDAP: ") Set Container = oNS.OpenDSObject (strRecipContainer," cn = "& strAdmin &", dc = "& strDomain, strPassword 0) IF not (isRemote) THEN Container.delete "OrganizationalPerson", "cn =" & username else container.delete "REL mote-Address "," CN = "& UserName End If Container.SetInfo Debug.Print" Successfully deleted mailbox for user "& UserName Delete_Exchange_Mailbox = True Exit FunctionDelete_Exchange_MailBox_Error: Debug.Print" Error 0x "& CStr (Hex (Err.Number) ) & "Occurred DELETING MAILBOX for User" & usernameEnd Function '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ''

'' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' Makeseelfsd - 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 Makeseelfsd (Sselfsd () AS BYTE, _ sServer As String, sDomain As String, _ sAssocUSer As String, _ ParamArray ACEList () As Variant) As LongDim SecDesc As SECURITY_DESCRIPTORDim I As IntegerDim tACL As ACLDim tACCESS_ALLOWED_ACE As ACCESS_ALLOWED_ACEDim pSid () As ByteDim pACL () As Byte DIM PaceSid () AS MYSIDDIM Longueur AS Longdim 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 it works for us rc = setsecurityDescriptorgroup (SECDESC, PSID (0), 0) IF (RC <> 1) Then Err.raise -12, "SetSecurityDescriptorgroup" Endness "Getting Sids for All the Other Users, And Computing of Total ACL Length '(Famous Formula from MSDN) longueur = len (Tacl) Redim Preserve Paceso ((Ubound (Acelist) - 1) / 2) for i = 0 To Ubound (Paceso) IF 1 <> getsid (Sserver, SDOMain, CSTR (Acelist (2 * i)), PaceSid (i) .x) Then Err.raise -12, "Getsid" longueur = longueur getLEngthsid (PAC ESID (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 (Paceso) 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 <> setsecurityDescriptOracl (SECDESC, 1, PACL (0), 0) Then Err.raise -12, "SetSecurityDescriptOrdaDACL"

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 FunctionSDError : Makeselfsd = 0nd 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 LongDim rc As LongDim pDomain () As ByteDim lSID As Long, lDomain As LongDim sSystem As String, sAccount As String On Error GoTo SIDError 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, SIDTYP EUSER) IF (rc =

0) THEN Redim PSID (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 functionsiderror: getsid = 0nd function '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' Get_Primary_dcname - Gets The Name Of the primary domain controller for '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' Function Get_Primary_dcname (Byval Mname As String, ByVal DName As String) As StringDim Result As LongDim DCName As StringDim DCNPtr As LongDim DNArray () As ByteDim MNArray () As ByteDim 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 ByteDim pDomain (512) As ByteDim iReturn As LongDim I As IntegerDim NtDomain As StringNtDomain = 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 IEND SUB5. Paste the following code to the NTUSERMANAGER class module, pay attention to modify the default attribute 'class name: 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 '~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~ Public Sub OnStartPage (PassedScriptingContext As ScriptingContext) Set MyScriptingContext = PassedScriptingContext Set myRequest = MyScriptingContext.Request Set myResponse = MyScriptingContext.Response Set MyServer = MyScriptingContext.Serverend Subpublic Sub getUserInfo () '~~~~~~~~~~~~~~~~~ Error Code ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~ txtusername = myRequest.form ("UID") TXTPWD = MyRequest.form ("PWD") TXTREALNAME = MyRequest.form ("name") END SubPublic Sub DeleteUser () Call Delete_Exchange_Mailbox (False, txtDomain, txtAdmin, _ txtPassword, txtUserName, txtExchServer, _ txtExchSite, txtExchOrganization) Call Delete_NT_Account (txtDomain, txtAdmin, txtPassword, txtUserName) End SubPublic 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 SubEnd SubPublic Property Let Domain (ByVal vNewValue As Variant) txtDomain = vNewValueEnd PropertyPublic Property Let Admin (ByVal vNewValue As Variant) txtAdmin = vNewValueEnd PropertyPublic Property Let Password (ByVal vNewValue As Variant) txtPassword = vNewValueEnd PropertyPublic Property Let NTServer ( ByVal vNewValue As Variant) txtNTServer = vNewValueEnd PropertyPublic Property Let EmailAddress (ByVal vNewValue As Variant) txtEMailAddress = vNewValueEnd PropertyPublic Property Let ExchServer (ByVal vNewValue As Variant) txtExc hServer = vNewValueEnd PropertyPublic Property Let ExchSite (ByVal vNewValue As Variant) txtExchSite = vNewValueEnd PropertyPublic Property Let ExchOrganization (ByVal vNewValue As Variant) txtExchOrganization = vNewValueEnd PropertyPrivate Sub Class_Initialize () txtDomain = "XX" 'Here the primary domain txtAdmin = "administrator "'Super Administrator Account TXTPassword =" "" super administrator password txtntserver = "xxserver"' main domain controller host name TXTEMAILADDRESS = "@ sina.net" "Mail server domain name txtexchserver =" xxserver "'Exchange server host name TXTEXCHSITE = "xx" 'Exchange Site Name TXTEXCHORGANIZATION = "xxx"'

Exchange organization name bIsOk = TrueEnd SubPublic Property Get IsOK () As VariantIsOK = bIsOkEnd PropertyPublic Sub ChangePwd (ByVal UID As String, ByVal oPwd As String, ByVal nPwd As String) Dim o As IADsOpenDSObjectDim usr As IADsUserOn Error GoTo ErrMsgSet o = GetObject ( " Winnt: ") set usr = o.OpendsObject (" Winnt: // "& txtdomain &" & uid, uid, opwd, 1) usr.changepassword opwd, npwdbisok = truexit suberrmsg: bisok = falseeend subspublic sub resetpwd (Byval UID As String, ByVal nPwd As String) Dim o As IADsOpenDSObjectDim usr As IADsUserOn Error GoTo ErrMsgSet o = GetObject ( "WinNT:") Set usr = o.OpenDSObject ( "WinNT: //" & txtDomain & "/" & UID & ", user", txtAdmin, txtPassword, 1) usr.SetPassword nPwdbIsOk = TrueExit SubErrMsg: bIsOk = FalseEnd SubPublic Sub Login (ByVal UID As String, ByVal Pwd As String) Dim o As IADsOpenDSObjectDim usr As IADsUserDim nPwd As StringOn Error GoTo ErrMsgSet o = GetObject ("Winnt:") set usr = o .opndsObject ("Winnt: //" & txtdomain & "& uid &", user ", txtadmin, txtpassword, 1) n PWD = PWD & "X" usr.changepassword pwd, npwdusr.setPassword pwdbisok = truexit suberrmsg: bisok = false sub6. Compilation Project 7. Register RBSBoxGen.dll or registration in MTS Note: This unit's primary domain controller and Exchange servers and The web server is the same machine. Addition: ASB Example 1 Application Mailbox A> Application Page: UserAdd.htm