[TIP] CLASS API

[Stephane Maillard]

Bonjour,

Ci-dessous une classe :

Options :

Code : Tout sélectionner

Option Public
Option Explicit

%INCLUDE "LSCONST.LSS"

Public Const MAXPATH = 256

Public Const OS_TRANSLATE_NATIVE_TO_LMBCS =0
Public Const OS_TRANSLATE_LMBCS_TO_NATIVE = 1

Public Const NOTE_CLASS_VIEW = &h8

Public Const NAVIGATE_NEXT = 1
Public Const READ_MASK_NOTEID = &h0001

Public Const RRV_DELETED = &h80000000

Public Const TYPE_TEXT = &h500
Public Const TYPE_TEXT_LIST = &h501
Public Const TYPE_NUMBER = &h300
Public Const TYPE_NUMBER_RANGE = &h301
Public Const TYPE_TIME = &h400
Public Const TYPE_TIME_RANGE = &h401

Public Const NOERROR = &h0
Public Const ERR_ITEM_NOT_FOUND = &h222

Déclarations :

Code : Tout sélectionner

Type COLLECTIONPOSITION
   iLevel As Integer
   sMinLevel As String * 1
   sMaxLevel As String * 1
   lTumbler(0 To 31) As Long
End Type

Type COLLECTIONDATA
   lDocCount As Long
   lDocTotalSize As Long
   lBTreeLeafNodes As Long
   iBTreeDepth As Integer
   iSpare As Integer
   lKeyOffset(11) As Long
End Type

Type BLOCKID
   pool As Long
   block As Integer
End Type

' API Notes
Declare Function OSPathNetConstruct Lib "nnotes.dll" ( _
PortName As Any, _
Byval NomServeur As String, _
Byval NomFichier As String, _
Byval RetourNomChemin As String _
) As Integer

Declare Function OSLoadString Lib "nnotes.dll" ( _
Byval lModule As Long, _
Byval lCodeCaractere As Long, _
Byval sRetourBuffer As String, _
Byval iLongueurBuffer As Integer _
) As Integer

Declare Function OSTranslate Lib "nnotes.dll" ( _
Byval iTranslateMode As Integer, _
Byval sEntreeDonnee As String, _
Byval iEntreeDonnee As Integer, _
Byval sSortieDonnee As String, _
Byval iSortieDonnee As Integer _
) As Integer

Declare Function NSFDbOpen Lib "nnotes.dll" ( _
Byval sChemin As String, _
lHandleRetourDb As Long _
) As Integer

Declare Function NSFDbClose Lib "nnotes.dll" ( _
Byval lHandleDatabase As Long _
) As Integer

Declare Function OSMemFree Lib "nnotes.dll" ( _
Byval lHandle As Long _
) As Integer

Declare Function OSLockObject Lib "nnotes.dll" ( _
Byval lHandle As Long _
) As Long

Declare Function OSUnlockObject Lib "nnotes.dll" ( _
Byval lHandle As Long _
) As Integer

Declare Function NSFNoteOpen Lib "nnotes.dll" ( _
Byval Db_Handle As Long, _
Byval Note_ID As Long, _
Byval Open_Flags As Integer, _
Note_Handle As Long _
) As Integer

Declare Function NSFNoteClose Lib "nnotes.dll" ( _
Byval Note_Handle As Long _
) As Integer

Declare Function NSFItemGetText Lib "nnotes.dll" ( _
Byval Note_Handle As Long, _
Byval Item_Name As String, _
Byval Item_Text As String, _
Text_Len As Integer _
) As Integer

Declare Function NSFItemInfo Lib "nnotes.dll" ( _
Byval Note_Handle As Long, _
Byval Item_Name As String, _
Byval Name_Len As Integer, _
Item_BlockID As BLOCKID, _
Value_DataType As Integer, _
Value_BlockID As BLOCKID, _
Value_Len As Long _
) As Integer

