Option Public
Option Explicit


'** Notes C-API functions
Declare Function OSPathNetConstruct Lib "nnotes.dll" (Byval portName As Integer, _
Byval serverName As String, Byval fileName As String, Byval pathName As String) As Integer

Declare Function NSFDbOpen Lib "nnotes.dll" (Byval dbName As String, hDb As Long) As Integer
Declare Function NSFDbClose Lib "nnotes.dll" (Byval hDb As Long) As Integer

Declare Function NSFNoteDelete Lib "nnotes.dll" (Byval hDb As Long, Byval NoteID As Long, _
Byval flags As Integer) As Integer

Declare Function OSLoadString Lib "nnotes.dll" (Byval hModule As Long, Byval stringCode As Integer, _
Byval retBuffer As String, Byval bufferLength As Integer) As Integer

'** Error code masks
Const ERR_MASK = &H3fff
Const PKG_MASK = &H3f00
Const ERRNUM_MASK = &H00ff

'** Notes Update flags
Const UPDATE_FORCE = 0001						'update even if ERR_CONFLICT
Const UPDATE_NAME_KEY_WARNING = 0002	'give error if new field name defined
Const UPDATE_NOCOMMIT = 0004					'do NOT do a database commit after update
Const UPDATE_NOREVISION = 0256				'do NOT maintain revision history
Const UPDATE_NOSTUB = 0512						'update body but leave no trace of note in file if deleted
Const UPDATE_INCREMENTAL = 16384			'Compute incremental note info
Const UPDATE_DELETED = 32768					'update body DELETED


Sub Initialize
	'** a simple test of APIStublessDelete, if you happen to have a NoteID you want to delete
	Dim hexNoteID As String
	hexNoteID = Inputbox$("Please enter a valid NoteID for deletion, using Hex notation:")
	
	If (hexNoteID = "") Then
		Print "Nothing entered. Exiting."
		Exit Sub
	End If
	
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim result As String
	Set db = session.CurrentDatabase
	result = APIStublessDelete(db, hexNoteID)
	
	If (result = "") Then
		Print "Successfully deleted NoteID " & hexNoteID
	Else
		Print result
	End If
End Sub

Function APIStublessDeleteWrapper (doc As NotesDocument) As String
	'** a very simple wrapper around the APIStublessDelete function, if you
	'** just want to pass a NotesDocument as a parameter
	APIStublessDeleteWrapper = APIStublessDelete(doc.ParentDatabase, doc.NoteID)
End Function

Function APIStublessDelete (db As NotesDatabase, hexNoteId As String) As String
	'** This function will attempt to delete a document in a Notes database without
	'** leaving a deletion stub behind. When dealing directly with Notes, you'll generally
	'** get a NoteID as a Hex number (for example, using NotesDocument.NoteID),
	'** so this function expects you to pass a Hex number String as a NoteID.
	'** You can also remove a deletion stub with this function, provided you know its
	'** NoteID (available using NotesPeek or DelStubs)
	
	'** If you plan to do a large number of deletions using this method, you'll probably
	'** want to use NSFDbOpen to open the database, and leave the handle open
	'** during all of your deletions, instead of opening and closing the database
	'** a bunch of times
	
	'** by Julian Robichaux, http://www.nsftools.com
	On Error Goto processError
	
	Dim hDb As Long
	Dim convertID As Long
	Dim pathName As String*256
	Dim result As Integer
	
	'** create a proper network path name with OSPathNetConstruct
	Call OSPathNetConstruct(0, db.Server, db.FilePath, pathName)
	
	'** open the database and get a handle with NSFDbOpen
	result = NSFDbOpen(pathName, hDb)
	If result <> 0 Then
		APIStublessDelete = "Cannot open database " & db.FilePath & " on server " & db.Server & _
		". Error was " & Cstr(result) & ": " & GetAPIError(result)
		Exit Function
	End If
	
	'** convert the NoteID from Hex to Long, and strip off the flag if this is a deletion stub
	convertID = Clng(Val("&H" & hexNoteId)) And &H7FFFFFFF
	
	'** delete the note (using the NoteID of the doc) using UPDATE_NOSTUB to do a "stubless" delete
	result = NSFNoteDelete(hDb, convertID, UPDATE_NOSTUB Or UPDATE_FORCE)
	If result <> 0 Then
		APIStublessDelete = "Unable to delete doc" & _
		". Error was " & Cstr(result) & ": " & GetAPIError(result)
	End If
	
closeDb:
	Call NSFDbClose(hDb)
	
endOfFunction:
	Exit Function
	
processError:
	APIStublessDelete = "Notes error " & Err & " occurred: " & Error$
	If (hDb > 0) Then
		Call NSFDbClose(hDb)
	End If
	Exit Function
	
End Function

Function GetAPIError (errorCode As Integer) As String
	Dim errorString As String*256
	Dim returnErrorString As String
	Dim resultStringLength As Long
	Dim errorCodeTranslated As Integer
	
	'** mask off the top 2 bits of the errorCode that was returned; this is
	'** what the ERR macro in the API does
	errorCodeTranslated = (errorCode And ERR_MASK)
	
	'** get the error code translation using the OSLoadString API function
	resultStringLength = OSLoadString(0, errorCodeTranslated, errorString, Len(errorString) - 1)
	
	'** strip off the null-termination on the string before you return it
	If (Instr(errorString, Chr(0)) > 0) Then
		returnErrorString = Left$(errorString, Instr(errorString, Chr(0)) - 1)
	Else
		returnErrorString = errorString
	End If
	
	GetAPIError = returnErrorString
	
End Function