邮件服务器-邮件系统-邮件技术论坛(BBS)

标题: [求助]再次请教EXCHANG如何实现自动申请帐号？ [打印本页]

作者: zlb4779 时间: 2005-7-30 16:41
标题: [求助]再次请教EXCHANG如何实现自动申请帐号？
上次发的贴不知何原因不见了。只好再次请教。斑竹不要嫌烦奥！！！！！

作者: 85501188 时间: 2005-7-30 22:20
标题: re:基于ADSI的NT帐号及Exchange...
基于ADSI的NT帐号及Exchange Server帐号申请及验证模块源代码 
 
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 = &H2 
Public Const RIGHT_MODIFY_ADMIN_ATTRIBUTES = &H4 
Public Const RIGHT_SEND_AS = &H8 
Public Const RIGHT_MAILBOX_OWNER = &H10 
Public Const RIGHT_MODIFY_PERMISSIONS = &H80 
Public 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 = 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://" & strDomain, strDomain & "\" & strAdmin, strPassword, 0) Set User = Domain.Create("User", UserName) With User .Description = "ADSI 创建的用户" .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 Function 
 
Create_NT_Account_Error: Create_NT_Account = False Debug.Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred creating NT account for user " & 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://" & 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" & CStr(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 
'' 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://" & 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=" & ExchangeServer & ",cn=Servers,cn=Configuration,ou=" & ExchangeSite & ", o = " & ExchangeOrganization .Put "Home-MDB", "cn=Microsoft Private MDB,cn=" & ExchangeServer & ",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) & ";" .Put "rfc822MailBox", UserName & "@" & ExchangeSite & "." & ExchangeOrganization & ".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 < Len(Direction) Then .Put "Department", Direction 'If 0 < Len(FaxNumber) Then .Put "FacsimileTelephoneNumber", FaxNumber 'If 0 < Len(City) Then .Put "l", City 'If 0 < Len(Address) Then .Put "PostalAddress", Address 'If 0 < Len(PostalCode) Then .Put "PostalCode", PostalCode 'If 0 < Len(Banque) Then .Put "Company", Banque 'If 0 < Len(PhoneNumber) Then .Put "TelephoneNumber", PhoneNumber 'If 0 < Len(Title) Then .Put "Title", Title 'If 0 < Len(AP1) Then .Put "Extension-Attribute-1", AP1 'If 0 < Len(Manager) Then .Put "Extension-Attribute-2", Manager 'If 0 < Len(Agence) Then .Put "Extension-Attribute-3", Agence 'If 0 < Len(Groupe) Then .Put "Extension-Attribute-4", Groupe 'If 0 < Len(Secteur) Then .Put "Extension-Attribute-5", Secteur 'If 0 < Len(Region) Then .Put "Extension-Attribute-6", Region 'If 0 < Len(GroupeBanque) Then .Put "Extension-Attribute-7", GroupeBanque 'If 0 < Len(AP7) Then .Put "Extension-Attribute-8", AP7 'If 0 < Len(AP8) Then .Put "Extension-Attribute-9", AP8 .SetInfo End With Debug.Print "Successfully created mailbox for user " & UserName Create_Exchange_MailBox = True Exit Function 
 
Create_Exchange_MailBox_Error: Create_Exchange_MailBox = False Debug.Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred creating Mailbox for user " & UserName 
End Function 
 
连下贴。。。。。。。。

作者: zlb4779 时间: 2005-7-31 09:03
标题: re:大恩不言谢。你就是及时雨啊！！！！！...
大恩不言谢。你就是及时雨啊！！！！！ 
我试试先。

欢迎光临邮件服务器-邮件系统-邮件技术论坛(BBS) (http://bbs.5dmail.cn/)