Administer quotas from the people view of the NAB

We added an action button to one of our People views in the NAB that allows us to view and set the mailfile quota for any user. I found a piece of code on Notes.net that uses API calls to set the quota and warning. Then modified this code to so that we could use it as an action button in the People view of the NAB.


 'Quota: 

Option Declare
Option Compare Nocase

Type DBQUOTAINFO
 WarningThreshold As Long
 SizeLimit As Long
 CurrentDbSize As Long
 MaxDbSize As Long
End Type
Declare Function NSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen" ( Byval dbName As String, hDb As Long) As Integer
Declare Function NSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" ( Byval hDb As Long) As Integer
Declare Function NSFDbQuotaGet Lib "nnotes.dll" (Byval Filename As String, retQuotaInfo As dbQuotaInfo) As Integer
Declare Function NSFDbQuotaSet Lib "nnotes.dll" (Byval Filename As String, Flags As Integer, QuotaSet As DBQUOTAINFO) As Integer
Declare Function OSPathNetConstruct Lib"nnotes.dll" (Byval sPortName As String, Byval sServerName As String, Byval sFileName As String, Byval sPathName As String) As Integer

Const fld_mailfile = "mailfile"
Const fld_mailserver = "mailserver"
Const fld_fullname = "fullname"

Const warning_delta = 15000
Const mb75 = 76800
Const mb150 = 153600
Const mb250 = 256000
Const mb400 = 409600
Const mb600 = 614400
Const mb800 = 819200
Const mb1000 = 1024000
Const quota_bump = 25600


Sub Click(Source As Button)
 Dim s As New notessession
 Dim dc As notesdocumentcollection
 Dim db As notesdatabase
 Dim doc As notesdocument
 Dim ms As String, mf As String
 Dim nname As notesname
 
 Set db = s.currentdatabase
 Set dc = db.unprocesseddocuments
 Set doc = dc.getfirstdocument
 While Not doc Is Nothing
  mf = doc.getitemvalue( fld_mailfile )(0)
  ms = doc.getitemvalue( fld_mailserver )(0)
  If ms <> "" And mf <> "" Then 
   Set nname = New notesname( doc.getitemvalue( fld_fullname )(0) )
   setquota ms, mf, nname.common
  End If
  Set doc = dc.getnextdocument( doc )
 Wend
End Sub

Function OpenDatabaseHandle(ServerName As String, Filename As String, ServerConstructPath As String, hDb As Long)
 Dim sServerName As String * 256
 Dim sFileName As String * 256
 Dim sPathName As String * 256
 Dim sPortName As String * 64
 
 OpenDatabaseHandle = False
 
'Store server and database file name 
 sServerName = ServerName & Chr(0)
 sFileName = Filename & Chr(0)
 
'Construct path
 Call OSPathNetConstruct (sPortName, sServerName, sFileName, sPathName)
 ServerConstructPath = sPathName
 
'Open database 
 Call NSFDBOpen(sPathName, hDb)
End Function
Function CloseDatabaseHandle(hDb)
 Call NSFDbClose(hDb)
End Function
Sub setquota( server As String, database As String, title As String )
 Const fm = "#,##0"
 Dim w As New notesuiworkspace
 Dim hDb As Long
 Dim ServerConstructPath As String
 Dim retQuotaInfo As DBQUOTAINFO
 Dim rv As Integer
 Dim Msg As String
 Dim warning As Long
 Dim quota As Long
 Dim dlg_title As String
 Dim dlg_accept As Integer
 Dim dlg_finished As Integer
 Dim qstring As String
 
 dlg_finished = False
 dlg_accept = False
 
 Call OpenDatabaseHandle(Server, Database, ServerConstructPath, hDb)
 If hDb = 0 Then
  Msgbox "Unable to get database hande....Exiting",,"Database Audit"
  Exit Sub
 End If
 
'Get the current quota settings and display them
 rv = NSFDbQuotaGet(ServerConstructPath, retQuotaInfo)
 Msg = "Warning Threshold:" & Chr$(9) & Format( retQuotaInfo.WarningThreshold/1024, fm ) & " mb" & Chr$(13)
 Msg = Msg & "Quota Size Limit:" & Chr$(9) & Chr$(9) & Format( retQuotaInfo.SizeLimit/1024, fm ) & " mb" & Chr$(13)
 Msg = Msg & "Current Database Size:" & Chr$(9) & Format( retQuotaInfo.CurrentDbSize/1024, fm ) & " mb" & Chr$(13) & Chr$(13)
 msg = msg & "Enter quota size in MB:"
 
 Select Case retQuotaInfo.CurrentDbSize/1024 + quota_bump
 Case Is <75 : quota = mb75
 Case Is < 150 : quota = mb150
 Case Is < 250 : quota = mb250
 Case Is < 400 : quota = mb400
 Case Is < 600 : quota = mb600
 Case Is < 800 : quota = mb800
 Case Is < 1000 : quota = mb1000
 Case Else :  quota = retQuotaInfo.CurrentDbSize + quota_bump
 End Select
 
 If title = "" Then
  dlg_title = "Quota Settings for " & Database & " (" & Server & ")"
 Else
  dlg_title = "Quota Settings for " & title & ", " & Database & " (" & Server & ")"
 End If
 
 While Not dlg_finished
  qstring = w.prompt( PROMPT_OKCANCELEDIT, dlg_title, msg, Format( quota/1024, fm) )
  If qstring = "" Then
   dlg_finished = True
  Else
   If Isnumeric( qstring ) Then
    quota = Clng( qstring ) * 1024
    dlg_accept = True
    dlg_finished = True
   Else
    Msgbox "The quota needs to be a number.",, "Invalid Entry"
   End If
  End If
 Wend
 
 If dlg_accept Then
  'Set the new quota and warning
  If quota < warning_delta Then 
   warning = quota / 2
  Else
   warning = quota - warning_delta
  End If
  
  retQuotaInfo.WarningThreshold = warning
  retQuotaInfo.SizeLimit = quota
  rv = NSFDbQuotaSet(ServerConstructPath, 0, retQuotaInfo)
  If rv <> 0 Then
   Msgbox "Error" + Str( rv ) + ", setting the quota.  ",48, "Error setting quota."
  Else
   Print dlg_title + " set to " + Format( retQuotaInfo.SizeLimit/1024, fm )
  End If
  
 End If
 
 Call CloseDatabaseHandle(hDb)
End Sub

This was first published in July 2002

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.

Back to top