Declare Function NSFItemGetTextListEntries Lib "nnotes.dll" ( _
Byval Note_Handle As Long, _
Byval Item_Name As String _
) As Integer

Declare Function NSFItemGetTextListEntry Lib "nnotes.dll" ( _
Byval Note_Handle As Integer, _
Byval Item_Name As String, _
Byval Entry_Position As Integer, _
Byval Entry_Text As String, _
Byval Text_Len As Integer _
) As Integer

Declare Function NIFFindDesignNote Lib "nnotes.dll" ( _
Byval lFile As Long, _
Byval sName As String, _
Byval iClass As Integer, _
lRetNoteID As Long _
) As Integer

Declare Function NIFOpenCollection Lib "nnotes.dll" ( _
Byval lViewDB As Long, _
Byval lDataDB As Long, _
Byval lViewNoteID As Long, _
Byval iOpenFlags As Integer, _
Byval iUnreadList As Integer, _
iRetCollection As Integer, _
aRetViewNote As Any, _
aRetViewUNID As Any, _
aRetCollapsedList As Any, _
aRetSelectedList As Any _
) As Integer

Declare Function NIFCloseCollection Lib "nnotes.dll" ( _
Byval iCollection As Integer _
) As Integer

Declare Function NIFReadEntries Lib "nnotes.dll" ( _
Byval iCollection As Integer, _
IndexPosition As COLLECTIONPOSITION, _
Byval SkipNavigator As Integer, _
Byval SkipCount As Long, _
Byval ReturnNavigator As Integer, _
Byval ReturnCount As Long, _
Byval ReturnMask As Long, _
lRetBuffer As Long, _
aRetBufferLength As Any, _
aRetNumEntriesSkipped As Any, _
lRetNumEntriesReturned As Long, _
aRetSgnalFlags As Any _
) As Integer

Declare Function NIFGetCollectionData Lib "nnotes.dll" ( _
Byval iCollection As Integer, _
lRetCollection As Long _
) As Integer

' API Windows
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
aDestination As Any, _
aSource As Any, _
Byval lLength As Long _
)


' **********************************************
' ** CTranslate
' **********************************************
Public Class APITranslate
   
   ' ToNative
   Public Function ToNative(sEntreeBuffer As String)
      Dim sSortieBuffer As String
      sSortieBuffer = Space$(256)
      Call OSTranslate(OS_TRANSLATE_LMBCS_TO_NATIVE, sEntreeBuffer, Len(sEntreeBuffer) - 1, sSortieBuffer, Len(sSortieBuffer) - 1)
      ToNative = Left$(sSortieBuffer, Instr(sSortieBuffer, Chr$(0)) - 1)
   End Function
   
   ' ToLMBCS
   Public Function ToLMBCS(sEntreeBuffer As String)
      Dim sSortieBuffer As String
      sSortieBuffer = Space$(256)
      Call OSTranslate(OS_TRANSLATE_NATIVE_TO_LMBCS, sEntreeBuffer, Len(sEntreeBuffer) - 1, sSortieBuffer, Len(sSortieBuffer) - 1)
      ToLMBCS = Left$(sSortieBuffer, Instr(sSortieBuffer, Chr$(0)) - 1)
   End Function
End Class

' **********************************************
' ** CNotesErreur
' **********************************************
Public Class APINotesErreur
   
   Private atTranslate As APITranslate
   
   ' RecupMessageErreur
   Public Function RecupMessageErreur(iEntreeCodeErreur As Integer)
      Dim iCodeErreur As Integer
      Dim sEntreeMessageErreur As String
      Dim sSortieMessageErreur As String
      
      Set atTranslate = New APITranslate
      sEntreeMessageErreur = Space$(255)
      sSortieMessageErreur = Space$(255)
      
      iCodeErreur = iEntreeCodeErreur And &h3fff
      Call OSLoadString(0, iCodeErreur, sEntreeMessageErreur, Len(sEntreeMessageErreur) - 1)
      
      sSortieMessageErreur = atTranslate.ToNative(sEntreeMessageErreur)
      
      RecupMessageErreur = sSortieMessageErreur
   End Function
