Page 1 sur 1

Expand Groups

MessagePublié: 01 Août 2005 à 13:16
par Stephane Maillard
[syntax="ls"]Const TYPE_TEXT = &H0500
Const TYPE_TEXT_LIST = &H0501

Type BlockID
hPool As Long
Block As Integer
End Type

Const APIModule = "NNOTES" ' Windows

Declare Function OSPathNetConstruct Lib APIModule Alias "OSPathNetConstruct" _
( Byval NullPort As Long, Byval Server As String, Byval FIle As String, Byval PathNet As String) As Integer
Declare Function NSFDbOpen Lib APIModule Alias "NSFDbOpen" _
( Byval PathName As String, DbHandle As Long) As Integer
Declare Function NSFDbClose Lib APIModule Alias "NSFDbClose" _
( Byval DbHandle As Long) As Integer

Declare Function NSFNoteOpen Lib APIModule Alias "NSFNoteOpen" _
( Byval DbHandle As Long, Byval NoteID As Long, Byval F As Integer, hNT As Long) As Integer
Declare Function NSFNoteUpdate Lib APIModule Alias "NSFNoteUpdate" _
( Byval hNT As Long, Byval F As Integer) As Integer
Declare Function NSFNoteClose Lib APIModule Alias "NSFNoteClose" _
( Byval hNT As Long) As Integer

Declare Function OSMemAlloc Lib APIModule Alias "OSMemAlloc" _
( Byval T As Integer, Byval N As Long, hM As Long) As Integer
Declare Function OSMemFree Lib APIModule Alias "OSMemFree" _
( Byval Handle As Long) As Integer

Declare Function OSLockObject Lib APIModule Alias "OSLockObject" _
( Byval H As Long) As Long
Declare Sub OSUnlockObject Lib APIModule Alias "OSUnlockObject" _
( Byval H As Long)

Declare Function NSFItemInfo Lib APIModule Alias "NSFItemInfo" _
( Byval hNT As Long, Byval N As String, Byval nN As Integer _
, iB As BlockID, D As Integer, vB As BlockID, nV As Long) As Integer
Declare Function NSFItemDelete Lib APIModule Alias "NSFItemDelete" _
( Byval hNT As Long, Byval N As String, Byval nN As Integer) As Integer
Declare Function NSFItemAppend Lib APIModule Alias "NSFItemAppend" _
( Byval hNT As Long, Byval F As Integer, Byval N As String, Byval nN As Integer _
, Byval T As Integer, Byval pV As Long, Byval nV As Long) As Integer

Declare Function ListAllocate Lib APIModule Alias "ListAllocate" _
( Byval N As Integer, Byval S As Integer, Byval T As Integer _
, hL As Long, pL As Long) As Integer
Declare Function ListAddText Lib APIModule Alias "ListAddText" _
( Byval pL As Long, Byval T As Integer, Byval N As Integer _
, Byval S As Long, Byval nS As Integer) As Integer

Declare Function MailExpandNames Lib "NNOTES" Alias "MailExpandNames" _
( Byval hL As Long, Byval nL As Integer, hE As Long, nE As Integer _
, Byval U As Integer, Byval zA As Long) As Integer

Declare Function CopyMemory Lib "MSVCRT" Alias "memcpy" _
( Byval D As Long, Byval S As Long, Byval B As Long) As Long

Sub Click(Source As Button)
Const sourceItem = "Recipients"
Const targetItem = "Expanded"

Dim workspace As New NotesUIWorkspace

Dim uidoc As NotesUIDocument
Set uidoc = workspace.CurrentDocument
If uidoc.EditMode Then uidoc.Save

Dim doc As NotesDocument
Set doc = uidoc.Document

Dim db As NotesDatabase
Set db = doc.ParentDatabase

pn$ = Space(1024)
OSPathNetConstruct 0, db.Server, db.FilePath, pn$

Dim hDB As Long
NSFDbOpen pn$, hDB
If hDB = 0 Then Exit Sub

Dim hNT As Long
NSFNoteOpen hDB, Clng("&H" & doc.NoteID), 0, hNT

Dim iB As BlockID, vB As BlockID
NSFItemInfo hNT, sourceItem, Len(sourceItem), iB, dt%, vB, nV&

If dt% = TYPE_TEXT_LIST Or dt% = TYPE_TEXT Then
Dim hM As Long
ps& = OSLockObject(vB.hPool) + vB.Block

Select Case dt%
Case TYPE_TEXT_LIST :
OSMemAlloc 0, nV&, hM
pd& = OSLockObject(hM)
CopyMemory pd&, ps&, nV&
Case TYPE_TEXT :
ListAllocate 1, nV& - 2, True, hM, pM&
ListAddText pM&, True, 0, ps& + 2, nV& - 2
End Select

OSUnlockObject hM
OSUnlockObject vB.hPool

Dim hE As Long
MailExpandNames hM, nV&, hE, ne%, 0, 0

pe& = OSLockObject(hE)
NSFItemDelete hNT, targetItem, Len(targetItem)
NSFItemAppend hNT, 4, targetItem, Len(targetItem), TYPE_TEXT_LIST, pe& + 2, Clng(ne% - 2)
OSUnlockObject hE
OSMemFree hE

NSFNoteUpdate hNT, 1
Else
Messagebox "Item " & sourceItem & " is not text"
End If

NSFNoteClose hNT
NSFDbClose hDB

uidoc.Close
End Sub[/syntax]