All of the program code and information presented in the OpenNTF.org Code Bin are provided "as-is", and should be used at your own risk. OpenNTF.org make no express or implied warranty about anything in the Code Bin, and OpenNTF.org will not be responsible or liable for any damage caused by the use or misuse of anything from this site. OpenNTF.org makes no guarantees about anything. Please thoroughly test all of the knowledge and code you find here before you attempt to use them in your production environment.

Private Type timeDateTYPE
innards(0 To 1) As Long
End Type

Declare Function W32OSLoadString Lib "nnotes" Alias "OSLoadString" ( _
Byval hMod As Long, _
Byval stringCode As Integer, _
Byval retBuff As Lmbcs String, _
Byval buffLen As Integer _
) As Integer

Declare Private Function W32NSFNoteOpen Lib "nnotes" Alias "NSFNoteOpen" ( _
Byval hDb As Long, _
Byval noteID As Long, _
Byval openFlags As Integer, _
hNote As Long _
) As Integer

Declare Private Function W32NSFNoteClose Lib "nnotes" Alias "NSFNoteClose" ( _
Byval hNote As Long _
) As Integer

Declare Private Function W32NSFNoteGetInfo Lib "nnotes" Alias "NSFNoteGetInfo" ( _
Byval hNote As Long, _
Byval noteMember As Integer, _
retValu As Any _
) As Integer

Declare Private Function W32ConvertTIMEDATEToText Lib "nnotes" Alias "ConvertTIMEDATEToText" ( _
Byval intlFmt As Long, _
Byval txtFmt As Long, _
timeDate As timeDateTYPE, _
Byval retBuff As Lmbcs String, _
Byval maxBuffLen As Integer, _
actBuffLen As Integer _
) As Integer

Public Function getAddedToFileDate(pndtAddedInThisFile As NotesDateTime, plngHDb As Long, Byval pstrNoteID As String) As Boolean
'// +++ GLOBAL VARIABLES +++
'// Constants:
'// none
'//
'// Class instances:
'// none
'//
'// 09/23/2004 - Dallas Gimpel
'//
'// DESCRIPTION:
'// This function serves as a wrapper for obtaining the date/time a given Note was added to
'// to its parent database via calls to the C API. The date/time "added" may be the same as
'// the date the note was created but it can also be the date/time the note was received by
'// way of replication. Once value is retrieved, the date/time value is written out to the
'// NotesDateTime object passed. If an API error is encountered, the function attempts to
'// re-throw the error in a more friendly manner via the "getAPIErrorDesc" function.
'//
'// INPUT:
'// plngHDb - Long, an API handle to the target document's parent database
'// pstrNoteID - String, the Note ID of the target document
'//
'// OUTPUT:
'// pndtAddedInThisFile - NotesDateTime, receives date/time the given note was added to its database
'// Function returns a boolean - true unless an error is encountered, otherwise false

On Error Goto errorHandler

Const NOTE_ADDED_TO_FILE% = 13
Const BUFF_LENGTH% = 32 * 3
Dim lngHNote As Long
Dim tdStruct As timeDateTYPE
Dim intRetCode As Integer
Dim intStringLength As Integer
Dim strErrTxt As String
Dim strRetBuff As String * BUFF_LENGTH

getAddedToFileDate = False
pstrNoteID$ = "&H" & pstrNoteID$
intRetCode% = W32NSFNoteOpen(plngHDb&, Clng(pstrNoteID$), 0, lngHNote&)
If Not(intRetCode% = 0) Then
Call getAPIErrorDesc(intRetCode%, strErrTxt$)
Error intRetCode%, strErrTxt$
End If

intRetCode% = W32NSFNoteGetInfo(lngHNote&, NOTE_ADDED_TO_FILE, tdStruct)
If Not(intRetCode% = 0) Then
Call getAPIErrorDesc(intRetCode%, strErrTxt$)
Error intRetCode%, strErrTxt$
End If

intRetCode% = W32ConvertTIMEDATEToText(0&, 0&, tdStruct, strRetBuff$, BUFF_LENGTH, intStringLength%)
If Not(intRetCode% = 0) Then
Call getAPIErrorDesc(intRetCode%, strErrTxt$)
Error intRetCode%, strErrTxt$
End If

Set pndtAddedInThisFile = New NotesDateTime(Left$(strRetBuff$, intStringLength%))
getAddedToFileDate = pndtAddedInThisFile.IsValidDate

functionExit:
If lngHNote& > 0 Then
Call W32NSFNoteClose(lngHNote&)
End If
Exit Function

errorHandler:
Msgbox "Error " & Err & ": " & Error & " encountered at line " & Erl & " of " & Getthreadinfo(1) & ".", , "Error encountered . . ."
Print "Error " & Err & ": " & Error & " encountered at line " & Erl & " . . ."
Resume functionExit
End Function


Private Sub getAPIErrorDesc(pintRetCode As Integer, pstrErrMsg As String)
'// +++ GLOBAL VARIABLES +++
'// Constants:
'//
'//
'// Class instances:
'//
'//
'// 08/09/2002 - Dallas Gimpel
'//
'// DESCRIPTION:
'// This sub takes the unmodified return code returned by an api call and "decodes" it
'// into a less cryptic error number. It then returns the text associated with the given
'// error number by making an api call which loads the text into a string variable. If
'// no text is returned for the given error, it defaults to "unknown error".
'//
'// INPUT:
'// pintRetCode - Integer, the original return code as returned from the api call
'//
'// OUTPUT:
'// pintRetCode - Integer, modified by "Anding" the error mask to it to produce a "kinder & gentler" error
'// pstrErrMsg - String, the text of the error message as returned by the api