End Class

' **********************************************
' ** CNotesDatabse
' **********************************************
Public Class APINotesDatabase
   
   Private apNotesErreur As APINotesErreur
   Private lHandleDatabase As Long
   
   ' Ouverture
   Sub New(sNomServeur As String, sNomFichier As String)
      Dim sCheminComplet As String
      Dim iValeurRetour As Integer
      
      Set apNotesErreur = New APINotesErreur
      sCheminComplet = Space$(MAXPATH)
      
      Me.lHandleDatabase = 0
      
      iValeurRetour = OSPathNetConstruct(Byval &h0, sNomServeur, sNomFichier, sCheminComplet)
      
      iValeurRetour = NSFDbOpen(sCheminComplet, Me.lHandleDatabase)
      
      If (iValeurRetour) Then
         Call apNotesErreur.RecupMessageErreur(iValeurRetour)
         Messagebox apNotesErreur.RecupMessageErreur(iValeurRetour), MB_ICONSTOP, "CNotesDatabase : Ouverture"
         Exit Sub
      End If
   End Sub
   
   ' Fermeture
   Sub Delete()
      Dim iValeurRetour As Integer
      
      If (Me.lHandleDatabase <> 0) Then
         iValeurRetour = NSFDbClose(Me.lHandleDatabase)
         If (iValeurRetour) Then
            Call apNotesErreur.RecupMessageErreur(iValeurRetour)
            Messagebox apNotesErreur.RecupMessageErreur(iValeurRetour), MB_ICONSTOP, "CNotesDatabase : Fermeture"
            Exit Sub
         End If
      End If
   End Sub
   
   ' IsOpen
   Public Property Get IsOpen() As Integer
      If (Me.lHandleDatabase <> 0) Then
         IsOpen = True
      Else
         IsOpen = False
      End If
   End Property
   
   ' GetDbHandle
   Public Property Get GetDbHandle() As Long
      GetDbHandle = Me.lHandleDatabase
   End Property
   
   ' GetView
   Public Function GetView(sNomVue As String) As APINotesView
      Dim APIVue As New APINotesView(Me.lHandleDatabase, sNomVue)
      
      If (APIVue.IsOpen()) Then
         Set GetView = APIVue
      Else
         Set GetView = Nothing
      End If
   End Function
   
End Class

