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


Class StublessDocumentDeletions
   
   Private db As notesdatabase
   Private hDb As Long
   Private result As Integer
   Private pathName As String * 256
   Private dbFound As Variant
   
   Sub new( d As notesdatabase)
      Set db = d
      If Not db Is Nothing Then
         Call OSPathNetConstruct(0, _
         db.Server, db.FilePath, pathName)
         result = NSFDbOpen(pathName, hDb)
         If (result > 0) Then
            dbFound = False
         Else
            dbFound = True
         End If
      Else
         dbFound = False
      End If
   End Sub
   
   Sub delete()
      If (hDb > 0) Then
         Call NSFDbClose(hDb)
      End If
   End Sub
   
   Public Function databaseFound() As Variant
      ' for convenience, if you want to test 
      ' whether the database was found
      ' before running the deleteDocWithNoStub
      ' function multiple times
      databaseFound = dbFound
   End Function
   
   Public Function deleteDocWithNoStub(_
   doc As notesdocument) As String
      If dbFound Then
         deleteDocWithNoStub = APIStublessDelete(_
         doc.NoteID)
      Else
         deleteDocWithNoStub = "Database was not found!"
      End If
   End Function
   
   Private Function APIStublessDelete (_
   hexNoteId As String) As String
      
%REM
      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)
      
      by Julian Robichaux, http://www.nsftools.com
      with a few mods by John  Vaughan, http://jonvon.net
%END REM
      
      On Error Goto processError
      Dim convertID As Long, s As String
      
      s = "Doc successfully deleted without deletion stub."
      
      '** 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)
      Else
         APIStublessDelete = s
      End If
      
endOfFunction:
      Exit Function
      
processError:
      APIStublessDelete = "Notes error " & _
      Err & " occurred: " & Error$
      Exit Function
      
   End Function
   
   Private 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
   
End Class

Sub Initialize
   
   Dim s As New notessession
   Dim db As notesdatabase
   Dim v As notesview
   Dim doc As notesdocument
   Dim doc2 As notesdocument
   Dim docDeleter As StublessDocumentDeletions
   Dim result As String
   
   Set db = s.getdatabase("","mydb.nsf")
   Set v = db.getview("myview")
   Set doc = v.getfirstdocument
   Set docDeleter = New _
   StublessDocumentDeletions(db)
   
   If docDeleter.databaseFound Then
      ' lets delete all docs from the view, 
      ' leaving no stubs behind
      While Not doc Is Nothing
         Set doc2 = v.getnextdocument(doc)
         result = _
         docDeleter.deleteDocWithNoStub(doc)
         Print result
         Set doc = doc2
      Wend
   End If
   
End Sub