Const NULL_HANDLE = 0&
Const ERROR_MASK = &H3fff '// see globerr.h
Const BUFFER_SIZE% = 255
Const UNKOWN_ERR_DESC$ = "unknown error"
Dim intLength As Integer

pstrErrMsg$ = String$(BUFFER_SIZE + 1, 0)
pintRetCode% = pintRetCode% And ERROR_MASK
intLength% = W32OSLoadString(NULL_HANDLE, pintRetCode%, pstrErrMsg$, BUFFER_SIZE)

If intLength% > 0 Then '// if we got a valid error description back, use it
pstrErrMsg$ = Fulltrim(pstrErrMsg$)
Else
pstrErrMsg$ = UNKOWN_ERR_DESC
End If
End Sub

'// USAGE NOTES:
'// Among other uses, this code can be used in the event of a "late replication" event in which a remote user reintroduces old (purged)
'// documents into a database by way of replication. This happens on occasion when a remote user waits more than than a database's
'// purge interval (30 days by default) to replicate. The purge interval is the interval at which deletion stubs are purged from a database.
'// It is 1/3 of the cut off interval, which defaults to 90 days.
'//
'// Since the "getAddedToFileDate" function above takes an api handle to a Notes database as an argument, the example code below,
'// which excludes declarations for the two modules above for brevity, shows a functional example with the api declarations and calls
'// that required but are not included in the code above.
'//
'// To try this code, just place the functions above and the sample code below in a button, agent, etc, and call "main". The "REPLICA_ID"
'// constant below will also need to be replaced with a valid replica id for testing purposes.

Declare Private Function W32OSPathNetConstruct Lib "nnotes" Alias "OSPathNetConstruct" ( _
Byval nullPort As Long, _
Byval server As Lmbcs String, _
Byval filePath As Lmbcs String, _
Byval pathNet As Lmbcs String _
) As Integer

Declare Function W32NSFDbOpen Lib "nnotes" Alias "NSFDbOpen" ( _
Byval dbPath As Lmbcs String, _
hDb As Long _
) As Integer

Declare Function W32NSFDbClose Lib "nnotes" Alias "NSFDbClose" ( _
Byval hDb As Long _
) As Integer

Sub main()
On Error Goto errorHandler

Const REPLICA_ID = "SOME_REPLICA_ID_YOU_CHOOSE"
Dim nsess As NotesSession
Dim ndbSrc As NotesDatabase
Dim dclxnInProcess As NotesDocumentCollection
Dim doc As NotesDocument
Dim ndtAddedInThisFile As NotesDateTime
Dim lngCount As Long
Dim lngHDb As Long
Dim x As Long
Dim intRetCode As Integer
Dim strServer As String
Dim strDbPath As String * 255
Dim strErrTxt As String

Set nsess = New NotesSession()
Set ndbSrc = New NotesDatabase("", "")
Call ndbSrc.OpenByReplicaID(nsess.CurrentDatabase.Server, REPLICA_ID)
Set dclxnInProcess = ndbSrc.AllDocuments

'// Get a server name.
strServer$ = ndbSrc.Server
If nsess.IsOnServer Then
strServer$ = ""
End If

lngCount& = dclxnInProcess.Count
Select Case True
Case (lngCount& = 0)
Print "The search produced no results . . ."
Goto subExit
Case (lngCount& > 50) '// this is just to limit the scope of the example to 50 documents
lngCount& = 50
End Select

'// Construct an API database path & get an API handle to the database.
Call W32OSPathNetConstruct(0, strServer$, ndbSrc.FilePath, strDbPath$)
intRetCode% = W32NSFDbOpen(strDbPath$, lngHDb&)
If Not(intRetCode% = 0) Then
Call getAPIErrorDesc(intRetCode%, strErrTxt$)
Error intRetCode%, strErrTxt$
End If

'// Process the document collection.
Set doc = dclxnInProcess.GetFirstDocument()
For x = 1 To lngCount&
Print "Processing document " & x & " of " & lngCount& & " . . ."
If getAddedToFileDate(ndtAddedInThisFile, lngHDb&, doc.NoteID) Then
If doc.IsValid Then
Call ndtAddedInThisFile.SetAnyTime()
If ndtAddedInThisFile.LSLocalTime > doc.Created Then
'// this is where some action would be taken with the document - just printing to the status bar for the example
Print "Date added (" & Format$(ndtAddedInThisFile.DateOnly, "mm/dd/yyyy") & ") > date created (" & Format$(doc.Created, "mm/dd/yyyy") & ") -- document appears to have been added via replication . . ."
End If
End If
Else
Goto subExit '// an error has occurred
End If
Set doc = dclxnInProcess.GetNextDocument(doc)
Next x

subExit:
If lngHDb& > 0 Then '// always close the database handle
Call W32NSFDbClose(lngHDb&)
End If
Exit Sub

errorHandler:
Msgbox "Error " & Err & ": " & Error & " encountered at line " & Erl & " of " & Getthreadinfo(1) & ".", , "Error encountered . . ."
Print "Error " & Err & ": " & Error & " encountered at line " & Erl & " . . ."
Resume subExit
End Sub