' **********************************************
' ** CNotesDocument
' **********************************************
Public Class APINotesDocument
   
   Private apNotesErreur As APINotesErreur
   Private atTranslate As APITranslate
   Private lHandleDatabase As Long
   Private hNote As Long
   
   ' Ouverture
   Sub New(p_hDb, p_lNoteID)
      
      Dim iValeurRetour As Integer
      
      Set Me.apNotesErreur = New APINotesErreur
      Set Me.atTranslate = New APITranslate
      Me.hNote = 0
      
      If (p_lNoteID = 0) Then Exit Sub
      
      iValeurRetour = NSFNoteOpen(p_hDb, p_lNoteID, 0, Me.hNote)
      
      If (iValeurRetour) Then
         
         Call Me.apNotesErreur.RecupMessageErreur(iValeurRetour)
         Messagebox Me.apNotesErreur.RecupMessageErreur(iValeurRetour), MB_ICONSTOP, "APINotesDocument Open"
         
         Exit Sub
      End If
   End Sub
   
   ' Fermeture
   Sub Delete()
      
      Dim iValeurRetour As Integer
      
      If (Me.hNote <> 0) Then NSFNoteClose(Me.hNote)
      
   End Sub
   
   ' IsOpen
   Public Property Get IsOpen() As Integer
      
      If (Me.hNote <> 0) Then
         IsOpen = True
      Else
         IsOpen = False
      End If
   End Property
   
   ' GetItemValue
   Public Function GetItemValue(p_sItemName As String) As Variant
      
      Dim sItemValue As String
      Dim vItemValue
      Dim iValeurRetour As Integer
      Dim iDataType As Integer
      Dim stItemBlockID As BLOCKID
      Dim stValueBlockID As BLOCKID
      Dim lValueLen As Long
      Dim iEntries As Integer
      Dim iCount As Integer
      
      sItemValue = Space$(356)
      
      iValeurRetour = NSFItemInfo(Me.hNote, p_sItemName, Len(p_sItemName), stItemBlockID, iDataType,stValueBlockID, lValueLen)
      
      Select Case (iValeurRetour)
         
      Case NOERROR :
         
         Select Case (iDataType)
            
         Case TYPE_TEXT :
            
            iValeurRetour = NSFItemGetText(Me.hNote, p_sItemName, sItemValue, Lenb(sItemValue))
            
            Redim vItemValue(0 To 0) As String
            vItemValue(0) = Me.atTranslate.ToNative(sItemValue)
            
         Case TYPE_TEXT_LIST :
            
            iEntries = NSFItemGetTextListEntries(Me.hNote, p_sItemName)
            
            Redim vItemValue(0 To 0) As String
            For iCount = 0 To iEntries - 1 Step 1
               
               Call NSFItemGetTextListEntry(Me.hNote, p_sItemName, iCount, sItemValue, Lenb(sItemValue) - 1)
               
               Redim Preserve vItemValue(0 To iCount) As String
               
               vItemValue(iCount) = Me.atTranslate.ToNative(Trim$(sItemValue))
               
            Next iCount
            
         Case TYPE_NUMBER :
            
         Case TYPE_NUMBER_RANGE :
            
         Case TYPE_TIME :
            
         Case TYPE_TIME_RANGE :
            
         End Select
         
         GetItemValue = vItemValue
         
      Case ERR_ITEM_NOT_FOUND :
         
         Redim vItemValue(0 To 0) As String
         vItemValue(0) = ""
         GetItemValue = vItemValue
         
      Case Else
         
         Call Me.apNotesErreur.RecupMessageErreur(iValeurRetour)
         Messagebox Me.apNotesErreur.RecupMessageErreur(iValeurRetour), MB_ICONSTOP, "GetItemValue"
         Exit Function
      End Select
   End Function
End Class

