Real size of attachments

[Stephane Maillard]

[syntax="ls"]Type BlockID
hPool As Long
Block As Integer
End Type

Const wAPIModule = "NNOTES" ' Windows/32

Declare 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 Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _
( Byval P As String, hDB As Long) As Integer
Declare Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _
( Byval hDB As Long) As Integer
Declare Function NSFNoteOpen Lib wAPIModule Alias "NSFNoteOpen" _
( Byval hDB As Long, Byval N As Long, Byval F As Integer, hNT As Long) As Integer
Declare Function NSFNoteClose Lib wAPIModule Alias "NSFNoteClose" _
( Byval hNT As Long) As Integer
Declare Function OSMemFree Lib wAPIModule Alias "OSMemFree" _
( Byval hM As Long) As Integer
Declare Function OSLoadString Lib wAPIModule Alias "OSLoadString" _
( Byval hM As Long, Byval S As Integer, Byval B As String, Byval nB As Integer) As Integer
Declare Function OSLockObject Lib wAPIModule Alias "OSLockObject" _
( Byval hM As Long) As Long
Declare Sub OSUnlockObject Lib wAPIModule Alias "OSUnlockObject" _
( Byval hM As Long)
Declare Function NSFItemInfo Lib wAPIModule 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 NSFItemInfoNext Lib wAPIModule Alias "NSFItemInfoNext" _
( Byval hNT As Long, Byval hP As Long, Byval B As Integer, Byval N As String, Byval nN As Integer, iB As BlockID _
, D As Integer, vB As BlockID, nV As Long) As Integer
Declare Sub NSFItemQuery Lib wAPIModule Alias "NSFItemQuery" _
( Byval hNT As Long, Byval hP As Long, Byval B As Integer _
, Byval zN As Long, Byval mN As Integer, nN As Integer _
, F As Integer, T As Integer, vB As BlockID, nV As Long)

Declare Function ConvertTIMEDATEToText Lib wAPIModule Alias "ConvertTIMEDATEToText" _
( Byval F As Long, Byval T As Long, Byval P As Long, Byval S As String _
, Byval nS As Integer, rS As Integer) As Integer
Declare Function NSFDbGetObjectSize Lib wAPIModule Alias "NSFDbGetObjectSize" _
( Byval hDB As Long, Byval oID As Long, Byval T As Integer, S As Long _
, C As Integer, P As Integer) As Integer

Declare Sub Peek Lib "KERNEL32" Alias "RtlMoveMemory" _
( D As Any, Byval P As Long, Byval N As Long)
Declare Sub PeekString Lib "KERNEL32" Alias "RtlMoveMemory" _
( Byval D As String, Byval P As Long, Byval N As Long)
Declare Sub CopyLS Lib "KERNEL32" Alias "RtlMoveMemory" _
( D As Any, P As Any, Byval N As Long)


Sub ShowAttachments(doc As NotesDocument)
Dim db As NotesDatabase
Set db = doc.ParentDatabase

dp$ = String(1024, " ")
OSPathNetConstruct 0, db.Server, db.FilePath, dp$

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

Dim hNT As Long
NSFNoteOpen hDB, Clng("&H" & doc.NoteID), 0, hNT
If Not hNT = 0 Then
Dim iB As BlockID, vB As BlockID
NSFItemInfo hNT, "$FILE", 5, iB, dt%, vB, nV&
While Not nV& = 0
NSFItemQuery hNT, iB.hPool, iB.Block, 0, 0, 0, f%, dt%, vB, nV&
ShowFileInfo f%, vB, hDB
NSFItemInfoNext hNT, iB.hPool, ib.Block, "$File", 5, iB, dt%, vB, nV&
Wend
End If
NSFNoteClose hNT

NSFDbClose hDB
End Sub


Sub ShowFileInfo(f%, vB As BlockID, hDB As Long)
Const itemflags = "SIGN SEAL SUMMARY &H08 &H10 READWRITERS NAMES " _
& "&H80 PLACEHOLDER PROTECTED READERS &H0800 UNCHANGED"

If vB.hPool = 0 Then Exit Sub

m$ = "Item flags: " & FlagList(f%, itemflags, "--") & Chr$(10)

p& = OSLockObject(vB.hPool) + vB.Block

Peek nF&, p& + 8, 2
fname$ = String$(nF&, " ")
PeekString fname$, p& + 38, nF&
m$ = m$ & Chr$(10) & "File: " & fname$

Peek fO%, p& + 2, 2
m$ = m$ & Chr$(10) & "Object flags: " _
& Attribute(fO% And &HFF, "FILE 1 2 TODO 4 5 6 7 RUNDATA") _
& " " & FlagList(fO% \ 4096, "&H1000 PUBLIC PRESERVE NOCOPY", "")

Peek hT%, p& + 10, 2
m$ = m$ & Chr$(10) & "Host type: " _
& Attribute(hT%, "MSDOS OLE MAC UNKNOWN HPFS OLELIB BYTEEXT BYTEPAGE CD STREAM LINK")

Peek cT%, p& + 12, 2
m$ = m$ & Chr$(10) & "Compression type: " & FlagList(cT%, "HUFF LZ1", "NONE")

Peek fA%, p& + 14, 2
m$ = m$ & Chr$(10) & "Attributes: " & FlagList(fA%, "READONLY PRIVATE", "-none-")

Peek fF%, p& + 16, 2
m$ = m$ & Chr$(10) & "Flags: " & FlagList(fF%, "SIGN INDOC MIME", "-none-")

Peek fS&, p& + 18, 4
m$ = m$ & Chr$(10) & "Size: " & Cstr(fS&)

Peek dT%, p& + 2, 2
Peek oID&, p& + 4, 4
NSFDbGetObjectSize hDB, oID&, dT%, rS&, fC%, fP%
m$ = m$ & Chr$(10) & "Real size: " & Cstr(rS&)

cdate$ = String$(256, " ")
ConvertTIMEDATEToText 0, 0, p& + 22, cdate$, 256, nc%
m$ = m$ & Chr$(10) & "Created: " & Left$(cdate$, nc%)

mdate$ = String$(256, " ")
ConvertTIMEDATEToText 0, 0, p& + 30, mdate$, 256, nm%
m$ = m$ & Chr$(10) & "Modified: " & Left$(mdate$, nm%)

OSUnlockObject vB.hPool

Messagebox m$, 64, "$FILE"
End Sub


Function FlagList(Byval f%, Byval s$, d$) As String
m% = 1
While m% <= f%
If s$ = "" Then
w$ = "&H" & Hex$(m%)
Else
p% = Instr(s$, " ")
If p% = 0 Then
w$ = s$
s$ = ""
Else
w$ = Left$(s$, p% - 1)
s$ = Mid$(s$, p% + 1)
End If
End If
If Not ((m% And f%) = 0) Then
If Not FlagList = "" Then FlagList = FlagList & " "
FlagList = FlagList & w$
f% = f% And Not m%
End If
m% = m% * 2
Wend
If FlagList = "" Then FlagList = d$
End Function


Function Attribute(f%, Byval s$) As String
For i% = 0 To f%
If s$ = "" Then
w$ = Cstr(f%)
Exit For
Else
p% = Instr(s$, " ")
If p% = 0 Then
w$ = s$
s$ = ""
Else
w$ = Left$(s$, p% - 1)
s$ = Mid$(s$, p% + 1)
End If
End If
Next
Attribute = w$
End Function[/syntax]