Microsoft Exchange üzerinde email kota ayarı scripti

on error resume next

CONST QUOTA_EXEMPTION = 500000 “˜* > mDBOverHardQuotaLimit is exempted to use default quota
CONST EXEMPTED_WORD = “œexempted”

Const ADS_SCOPE_SUBTREE = 2
Const ADS_CHASE_REFERRALS_EXTERNAL = &h40
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ADS_UF_PASSWD_CANT_CHANGE = &h00040
Const ADS_UF_PASSWORD_EXPIRED = &H80000
Const ADS_UF_LOCKOUT = &h00010

Set rootDSE = GetObject(“LDAP://RootDSE”)
sObjectDN = “œLDAP://” & rootDSE.Get(“defaultNamingContext”)
Set rootDSE = Nothing
Set oIADs = GetObject(sObjectDN)
set con=createobject(“ADODB.Connection”)
set com =createobject(“ADODB.Command”)
Set WshShell = Wscript.CreateObject(“Wscript.Shell”)
Set objFSO = CreateObject(“Scripting.FileSystemObject”)

con.Provider = “œADsDSOObject”
con.Open “œActive Directory Provider”

Set Com.ActiveConnection = con

sMsg = “œselect AdsPath,CN,Name,samAccountName from “˜” & oIADs.ADsPath
sMsg = sMsg & “œ”˜ where objectCategory=’user’ order by Name”

Com.CommandText = sMsg
Com.Properties(“searchscope”) = ADS_SCOPE_SUBTREE
Com.Properties(“Chase referrals”) = ADS_CHASE_REFERRALS_EXTERNAL
Com.Properties(“Cache Results”) = False

Set rs = Com.Execute
i = 0

While Not rs.EOF
“˜ wscript.echo rs.Fields(“fieldname”)
DoWorkOnUser rs.Fields(“AdsPath”)
i = i + 1
rs.MoveNext
Wend

rs.Close

Sub DoWorkOnUser(strUser)

Set objUser = GetObject(strUser)
Err.Clear

If len(objUser.DisplayName)=0 Then
wscript.echo objUser.Name & “ – No Access !!!!!!!!!!”
Else
if objUser.MDBUseDefaults = “œFalse” then
Wscript.echo “œ””-“
Wscript.echo “œDisplayName – “ & objUser.DisplayName
Wscript.echo “œmDBOverHardQuotaLimit – “ & objUser.mDBOverHardQuotaLimit
Wscript.echo “œmDBOverQuotaLimit – “ & objUser.mDBOverQuotaLimit
Wscript.echo “œmDBStorageQuota – “ & objUser.mDBStorageQuota
Wscript.echo “œmDBUseDefaults – “ & objUser.mDBUseDefaults
lsResult = objUser.mDBUseDefaults
If objUser.mDBOverHardQuotaLimit >= QUOTA_EXEMPTION Then
Wscript.echo “œEXEMPTED: “ & objUser.mDBOverHardQuotaLimit & “ is over default quota “ & QUOTA_EXEMPTION & “œ.”
lsResult = lsResult & EXEMPTED_WORD
End If
“˜SET THE QUOTAS TO DEFAULT!
SetMbxQuotas strUser
Wscript.echo “œ””-“
end if
End If
Set objUser = nothing
“˜ RetrieveUserSettings = lsResult

End sub

“˜* “”””””””””””””””””””””””””””””””””””
“˜* Function: Set User Settings
“˜* “”””””””””””””””””””””””””””””””””””
Sub SetMbxQuotas (strUser)

wscript.echo “œSetting mDBUseDefaults to True.”
Set SetUser = GetObject(strUser)
SetUser.Put “œmDBUseDefaults”, True
SetUser.Put “œmDBOverHardQuotaLimit”, 0
SetUser.Put “œmDBOverQuotaLimit”, 0
SetUser.Put “œmDBStorageQuota”, 0
SetUser.SetInfo
If err.number > 0 Then
wscript.echo “œError setting account attribute: “ & lsAttribute
err.Clear
on error goto 0
Else
wscript.echo “œSet to True successfully.”
End If
Set SetUser = nothing

End Sub

wscript.quit

One thought on “Microsoft Exchange üzerinde email kota ayarı scripti

  1. Sayın Hocam;
    Çalıştığım iş yerinde benden istenen bir intranet sayfasını yazdım. Ancak benden istenen iş gereği intranetimizde bulunan bir asp sayfasından başka bir siteye login olmak veya asp sayfasına veri göndermek istiyorum. Aşağıda yazılı kodlarla deneme yaptım. VBS dosyası olarak kullandığımda başarılı oldum Ancak ASP olarak kullandığımda başaramadım. Aşağıda yazılı hatayı verdi. Bu komutları çalıştırabilmem için hangi bileşenleri register etmem gerekir? Benim için çok önemli olan bu konuda Yardımcı olursanız sevinirim.
    Saygılarımla;

    kullandığım kodlar
    ====================================
    Dim WshShell
    Set WshShell = WScript.CreateObject(“WScript.Shell”)
    Set oIE = CreateObject(“InternetExplorer.Application”)
    oIE.Visible = True
    oIE.Navigate “http://app.sgk.gov.tr/SigortaliTescil/amp/loginldap”

    Do While oIE.Busy Or (oIE.READYSTATE 4)
    Wscript.Sleep 10
    Loop

Leave a Reply

Your email address will not be published. Required fields are marked *

16 − = 6