' **********************************************
' ** CNotesView
' **********************************************
Public Class APINotesView
   
   Private apNotesErreur As APINotesErreur
   Private hDb As Long
   Private hCollection As Integer
   Private stCollectionPosition As COLLECTIONPOSITION
   
   ' Ouverture
   Sub New (p_hDb As Long, p_sViewName As String)
      
      Dim iValeurRetour As Integer
      Dim ViewID As Long
      
      Set apNotesErreur = New APINotesErreur
      
      Me.hDb = p_hDb
      Me.hCollection = 0
      
      iValeurRetour = NIFFindDesignNote(p_hDb, p_sViewName, NOTE_CLASS_VIEW, ViewID)
      
      If (iValeurRetour) Then
         Messagebox Me.apNotesErreur.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "NIFFindDesignNote Error"
         Exit Sub
      End If
      
      iValeurRetour = NIFOpenCollection(p_hDb, p_hDb, ViewID, 0, 0, Me.hCollection, Byval &h0, Byval &h0, Byval &h0, Byval &h0)
      If (iValeurRetour) Then
         
         Messagebox Me.apNotesErreur.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "NIFOpenCollection"
         Exit Sub
      End If
   End Sub
   
   ' Fermeture
   Sub Delete()
      
      If (Me.hCollection <> 0) Then NIFCloseCollection(Me.hCollection)
      
   End Sub
   
   ' IsOpen
   Public Property Get IsOpen() As Integer
      If (Me.hCollection <> 0) Then
         IsOpen = True
      Else
         IsOpen = False
      End If
   End Property
   
   ' GetNoteID
   Private Function GetNoteID(p_hCollection As Integer, p_stCollectionPosition As COLLECTIONPOSITION, p_lNoteID As Long) As Integer
      
      Dim iValeurRetour As Integer
      Dim hBuffer As Long
      Dim lNoteID As Long
      Dim lDocCount As Long
      Dim IdList(1 To 1) As Long
      Dim lAddress As Long
      
      GetNoteID = False
      p_lNoteID = 0
      
      Do While (p_lNoteID = 0)
         
         iValeurRetour = NIFReadEntries(p_hCollection, p_stCollectionPosition, NAVIGATE_NEXT, 1, NAVIGATE_NEXT, 1, READ_MASK_NOTEID, hBuffer, Byval &h0, Byval &h0, lDocCount, Byval &h0)
         
         If (iValeurRetour) Then
            
            Messagebox Me.apNotesErreur.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "NIFReadEntries"
            Exit Function
         End If
         
         If (hBuffer = 0) Then
            Exit Do
         End If
         
         lAddress = OSLockObject(hBuffer)
         
         Call MoveMemory(IdList(1), Byval lAddress, Byval 4)
         
         If ((IdList(1) And RRV_DELETED) <> RRV_DELETED) Then
            p_lNoteID = IdList(1)
         End If
         
         OSUnlockObject(hBuffer)
         
         OSMemFree(hBuffer)
      Loop
      
      GetNoteID = True
   End Function
   
   ' GetFirstDocument
   Public Function GetFirstDocument() As APINotesDocument
      
      Dim NDoc As APINotesDocument
      Dim iValeurRetour As Integer
      Dim lNoteID As Long
      
      Me.stCollectionPosition.iLevel = 0
      Me.stCollectionPosition.lTumbler(0) = 0
      
      iValeurRetour = GetNoteID(Me.hCollection, Me.stCollectionPosition, lNoteID)
      
      If (Not iValeurRetour) Then
         Set GetFirstDocument = Nothing
         Exit Function
      End If
      
      Set NDoc = New APINotesDocument(Me.hDb, lNoteID)
      
      If (NDoc.IsOpen) Then
         Set GetFirstDocument = NDoc
      Else
         Set GetfirstDocument = Nothing
      End If
   End Function
   
   ' GetNextDocument
   Public Function GetNextDocument() As APINotesDocument
      
      Dim NDoc As APINotesDocument
      Dim iValeurRetour As Integer
      Dim lNoteID As Long
      
      iValeurRetour = GetNoteID(Me.hCollection, Me.stCollectionPosition, lNoteID)
      
      If (Not iValeurRetour) Then
         Set GetNextDocument = Nothing
         Exit Function
      End If
      
      Set NDoc = New APINotesDocument(Me.hDb, lNoteID)
      If (NDoc.IsOpen) Then
         Set GetNextDocument = NDoc
      Else
         Set GetNextDocument = Nothing
      End If
   End Function
   
   ' Count
   Public Property Get Count() As Long
      
      Dim hCollData As Long
      Dim iValeurRetour As Integer
      Dim lAddress As Long
      Dim stCollectionData As COLLECTIONDATA
      
      count = 0
      
      iValeurRetour = NIFGetCollectionData(Me.hCollection, hCollData)
      
      If (hCollData <> 0) Then
         
         lAddress = OSLockObject(hCollData)
         
         Call MoveMemory(stCollectionData, Byval lAddress, Len(stCollectionData))
         
         Count = stCollectionData.lDocCount
         
         OSUnLockObject hCollData
         
         OSMemFree hCollData
      End If
   End Property
End Class

Cette classe va évoluer au fur à mesure que je trouve d'autre API. En réponse je poste les exemples qui fonctionne sur mon poste (6.5.1).

Si vous avez des fonctions à ajouté n'hésitez pas.

[Stephane Maillard]

Code : Tout sélectionner

Option Public
Option Explicit

Use "API"

' API Notes

