Quota for mailfile

This tip describes how to administer the quota for a mailfile.

This Content Component encountered an error

Here is an action button we added to a view in our NAB that allows us to administer the quota of a mailfile. You simply select the person document and then click the Quota action button. A box pops up showing the existing quota and warning and allows you to change the quota. A suggested quota is set as the default base upon the current mailfile size. The warning is set to 15 MB less than the quota. I found in Notes.net a piece of code...

that uses API calls to retrieve and set the Quota and Warning info for a database. I used that code and added the shell to get the mailfile info (server and pathname) and get input from the user. Here is the code:


Option Declare
Option Compare Nocase 



Type DBQUOTAINFO
 WarningThreshold As Long
 SizeLimit As Long
 CurrentDbSize As Long
 MaxDbSize As Long
End Type
Dim sServerName As String * 256
Dim sFileName As String * 256
Dim sPathName As String * 256
Dim sPortName As String * 64
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 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 + quota_bump
 Case Is < mb75 : quota = mb75
 Case Is < mb150 : quota = mb150
 Case Is < mb250 : quota = mb250
 Case Is < mb400 : quota = mb400
 Case Is < mb600 : quota = mb600
 Case Is < mb800 : quota = mb800
 Case Is < mb1000 : 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 
Function OpenDatabaseHandle(ServerName As String, Filename As String, ServerConstructPath As String, hDb As Long)
 
 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
This was first published in August 2002

Dig deeper on Domino Resources - Part 7

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchWinIT

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchVirtualDataCentre.co.UK

Close