ClearProfiles

[Stephane Maillard]

[syntax="ls"]Const wAPIModule = "NNOTES" ' Windows/32



Const UPDATE_FORCE = 1

Const UPDATE_NOSTUB = &H0200



Declare Private Function IDDeleteTable Lib wAPIModule Alias "IDDeleteTable" _

( Byval hT As Long, Byval hD As Long) As Integer

Declare Private Sub IDDestroyTable Lib wAPIModule Alias "IDDestroyTable" _

( Byval hT As Long)

Declare Private Function IDScan Lib wAPIModule Alias "IDScan" _

( Byval hT As Long, Byval F As Integer, ID As Long) As Integer



Declare Private Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _

( Byval P As String, hDB As Long) As Integer

Declare Private Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _

( Byval hDB As Long) As Integer

Declare Private Function NSFDbGetModifiedNoteTableExt Lib wAPIModule Alias "NSFDbGetModifiedNoteTableExt" _

( Byval hDB As Long, Byval C As Integer, Byval F As Long, Byval S As Currency, U As Currency, hT As Long) As Integer



Declare Private Function NSFNoteDelete Lib wAPIModule Alias "NSFNoteDelete" _

( Byval hDB As Long, Byval N As Long, Byval F As Integer) As Integer



Declare Private Function OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" _

( Byval zP As Long, Byval S As String, Byval F As String, Byval P As String) As Integer



Declare Private Sub TimeConstant Lib wAPIModule Alias "TimeConstant" _

( Byval C As Integer, T As Currency)





Function ClearProfiles(db As NotesDatabase) As Long

With db

np$ = Space(1024)

OSPathNetConstruct 0, db.Server, db.FilePath, np$

End With



Dim hDB As Long

NSFDbOpen np$, hDB



Dim ever As Currency, last As Currency

TimeConstant 2, ever



Dim hT As Long, hD As Long ' all notes, normal notes

NSFDbGetModifiedNoteTableExt hDB, &H7FFF, 8, ever, last, hT

NSFDbGetModifiedNoteTableExt hDB, &H7FFF, 0, ever, last, hD

IDDeleteTable hT, hD ' leave only the profiles



Dim rrv As Long

n& = 0

done = (IDScan(hT, True, rrv) = 0)

While Not done

If rrv > 0 Then

NSFNoteDelete hDB, rrv, UPDATE_FORCE

n& = n& + 1

End If

done = (IDScan(hT, False, rrv) = 0)

Wend



IDDestroyTable hD

IDDestroyTable hT



NSFDbClose hDB



ClearProfiles = n&

End Function[/syntax]