Declare Function NIFFindView Lib "nnotes.dll" ( _
Byval hFile As Long, _
Byval sViewName As String, _
lRetNoteID As Long _
) As Integer

Sub Initialize
   Dim NDb As APINotesDatabase
   Dim NNotesError As APINotesErreur
   Dim ViewID As Long
   Dim hCollection As Integer
   Dim stCollectionPosition As COLLECTIONPOSITION
   Dim hBuffer As Long
   Dim lDocCount As Long
   Dim iSignalFlags As Integer
   Dim iReturnValue As Integer
   Dim lCount As Long
   Dim lAddress As Long
   Dim hNote As Long
   Dim sUserName As String
   
   hCollection = 0
   
   Set NDb = New APINotesDatabase("URANUS", "names.nsf")
   
   If (Not NDb.IsOpen) Then Exit Sub
   
   iReturnValue = NIFFindDesignNote(NDb.GetDbHandle, "($People)", NOTE_CLASS_VIEW, ViewID)
   
   If (iReturnValue) Then
      Messagebox NNotesError.RecupMessageErreur(iReturnValue), MB_OK + MB_ICONSTOP, "NIFFindDesignNote Error"
      Exit Sub
   End If
   
   iReturnValue = NIFOpenCollection(NDb.GetDbHandle, NDb.GetDbHandle, ViewID, 0, 0, hCollection, Byval &h0, Byval &h0, Byval &h0, Byval &h0)
   
   If (iReturnValue) Then
      Messagebox NNOtesError.RecupMessageErreur(iReturnValue), MB_OK + MB_ICONSTOP, "NIFOpenCollection"
      Goto Initialize_Error
   End If
   
   stCollectionPosition.iLevel = 0
   stCollectionPosition.lTumbler(0) = 0
   
   iReturnValue = NIFReadEntries(hCollection, stCollectionPosition, NAVIGATE_NEXT, 1, NAVIGATE_NEXT, &hffff, READ_MASK_NOTEID, hBuffer,  Byval &h0, Byval &h0, lDocCount, Byval &h0)
   
   If (iReturnValue) Then
      Messagebox NNotesError.RecupMessageErreur(iReturnValue), MB_OK + MB_ICONSTOP, "NIFReadEntries"
      Goto Initialize_Error
   End If
   
   If (hBuffer <> 0) Then
      Redim IdList(1 To lDocCount) As Long
      lAddress = OSLockObject(hBuffer)
      Call MoveMemory(IdList(1), Byval lAddress, Byval lDocCount * 4)
      For lCount = 1 To lDocCount Step 1
         If ((IdList(lCount) And RRV_DELETED) <> RRV_DELETED) Then
            iReturnValue = NSFNoteOpen(NDb.GetDbHandle, IdList(lCount), 0, hNote)
            
            sUserName = Space$(256)
            iReturnValue = NSFItemGetText(hNote, "FullName", sUserName, Lenb(sUserName))
            sUserName = Left$(sUserName, Instr(sUserName, Chr$(0)) - 1)
            
            Print sUserName
            
            iReturnValue = NSFNoteClose(hNote)
            
         End If
      Next lCount
      
      OSUnlockObject hBuffer
      
      OSMemFree hBuffer
   End If
   
Initialize_Error:
   If (hCollection <> 0) Then NIFCloseCollection(hCollection)
End Sub


[Stephane Maillard]

Code : Tout sélectionner

Sub Initialize
   Dim Db As NotesDatabase
   Dim Vue As NotesView
   Dim Doc As NotesDocument
   
   Set Db = New NotesDatabase("URANUS", "names.nsf")
   
   If (Not Db.IsOpen) Then Exit Sub
   
   Set Vue = Db.GetView("($People)")
   
   Set Doc = Vue.GetFirstDocument
   
   Do While (Not (Doc Is Nothing))
      Print Doc.FullName(0)
      Set Doc = Vue.GetNextDocument(Doc)
   Loop
End Sub

