台灣最大程式設計社群網站
線上人數
1151
 
會員總數:246138
討論主題:189722
歡迎您免費加入會員
討論區列表 >> 專欄文章 >> 虛擬目錄最大容量配額的設定方法(CHOME提供)
[]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
虛擬目錄最大容量配額的設定方法(CHOME提供)
價值 : 0 QP  點閱數:2177 回應數:0
樓主

站務人員 站長
門外漢
0 1580
542 9
發送站內信

捐贈 VP 給 站務人員
以下文章摘自微軟
(http://support.microsoft.com/support/kb/articles/Q252/4/59.ASP)

******************************************

The information in this article applies to:

Microsoft Exchange 2000 Server

Microsoft Active Directory Service Interfaces, version 2.5

--------------------------------------------------------------------------------

SUMMARY

This article contains a Microsoft Visual Basic code sample that demonstrates how to programmatically retrieve the properties of a User object with Active Directory Service Interfaces (ADSI) and ActiveX Data Objects (ADO).


MORE INFORMATION

The following sample code demonstrates how to identify the Lightweight Data Access Protocol (LDAP) properties that are displayed by the Users and Computers snap-in when you view the User object's Exchange General and Exchange Advanced tabs.
To create and run the sample program, perform the following steps:

1.Create a new Visual Basic project called Project1.vbp.

2.Paste the following code in the code window:
------------------------------------------------------------------------------

Sub Main()
Dim oRootDSE As IADs

Dim oDomain As IADs

Dim obj As IADs

Dim objUser As IADsUser

Dim dacl As IADsAccessControlList

Dim ace As IADsAccessControlEntry

Dim oConnection As New ADODB.Connection

Dim oCommand As New ADODB.Command

Dim RS As ADODB.Recordset

Dim RS2 As ADODB.Recordset

Dim strQuery As String, strAlias As String, mystring As String

Dim varDomainNC As Variant, Desc As Variant, varReports As Variant

Dim PropArray As Variant, Prop As Variant, DescList As Variant

Dim Everyone As Boolean

Dim i As Integer



Const RIGHT_DS_DELETE = &H10000

Const RIGHT_DS_READ = &H20000

Const RIGHT_DS_CHANGE = &H40000

Const RIGHT_DS_TAKE_OWNERSHIP = &H80000

Const RIGHT_DS_MAILBOX_OWNER = &H1

Const RIGHT_DS_SEND_AS = &H2

Const RIGHT_DS_PRIMARY_OWNER = &H4



On Error Resume Next

' To do: change to the alias for the mailbox you are looking for.

strAlias = "EmailAlias"
' Get the Configuration Naming Context.

Set oRootDSE = GetObject("LDAP://RootDSE")

varDomainNC = oRootDSE.Get("defaultNamingContext")

' Open the Connection

oConnection.Provider = "ADsDSOObject"

oConnection.Open "ADs Provider"

' Build the query to find the user based on their alias.

strQuery = "<LDAP://" & varDomainNC & ">;(mailNickName=" & strAlias & ");adspath;subtree"

oCommand.ActiveConnection = oConnection

oCommand.CommandText = strQuery

Set RS = oCommand.Execute

If RS.RecordCount = 0 Then

Debug.Print strAlias, " is not a valid email alias"

Else

' Iterate through the results.

While Not RS.EOF

' Retrieve the properties and display in debug window.

Set objUser = GetObject(RS.Fields("adspath"))

Debug.Print "*************************************************"

Debug.Print "Information From the Exchange GENERAL Tab:"

Debug.Print "*************************************************"

Debug.Print "Mailbox Store:", objUser.homeMDB

Debug.Print "Alias:", objUser.mailNickname

Debug.Print "Delivery Restrictions:"

Debug.Print " Outgoing Message Size Limit:"

If objUser.submissionContlength > 0 Then

Debug.Print " No Limit: Is Not Selected"

Debug.Print " Maxumum Size KB: Is Selected"

Debug.Print " Maximum Size KB: ", objUser.submissionContlength

Else

Debug.Print " No Limit: Is selected"

Debug.Print " Maximum Size KB: Is not Selected"

End If



Debug.Print " Incoming Message Size:"

If objUser.delivContLength > 0 Then

Debug.Print " No Limit: Is Not Selected"

Debug.Print " Maximum Size: Is Selected"

Debug.Print " Maximum Size:", objUser.delivContLength

Else

Debug.Print " No Limit: Is Selected"

Debug.Print " Maximum Size: Is Not Selected"

End If



Debug.Print " Message Restriction:"

Debug.Print " Accept Messages from:"

Everyone = True

' Initialize the array of properties to pass to GetInfoEx.

PropArray = Array("authOrig", "unauthOrig", "dlMemSubmitPerms", "dlMemRejectPerms")

' Make the array a single variant for passing to GetInfoEx.

Prop = PropArray

objUser.GetInfoEx Prop, 0

Err.Clear

DescList = objUser.Get("dlMemSubmitPerms")

If Err.Number <> -2147463155 Then

Debug.Print " From Everyone: IS Not Selected"

Debug.Print " Only From:"

For Each Desc In DescList

' Print the descriptions.

Debug.Print " ", (Desc)

Next

Everyone = False

End If

DescList = Null

Err.Clear

DescList = objUser.Get("authOrig")

If Err.Number <> -2147463155 Then

For Each Desc In DescList

' Print the descriptions.

Debug.Print " ", (Desc)

Next

Everyone = False

End If

DescList = Null

Err.Clear

DescList = objUser.Get("dlMemRejectPerms")

If Err.Number <> -2147463155 Then

Debug.Print " From Everyone Except:"

For Each Desc In DescList

' Print the descriptions.

Debug.Print " ", (Desc)

Next

Everyone = False

End If

DescList = Null

DescList = objUser.Get("unauthOrig")

If Err.Number <> -2147463155 Then

For Each Desc In DescList

' Print the descriptions.

Debug.Print " ", (Desc)

Next

Everyone = False

End If

If Everyone = True Then

Debug.Print " From Everyone: Is Selected"

End If

Debug.Print "Delivery Options:"

Debug.Print " Delegates:"

Debug.Print " Grant Permission to:"

DescList = Null

Err.Clear

DescList = objUser.Get("publicDelegates")

If Err.Number <> -2147463155 Then

For Each Desc In DescList

' Print the descriptions.

Debug.Print " ", (Desc)

Next

Else

Debug.Print " Not Set"

End If

Debug.Print " Forwarding Address:", objUser.altRecipient

If objUser.deliverAndRedirect = True Then

Debug.Print " Deliver message to both forwarding address and mailbox: Checked"

Else

Debug.Print " Deliver message to both forwarding address and mailbox: Not Checked"

End If

Debug.Print " Recipient Limits:"

Err.Clear

DescList = objUser.Get("msExchRecipLimit")

If Err.Number <> -2147463155 Then

For Each Desc In DescList

Debug.Print " Maximum users:", objUser.msExchRecipLimit

Next

Else

Debug.Print " Not Set"

End If



Debug.Print "Storage Limits:"

Debug.Print " Use mailbox store defaults:", objUser.mdbusedefaults

Debug.Print " When mailbox exceeds the indicated amount:"

Debug.Print " Issue warning at:", objUser.mdbstoragequota

Debug.Print " Prohibit send at:", objUser.mdbOverquotalimit

Debug.Print " Prohibit send and recieve at:", objUser.mdbOverhardquotalimit

Debug.Print " Maximum Size:", objUser.MaxStorage

Debug.Print " Deleted items retension:"

If objUser.deletedItemflags > 0 Then

Debug.Print " Use mailbox store defaults: is Not Checked"

Else

Debug.Print " Use mailbox store defaults: is Checked"

End If

Debug.Print " Keep deleted items for days:", objUser.garbageCollPeriod / 86400

If objUser.deletedItemflags = 3 Then

Debug.Print " Don't permenently delete until the store has been backed up: is Checked"

Else

Debug.Print " Don't permenently delete until the store has been backed up: is Not Checked"

End If

Debug.Print "*************************************************"

Debug.Print "Information From the Exchange Advanced Tab:"

Debug.Print "*************************************************"

Debug.Print "Simple Display Name:", objUser.displayNamePrintable

Debug.Print "Hide from Exchange Address list", objUser.msExchHidefromAddressLists

varReports = objUser.securityProtocol

If varReports(3) <> 0 Then

Debug.Print "Downgrade high priority mail bound for X400: Is Checked"

Else

Debug.Print "Downgrade high priority mail bound for X400: Is Not Checked"

End If

Debug.Print "Custom Attributes:"

Debug.Print " extensionAttribute1:", objUser.extensionAttribute1

Debug.Print " extensionAttribute2:", objUser.extensionAttribute2

Debug.Print " extensionAttribute3:", objUser.extensionAttribute3

Debug.Print " extensionAttribute4:", objUser.extensionAttribute4

Debug.Print " extensionAttribute5:", objUser.extensionAttribute5

Debug.Print " extensionAttribute6:", objUser.extensionAttribute6

Debug.Print " extensionAttribute7:", objUser.extensionAttribute7

Debug.Print " extensionAttribute8:", objUser.extensionAttribute8

Debug.Print " extensionAttribute9:", objUser.extensionAttribute9

Debug.Print " extensionAttribute10:", objUser.extensionAttribute10

Debug.Print " extensionAttribute11:", objUser.extensionAttribute11

Debug.Print " extensionAttribute12:", objUser.extensionAttribute12

Debug.Print " extensionAttribute13:", objUser.extensionAttribute13

Debug.Print " extensionAttribute14:", objUser.extensionAttribute14

Debug.Print " extensionAttribute15:", objUser.extensionAttribute15

Debug.Print "Protocol Setting:"

DescList = Null

Err.Clear

DescList = objUser.Get("protocolsettings")

If Err.Number <> -2147463155 Then

For Each Desc In DescList

i = InStr(1, Desc, "§", vbTextCompare)

If Left(Desc, i - 1) = "HTTP" Then

Desc = Right(Desc, Len(Desc) - i)

If Left(Desc, 1) = "1" Then

Debug.Print " HTTP: is enabled for mailbox"

Else

Debug.Print " HTTP: is not enabled for mailbox"

End If

Desc = Right(Desc, Len(Desc) - 2)

If Left(Desc, 1) = "1" Then

Debug.Print " HTTP: Use protocol defaults"

Else

Debug.Print " HTTP: Do not use protocol defaults"

End If

ElseIf Left(Desc, i - 1) = "IMAP4" Then

Desc = Right(Desc, Len(Desc) - i)

If Left(Desc, 1) = "1" Then

Debug.Print " IMAP4: is enabled for mailbox"

Else

Debug.Print " IMAP4: is not enabled for mailbox"

End If

Desc = Right(Desc, Len(Desc) - 2)

If Left(Desc, 1) = "1" Then

Debug.Print " IMAP4: Use server defaults"

Else

Debug.Print " IMAP4: Do not use server defaults"

End If

Debug.Print " IMAP4 MIME Encoding:"

Desc = Right(Desc, Len(Desc) - 2)

If Left(Desc, 1) = "0" Then

Debug.Print " Message should be MIME-encoded with both text and HTML body parts"

ElseIf Left(Desc, 1) = "1" Then

Debug.Print " Message should be MIME-encoded with text only body parts"

ElseIf Left(Desc, 1) = "4" Then

Debug.Print " Message should be MIME-encoded with HTML only body parts"

End If

Desc = Right(Desc, Len(Desc) - 2)

i = InStr(1, Desc, "§", vbTextCompare)

Debug.Print " Default Character set:", Left(Desc, i - 1)

'The last 4 values are not documented.

'Setting these programmatically is not supported.



ElseIf Left(Desc, i - 1) = "POP3" Then

Desc = Right(Desc, Len(Desc) - i)

If Left(Desc, 1) = "1" Then

Debug.Print " POP3: is enabled for mailbox"

Else

Debug.Print " POP3: is not enabled for mailbox"

End If

Desc = Right(Desc, Len(Desc) - 2)

If Left(Desc, 1) = "1" Then

Debug.Print " POP3: Use server defaults"

Else

Debug.Print " POP3: Do not use protocol defaults"

End If

Debug.Print " POP3 MIME Encoding:"

Desc = Right(Desc, Len(Desc) - 2)

If Left(Desc, 1) = "0" Then

Debug.Print " Message should be MIME-encoded with both text and HTML body parts"

ElseIf Left(Desc, 1) = "1" Then

Debug.Print " Message should be MIME-encoded with text only body parts"

ElseIf Left(Desc, 1) = "2" Then

Debug.Print " POP3 UUencoding: Is Enabled "

Debug.Print " POP3 UUencoding: Use Binhex for macintosh is enabled"

ElseIf Left(Desc, 1) = "3" Then

Debug.Print " POP3 UUencoding: Is Enabled "

ElseIf Left(Desc, 1) = "4" Then

Debug.Print " Message should be MIME-encoded with HTML only body parts"

End If

Desc = Right(Desc, Len(Desc) - 2)

i = InStr(1, Desc, "§", vbTextCompare)

Debug.Print " Default Character set:", Left(Desc, i - 1)

i = InStr(1, Desc, "§", vbTextCompare)

Desc = Right(Desc, Len(Desc) - i)

If Left(Desc, 1) = "0" Then

Debug.Print " Use Rich Text is not enabled"

Else

Debug.Print " Use Rich Text is enabled"

End If

End If

Next

End If

mystring = "§"

i = Asc(mystring)

Debug.Print "ILS Settings"

i = InStr(1, objUser.autoReplyMessage, "/", vbTextCompare)

Debug.Print " ILS Server:", Left(objUser.autoReplyMessage, i - 1)

Debug.Print " ILS Account:", Right(objUser.autoReplyMessage, Len(objUser.autoReplyMessage) - i)



DescList = Null

Err.Clear

Debug.Print "Mailbox Rights"



' msExchMailboxSecurityDescriptoris a copy of what is in the MDB.

' It cannot be modified programmatically.



objUser.GetInfoEx "msExchMailboxSecurityDescriptor", 0

Dim objsd As IADsSecurityDescriptor

Set objsd = objUser.Get("msExchMailboxSecurityDescriptor")

'----Enumerate an ACE in DACL----

Set dacl = objsd.DiscretionaryAcl

For Each ace In dacl



'----TRUSTEE----



mystring = ace.Trustee



'----ACE TYPE-----



If (ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED) Then

mystring = " " & mystring & " is allowed:"

ElseIf (ace.Type = ADS_ACETYPE_ACCESS_DENIED) Then

mystring = " " & mystring & " is denied:"

End If



'----ACE MASK----



If (ace.AccessMask And RIGHT_DS_SEND_AS) Then

mystring = mystring & " -send mail as"

End If



If (ace.AccessMask And RIGHT_DS_CHANGE) Then

mystring = mystring & " -modify user attributes"

End If

If (ace.AccessMask And RIGHT_DS_DELETE) Then

mystring = mystring & " -delete mailbox store"

End If


If (ace.AccessMask And RIGHT_DS_READ) Then

mystring = mystring & " -read permissions"

End If

If (ace.AccessMask And RIGHT_DS_TAKE_OWNERSHIP) Then

mystring = mystring & " -take ownership of this object"

End If

If (ace.AccessMask And RIGHT_DS_MAILBOX_OWNER) Then

mystring = mystring & " -is mailbox owner of this object"

End If

If (ace.AccessMask And RIGHT_DS_PRIMARY_OWNER) Then

mystring = mystring & " -is mailbox Primary owner of this object"

End If

Debug.Print mystring

Next

RS.MoveNext

Wend

obj = Nothing

objUser = Nothing

dacl = Nothing

ace = Nothing



End If

oRootDSE = Nothing

oDomain = Nothing

Set oConnection = Nothing

Set oCommand = Nothing

Set RS = Nothing

Set RS2 = Nothing

End Sub
---------------------------------------------------------------------------

3.Modify the code to set the value of the strAlias variable to the email alias of the user for whom you want to retrieve properties.

4.Reference the project with the ActiveX Data Objects 2.5 Libraries.


5.Run the project in debug mode.


Additional query words:

Keywords : kbADO kbADSI kbExchange kbMsg kbVBp kbGrpDSMsg kbDSupport

Issue type : kbinfo

Technology : kbAudDeveloper kbExchangeSearch kbADSISearch kbZNotKeyword2 kbExchange2000Search

本篇文章發表於2001-05-17 00:00
目前尚無任何回覆
   

回覆
如要回應,請先登入.