[Stephane Maillard]

Code : Tout sélectionner

Option Public
Option Explicit

Use "API"

Sub Initialize
   Dim NDb As APINotesDatabase
   Dim NView As APINotesView
   Dim NDoc As APINotesDocument
   Dim vItemValue As Variant
   
   Set NDb = New APINotesDatabase("URANUS", "names.nsf")
   
   If (Not NDb.IsOpen) Then Exit Sub
   
   Set NView = NDb.GetView("($People)")
   
   If (NView Is Nothing) Then  Exit Sub
   
   Set NDoc = NView.GetFirstDocument
   
   Do While (Not (NDoc Is Nothing))
      vItemValue = NDoc.GetItemValue("FullName")
      Print vItemValue(0)
      Set NDoc = NView.GetNextDocument()
   Loop
End Sub

[Stephane Maillard]

Code : Tout sélectionner

Option Public
Option Explicit

Use "API"

Type ACL_PRIVILEGES
   BitMask As String * 10
End Type

Public Const ACL_LEVEL_NOACCESS = 0
Public Const ACL_LEVEL_DEPOSITOR = 1
Public Const ACL_LEVEL_READER = 2
Public Const ACL_LEVEL_AUTHOR = 3
Public Const ACL_LEVEL_DESIGNER = 5
Public Const ACL_LEVEL_MANAGER = 6

Public Const ACL_FLAG_AUTHOR_NOCREATE = &h0001
Public Const ACL_FLAG_NODELETE = &h0004
Public Const ACL_FLAG_CREATE_PRAGENT = &h0008
Public Const ACL_FLAG_CREATE_PRFOLDER = &h0010
Public Const ACL_FLAG_CREATE_FOLDER = &h0080
Public Const ACL_FLAG_CREATE_LOTUSSCRIPT = &h0100

Public Const ACL_FLAG_PUBLICREADER = &h0200
Public Const ACL_FLAG_PUBLICWRITER = &h0400

Public Const ACL_FLAG_PERSON = &h0020
Public Const ACL_FLAG_SERVER = &h0002
Public Const ACL_FLAG_GROUP = &h0040
Public Const ACL_FLAG_PERSON_GROUP = ACL_FLAG_PERSON + ACL_FLAG_GROUP
Public Const ACL_FLAG_SERVER_GROUP = ACL_FLAG_SERVER + ACL_FLAG_GROUP

Public Const ACL_UPDATE_NAME = &h01
Public Const ACL_UPDATE_LEVEL = &h02
Public Const ACL_UPDATE_PRIVILIGES = &h04
Public Const ACL_UPDATE_FLAGS = &h08

' API Notes
Declare Function NSFDbReadACL Lib "nnotes.dll" ( _
Byval hDb As Long, _
lRetACL As Long _
) As Integer

Declare Function NSFDbStoreACL Lib "nnotes.dll" ( _
Byval hDb As Long, _
Byval lACL As Long, _
Byval lObjectID As Long, _
Byval iMethod As Integer _
) As Integer

Declare Function ACLAddEntry Lib "nnotes.dll" ( _
Byval lACL As Long, _
Byval sACLName As String, _
Byval iAccessFlags As Integer, _
Privileges As ACL_PRIVILEGES, _
Byval iAccessFlags As Integer _
) As Integer

Declare Function ACLUpdateEntry Lib "nnotes.dll" ( _
Byval lACL As Long, _
Byval aACLName As Any, _
Byval iUpdateFlags As Integer, _
Byval aNewACLName As Any, _
Byval aNewAccessLevel As Any, _
Byval aNewPrivileges As Any, _
Byval aNewAccessFlags As Any _
) As Integer

Declare Function ACLDeleteEntr Lib "nnotes.dll" ( _
Byval lACL As Long, _
Byval sACLName As String _
) As Integer

Sub Initialize
   Dim ErreurNotes As New APINotesErreur
   Dim NDb As APINotesDatabase
   Dim hACL As Long
   Dim stPrivileges As ACL_PRIVILEGES
   Dim iValeurRetour As Integer
   
   Set NDb = New APINotesDatabase("", "names.nsf")
   
   If (Not NDb.IsOpen) Then Exit Sub
   
   iValeurRetour = NSFDbReadACL(NDb.GetDbHandle(), hACL)
   
   If (iValeurRetour) Then
      Messagebox ErreurNotes.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "NSFDbReadACL Error"
      Exit Sub
   End If
   
   stPrivileges.BitMask = String$(10, Chr$(0))
   
   iValeurRetour = ACLAddEntry(hACL, "TestGroup", ACL_LEVEL_MANAGER, stPrivileges, ACL_FLAG_PERSON_GROUP)
   
   If (iValeurRetour) Then
      Messagebox ErreurNotes.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "ACLAddEntry Error"
      Call OSMemFree(hACL)
      Exit Sub
   End If
   
   iValeurRetour = ACLUpdateEntry(hACL, &h0, ACL_UPDATE_LEVEL, Byval &h0, ACL_LEVEL_READER, Byval &h0, Byval &h0)
   
   If (iValeurRetour) Then
      Messagebox ErreurNotes.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "ACLUpdateEntry Error"
      Call OSMemFree(hACL)
      Exit Sub
   End If
   
   iValeurRetour = NSFDbStoreACL(NDb.GetDbHandle(), hACL, 0, 0)
   
   If (iValeurRetour) Then
      Messagebox ErreurNotes.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "NSFDbStoreACL Error"
      Call OSMemFree(hACL)
      Exit Sub
   End If
End Sub

[Stephane Maillard]

Code : Tout sélectionner

Option Public
Option Explicit

Use "API"

Public Const SPECIAL_ID_NOTE = &h8000
Public Const NOTE_CLASS_ACL = &h0040

' API Notes
Declare Function NSFDbCopyACL Lib "nnotes.dll" ( _
Byval lSrcDb As Long, _
Byval lDstDb As Long _
) As Integer

Declare Function NSFDbGetSpecialNoteID Lib "nnotes.dll" ( _
Byval lDb As Long, _
Byval iIndex As Integer, _
lRetNoteID As Long _
) As Integer

Declare Function NSFNoteDelete Lib "nnotes.dll" ( _
Byval Db_Handle As Long, _
Byval Note_Id As Long, _
Byval Update_Flags As Integer _
) As Integer

Sub Initialize
   Dim NotesErreur As APINotesErreur
   Dim nDbFrom As APINotesDatabase
   Dim nDbTo As APINotesDatabase
   Dim iValeurRetour As Integer
   Dim NoteID As Long
   
   Set nDbFrom = New APINotesDatabase("", "names.nsf")
   If (Not nDbFrom.IsOpen) Then Exit Sub
   
   Set nDbTo = New APINotesDatabase("", "test.nsf")
   If (Not nDbTo.IsOpen) Then Exit Sub
   
   iValeurRetour = NSFDbGetSpecialNoteID(nDbTo.GetDbHandle(), SPECIAL_ID_NOTE + NOTE_CLASS_ACL, NoteID)
   
   If (iValeurRetour) Then
      Messagebox NotesErreur.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "NSFDbGetSpecialNoteID Error"
      Exit Sub
   End If
   
   iValeurRetour = NSFNoteDelete(nDbTo.GetDbHandle(), NoteId, 0)
   
   If (iValeurRetour) Then
      Messagebox NotesErreur.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "NSFNoteDelete Error"
      Exit Sub
   End If
   
   iValeurRetour = NSFDbCopyACL(nDbFrom.GetDbHandle(), nDbTo.GetDbHandle())
   
   If (iValeurRetour) Then
      Messagebox NotesErreur.RecupMessageErreur(iValeurRetour), MB_OK + MB_ICONSTOP, "NSFDbCopyACL Error"
      Exit Sub
   End If
End Sub