Option Public
Option Declare

Public Const PL_Win32 = 1
Public Const PL_Win64 = 8
Public Const PL_OS2 = 2
Public Const PL_Linux = 4

'====================================== Structures and Classes =============================================
Public Type BLOCKID								'32-bit structure
	pool As Long 									'address of memory
	block As Integer								'offset within this pool		
End Type

Public Type BLOCKID64							'64-bit structure
	pool As Double 								'address of memory
	block As Integer								'offset within this pool		
End Type


'================================== External API Declarations =======================================
' --------------------- WIN functions for work with memory ---------------------
Declare Private Sub W32SetMemBlockValue Lib "kernel32" Alias "RtlMoveMemory"(ByVal dest_mem As Long, src_var As BLOCKID, ByVal byte_count As Long)
Declare Private Sub W64SetMemBlockValue Lib "kernel32" Alias "RtlMoveMemory"(ByVal dest_mem As Long, src_var As BLOCKID64, ByVal byte_count As Long)
Declare Private Sub GetMemString Lib "kernel32" Alias "RtlMoveMemory"(ByVal dest_var As LMBCS String, ByVal src_mem As Long, ByVal byte_count As Integer)

' ----------------------------------------------------------  from internal Lotus dll's
' --------------------- Memory functions ---------------------
Declare Private Function W32OSMemAlloc Lib "nnotes" Alias "OSMemAlloc" (ByVal BlkType As Integer, ByVal dwSize As Long, retHandle As Long) As Integer
Declare Private Function W64OSMemAlloc Lib "nnotes" Alias "OSMemAlloc" (ByVal BlkType As Integer, ByVal dwSize As Long, retHandle As Double) As Integer

Declare Private Function W32OSMemFree Lib "nnotes" Alias "OSMemFree" (ByVal handle As Long) As Integer
Declare Private Function W64OSMemFree Lib "nnotes" Alias "OSMemFree" (ByVal handle As Double) As Integer

Declare Private Function W32OSLockObject Lib "nnotes" Alias "OSLockObject" (ByVal handle As Long) As Long
Declare Private Function W64OSLockObject Lib "nnotes" Alias "OSLockObject" (ByVal handle As Double) As Long

Declare Private Sub W32OSUnlockObject Lib "nnotes" Alias "OSUnlockObject" (ByVal handle As Long)
Declare Private Sub W64OSUnlockObject Lib "nnotes" Alias "OSUnlockObject" (ByVal handle As Double)

Declare Private Function WinNSFDbOpen Lib "nnotes" Alias "NSFDbOpen" (ByVal sDbPath As LMBCS String, hDb As Long) As Integer

Declare Private Function WinNSFDbClose Lib "nnotes" Alias "NSFDbClose" (ByVal hDb As Long) As Integer

' -------------- Note functions ---------------------
Declare Private Function WinNSFNoteOpen Lib "nnotes" Alias "NSFNoteOpen" (ByVal hDb As Long, ByVal noteid As Long, ByVal flags As Long, hNote As Long) As Integer

Declare Private Function WinNSFNoteClose Lib "nnotes" Alias "NSFNoteClose" (ByVal hNote As Long) As Integer

' ------ encrypt/decrypt
Declare Private Function WinNSFNoteDecrypt Lib "nnotes" Alias "NSFNoteDecrypt" (ByVal hNote As Long, ByVal DecryptFlags As Integer, ByVal retKeyForAttachments As Integer) As Integer

' -------------- Item functions ---------------------
Declare Private Function W32NSFItemInfo Lib "nnotes" Alias "NSFItemInfo" (ByVal hNote As Long, ByVal item_name As String, ByVal name_len As Integer, item_blockid As BLOCKID, value_datatype As Integer, value_blockid As Any, value_len As Long) As Integer
Declare Private Function W64NSFItemInfo Lib "nnotes" Alias "NSFItemInfo" (ByVal hNote As Long, ByVal item_name As String, ByVal name_len As Integer, item_blockid As BLOCKID64, value_datatype As Integer, value_blockid As Any, value_len As Long) As Integer

Declare Private Function W32NSFItemInfoNext Lib "nnotes" Alias "NSFItemInfoNext" (ByVal hNote As Long, ByVal prev_blockid_pool As Long, ByVal prev_blockid_block As Long, ByVal item_name As String, ByVal name_len As Integer, item_blockid As BLOCKID, value_datatype As Integer, value_blockid As Any, value_len As Long) As Integer
Declare Private Function W64NSFItemInfoNext Lib "nnotes" Alias "NSFItemInfoNext" (ByVal hNote As Long, ByVal prev_blockid_pool As Double, ByVal item_name As String, ByVal name_len As Integer, item_blockid As BLOCKID64, value_datatype As Integer, value_blockid As Any, value_len As Long) As Integer

Declare Private Function WinOSLoadString Lib "nnotes" Alias "OSLoadString" (ByVal hModule As Long, ByVal StringCode As Integer, ByVal retBuffer As LMBCS String, ByVal BufferLength As Integer) As Integer

Declare Private Sub WinOSPathNetConstruct Lib "nnotes" Alias "OSPathNetConstruct" (ByVal portName As LMBCS String, ByVal ServerName As LMBCS String, ByVal FileName As String, ByVal retPathName As String)

Const NULLHANDLE  = 0

Const TYPE_LONG = 4
Const TYPE_WORD = 2
Const TYPE_OBJECT = 3

Const ITEMTYPE_TEXT = &H500
Const ITEMTYPE_TEXT_LIST = &H501
Const ITEMTYPE_TIME = &H400
Const ITEMTYPE_TIME_LIST = &H401
Const ITEMTYPE_NUMBER = &H300
Const ITEMTYPE_NUMBER_LIST = &H301
Const ITEMTYPE_COMPOSITE = 1

Const OPEN_EXPAND = &H0004  									' expand data while opening 
Const UPDATE_FORCE = &H0001
Const UPDATE_NOSTUB = &H0200									'ключик для NSFNoteDelete;		в AdminTools почему-то было значение &H0201

Const NOTE_OID% = 2 												' number of member (see "NSFNoteGetInfo" function)

Const AGENT_REOPEN_DB = &H10
Const AGENT_SECURITY_ON = &H01

Const SPECIAL_ID_NOTE  =  &H8000								' use in combination w/NOTE_CLASS   when calling NSFDbGetSpecialNoteID 
Const NOTE_CLASS_DOCUMENT = &H0001							' document note 
Const NOTE_CLASS_DATA = NOTE_CLASS_DOCUMENT				' old name for document note 
Const NOTE_CLASS_INFO = &H0002								' notefile info (help-about) note 
Const NOTE_CLASS_FORM = &H0004								' form note 
Const NOTE_CLASS_VIEW = &H0008								' view note 
Const NOTE_CLASS_ICON = &H0010								' icon note 
Const NOTE_CLASS_DESIGN = &H0020								' design note collection 
Const NOTE_CLASS_ACL = &H0040									' acl note 
Const NOTE_CLASS_HELP_INDEX = &H0080						' Notes product help index note 
Const NOTE_CLASS_HELP = &H0100								' designer's help note 
Const NOTE_CLASS_FILTER = &H0200								' filter note 
Const NOTE_CLASS_FIELD = &H0400								' field note 
Const NOTE_CLASS_REPLFORMULA = &H0800						' replication formula 
Const NOTE_CLASS_PRIVATE = &H1000
Const NOTE_CLASS_ALL = &H7fff&

Const ERR_NOT_FOUND_LOCAL = &H404
Const ERR_NOT_FOUND_REMOTE = &H4404
Const ERR_ITEM_NOT_FOUND = &h222
Const ERR_NOTE_NOT_SEALED = &h262

Const DECRYPT_ATTACHMENTS_IN_PLACE = &h1

Const MAXPATH = 256

Const BUFFER_SIZE = 1024
Const MAXDWORD = &hFFFFFFFF
Const MAXWORD = &hFFFF

Const MULTI_SEP = "^"											' multivalue separator (used in apiGetDocItemValue)


'<DECLARATIONS Advapi>
Const DIFF_SIGN_TAG = "~"

Const MAX_ITEMS = 1000

Const ODS_FILEOBJECT = &h3A
Const OBJECT_FILE = 0

'constants for class "Hash"
Const PROV_RSA_FULL = 1
Const CALG_SHA  = &h8004&							'LONG value

Const HP_HASHVAL = 2										

Const CRYPT_VERIFYCONTEXT = &hF0000000			'asquare Crypt context for hashing purpose only
Const BUFF_ARR_DIM = 5								'dimension of array of long for holding result hash

' ================ SecureAPI ================
Declare Private Function W32CryptAcquireContext Lib "Advapi32" Alias "CryptAcquireContextA"(phProv As Long, ByVal pszContainer As LMBCS String, ByVal pszProvider As LMBCS String, ByVal dwProvType As Long, ByVal dwFlag As Long) As Long
Declare Private Function W32CryptCreateHash Lib "Advapi32" Alias "CryptCreateHash"(ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlag As Long, phHash As Long) As Long
Declare Private Function W32CryptHashData Lib "Advapi32" Alias "CryptHashData"(ByVal hHash As Long, ByVal addr_data As Long, ByVal dwSize As Long, ByVal dwFlag As Long) As Long
Declare Private Function W32CryptGetHashParam Lib "Advapi32" Alias "CryptGetHashParam"(ByVal hHash As Long, ByVal dwParam As Long, buffer As Long, dwSize As Long, ByVal dwFlag As Long) As Long
Declare Private Function W32CryptDestroyHash Lib "Advapi32" Alias "CryptDestroyHash"(ByVal hHash As Long) As Long
Declare Private Function W32CryptReleaseContext Lib "Advapi32" Alias "CryptReleaseContext"(ByVal hProv As Long, ByVal dwFlags As Long) As Long

Declare Private Function W64CryptAcquireContext Lib "Advapi32" Alias "CryptAcquireContextA"(phProv As Double, ByVal pszContainer As LMBCS String, ByVal pszProvider As LMBCS String, ByVal dwProvType As Long, ByVal dwFlag As Long) As Long
Declare Private Function W64CryptCreateHash Lib "Advapi32" Alias "CryptCreateHash"(ByVal hProv As Double, ByVal Algid As Long, ByVal hKey As Double, ByVal dwFlag As Long, phHash As Double) As Long
Declare Private Function W64CryptHashData Lib "Advapi32" Alias "CryptHashData"(ByVal hHash As Double, ByVal addr_data As Long, ByVal dwSize As Long, ByVal dwFlag As Long) As Long
Declare Private Function W64CryptGetHashParam Lib "Advapi32" Alias "CryptGetHashParam"(ByVal hHash As Double, ByVal dwParam As Long, buffer As Long, dwSize As Long, ByVal dwFlag As Long) As Long
Declare Private Function W64CryptDestroyHash Lib "Advapi32" Alias "CryptDestroyHash"(ByVal hHash As Double) As Long
Declare Private Function W64CryptReleaseContext Lib "Advapi32" Alias "CryptReleaseContext"(ByVal hProv As Double, ByVal dwFlags As Long) As Long
'</DECLARATIONS Advapi>


Private Const ERR_API_WITH_DESCR = 2222
Private Const ERR_API_WITHOUT_DESCR = 2223
Public Const ERR_API = 3333

Private m_sPlatform As String
Private m_iPlatform As Integer


%REM
	Базовая функциональности для всех классов, работающих с Lotus API
%END REM
Public Class apiBase
	
	Sub New()
		Call getPlatform()
	End Sub
	
	Public Function OSLoadString(hModule As Long, StringCode As Integer, retBuffer As String, BufferLength As Integer) As Integer
		Select Case m_iPlatform
			Case PL_Win32, PL_Win64:
				OSLoadString = WinOSLoadString(hModule, StringCode, retBuffer, BufferLength)
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
	
	%REM
		Build an API-friendly path to the database (i.e., !!)
	%END REM
	Public Sub OSPathNetConstruct(portName As String, ServerName As String, FileName As String, retPathName As String)
		Select Case m_iPlatform
			Case PL_Win32, PL_Win64:
				Call WinOSPathNetConstruct(portName, ServerName, FileName, retPathName)
			Case Else:
				Call throwPlatformError()
		End Select
	End Sub
	
	%REM
		GetCAPIErrorMsg - This function takes a status code returned from a C API call, retrieves the corresponding
		error message from Notes' internal string tables, and returns the string to the caller.
	%END REM
	Public Function GetCAPIErrorMsg(iStatus As Integer) As String
		Const NULLHANDLE = 0&
		Dim rc As Integer
		Dim sBuffer As String
		sBuffer = String$(256, 0)
		'--- get the API error message from the internal Notes/Domino string tables
		rc = Me.OSLoadString(NULLHANDLE, iStatus, sBuffer, Len(sBuffer) - 1)
		If rc > 0 Then
			GetCAPIErrorMsg = Left$(sBuffer, InStr(1, sBuffer, Chr$(0)) - 1)
		Else
			GetCAPIErrorMsg = "Unknown error"
		End If
	End Function
	
	Private Sub throwPlatformError()
		Error ERR_API, "Функция " & GetThreadInfo(10) & " не поддерживается платформой " + m_sPlatform + "!"
	End Sub
	
End Class
Public Class LNMemHandle
	Private m_lPool As Long			'address of memory for 32-bit
	Private m_dPool As Double		'address of memory for 64-bit
	
	Public Function getPool32() As Long
		getPool32 = m_lPool
	End Function
	
	Public Function getPool64() As Double
		getPool64 = m_dPool
	End Function
	
	Public Sub setPool32(lPool As Long)
		m_lPool = lPool
	End Sub
	
	Public Sub setPool64(dPool As Double)
		m_dPool = dPool
	End Sub
	
	Public Function IsEmpty() As Boolean
		Me.IsEmpty = (m_lPool = 0 And m_dPool = 0)
	End Function
	
	Public Sub clear()
		m_lPool = 0
		m_dPool = 0
	End Sub
End Class
Public Class LNMemStruct As LNMemHandle
	Private m_iBlock As Integer
	
	Public Function getBlock() As Integer
		getBlock = m_iBlock
	End Function
	
	Public Sub setBlock(iBlock As Integer)
		m_iBlock = iBlock
	End Sub
	
	Public Sub set32(block As BLOCKID)
		block.pool = m_lPool
		block.block = m_iBlock
	End Sub
	
	Public Sub set64(block As BLOCKID64)
		block.pool = m_dPool
		block.block = m_iBlock
	End Sub
	
	
	Public Sub update32(block As BLOCKID)
		m_lPool = block.pool
		m_iBlock = block.block
	End Sub
	
	Public Sub update64(block As BLOCKID64)
		m_dPool = block.pool
		m_iBlock = block.block
	End Sub
	
	Public Sub clear()
		Call LNMemHandle..clear()
		m_iBlock = 0
	End Sub
End Class
'=========================  Classes for C API objects ===================================
'-------------------------------------------- Database ------------------------------------------------------------------------------------
Class apiDatabase	As apiBase
	Private m_hDb As Long 								'CAPI handle to opened database
	
	Public Sub New(ndb As NotesDatabase)
		Dim sPath As String
		sPath = String$(MAXPATH, 0)
		Call Me.OSPathNetConstruct("", ndb.Server, ndb.FilePath, sPath)		'правильно собираем путь через "!!"
		sPath = Left$(sPath, InStr(1, sPath, Chr$(0)) - 1)
		Call Me.NSFDbOpen(sPath)
	End Sub
	
	Public Sub Close()
		If m_hDb <> 0 Then
			Call Me.NSFDbClose()
			m_hDb = 0
		End If
	End Sub
	
	Public Property Get Handle As Long
		Handle = m_hDb
	End Property
	
	Private Function NSFDbOpen(sDbPath As String) As Integer
		Select Case m_iPlatform
			Case PL_Win32, PL_Win64:
				NSFDbOpen = WinNSFDbOpen(sDbPath, m_hDb)
			Case Else:
				Call throwPlatformError()
		End Select
		Call CheckError(NSFDbOpen)
	End Function
	
	Private Function NSFDbClose() As Integer
		Select Case m_iPlatform
			Case PL_Win32, PL_Win64:
				NSFDbClose = WinNSFDbClose(m_hDb)
			Case Else:
				Call throwPlatformError()
		End Select
		m_hDb = 0
	End Function
	
	Public Function NSFNoteOpen(noteid As Long, flags As Long, hNote As Long) As Integer
		Select Case m_iPlatform
			Case PL_Win32, PL_Win64:
				NSFNoteOpen = WinNSFNoteOpen(m_hDb, noteid, flags, hNote)
			Case Else:
				Call throwPlatformError()
		End Select
		Call CheckError(NSFNoteOpen)
	End Function
	
	
	Public Sub Delete()
		Call Me.Close()
	End Sub
	
End Class
%REM
	Class apiNote
	Description: 
%END REM
Class apiNote As apiBase
	Private m_oDb As apiDatabase
	Private m_nNoteID As Long								'Numeric noteID of note
	Private m_hNote As Long 								'CAPI handle to opened document
	'Private m_OID As OID
	Private m_bOpened As Boolean
	
	%REM
		nd - можно не передавать, если с помощью свойства класса будет установлен NoteID (самая простая инициализация; нужна только для удаления)
		oDb - объект apiDatabase; если не передан, но передан nd, то при bOpenNote = True будет получен автоматом
		bOpenNote - делать NSFNoteOpen для получения полного хендла, иначе будет взят краткий из NotesDocument.Handle
	%END REM
	Public Sub New(nd As NotesDocument, oDb As apiDatabase, bOpenNote As Boolean)
		Set m_oDb = oDb
		If Not nd Is Nothing Then
			m_nNoteID = CLng("&H" + nd.NoteID)
			If bOpenNote Then
				If m_oDb Is Nothing Then Set m_oDb = New apiDatabase(nd.ParentDatabase)
				Call m_oDb.NSFNoteOpen(m_nNoteID, OPEN_EXPAND, m_hNote)
				m_bOpened = True
				Call Me.NSFNoteDecrypt(DECRYPT_ATTACHMENTS_IN_PLACE, 0)		'if doc encrypted it must be decrypted first
			Else
				m_hNote = nd.Handle
			End If
		End If
	End Sub
	
	Public Sub Close()
		If m_hNote <> 0 Then
			If m_bOpened Then Call Me.NSFNoteClose()
			m_hNote = 0
		End If
	End Sub
	
	
	Public Function NSFItemInfo(item_name As String, item_blockS As LNMemStruct, value_datatype As Integer, value_blockS As LNMemStruct, value_len As Long) As Integer
		Dim name_len As Integer
		name_len = Len(item_name)
		If m_iPlatform = PL_Win64 Then
			Dim tIBS64 As BLOCKID64, tVBS64 As BLOCKID64
			NSFItemInfo = W64NSFItemInfo(m_hNote, item_name, name_len, tIBS64, value_datatype, tVBS64, value_len)
			Call item_blockS.update64(tIBS64)
			Call value_blockS.update64(tVBS64)
		Else
			Dim tIBS32 As BLOCKID, tVBS32 As BLOCKID
			Select Case m_iPlatform
			Case PL_Win32:
				NSFItemInfo = W32NSFItemInfo(m_hNote, item_name, name_len, tIBS32, value_datatype, tVBS32, value_len)
			Case Else:
				Call throwPlatformError()
		End Select
			Call item_blockS.update32(tIBS32)
			Call value_blockS.update32(tVBS32)
		End If
		Call CheckError(NSFItemInfo)
	End Function
	
	
	%REM
		Здесь не вызываем CheckError()!
	%END REM
	Public Function NSFItemInfoNext(prev_value_blockS As LNMemStruct, item_name As String, item_blockS As LNMemStruct, value_datatype As Integer, value_blockS As LNMemStruct, value_len As Long) As Integer
		Dim name_len As Integer
		name_len = Len(item_name)
		If m_iPlatform = PL_Win64 Then
			Dim tIBS64 As BLOCKID64, tVBS64 As BLOCKID64
			Call item_blockS.set64(tIBS64)
			Call value_blockS.set64(tVBS64)
			NSFItemInfoNext = W64NSFItemInfoNext(m_hNote, prev_value_blockS.getPool64(), item_name, name_len, tIBS64, value_datatype, tVBS64, value_len)
			Call item_blockS.update64(tIBS64)
			Call value_blockS.update64(tVBS64)
		Else
			Dim tIBS32 As BLOCKID, tVBS32 As BLOCKID
			Call item_blockS.set32(tIBS32)
			Call value_blockS.set32(tVBS32)
			Select Case m_iPlatform
			Case PL_Win32:
				NSFItemInfoNext = W32NSFItemInfoNext(m_hNote, prev_value_blockS.getPool32(), prev_value_blockS.getBlock(), item_name, name_len, tIBS32, value_datatype, tVBS32, value_len)
			Case Else:
				Call throwPlatformError()
		End Select
			Call item_blockS.update32(tIBS32)
			Call value_blockS.update32(tVBS32)
		End If
	End Function
	
	
	Public Function NSFNoteDecrypt(DecryptFlags As Integer, retKeyForAttachments As Integer) As Integer
		Select Case m_iPlatform
			Case PL_Win32, PL_Win64:
				NSFNoteDecrypt = WinNSFNoteDecrypt(m_hNote, DecryptFlags, retKeyForAttachments)
			Case Else:
				Call throwPlatformError()
		End Select
		Select Case NSFNoteDecrypt
			Case 0, ERR_NOTE_NOT_SEALED:
				'ничего не делаем
			Case Else:
				Call CheckError(NSFNoteDecrypt)
		End Select
	End Function
	
	Public Function NSFNoteClose() As Integer
		Select Case m_iPlatform
			Case PL_Win32, PL_Win64:
				NSFNoteClose = WinNSFNoteClose(m_hNote)
			Case Else:
				Call throwPlatformError()
		End Select
		Call CheckError(NSFNoteClose)
	End Function
	
	
	Public Sub Delete()
		Call Me.Close()
	End Sub
	
End Class
Public Class LNMemBase As apiBase
	
	Public Function OSMemAlloc(BlkType As Integer, dwSize As Long, retMemHandle As LNMemHandle) As Integer
		Dim lHandle As Long
		Select Case m_iPlatform
			Case PL_Win32:
				OSMemAlloc = W32OSMemAlloc(BlkType, dwSize, retMemHandle.getPool32())
			Case PL_Win64:
				OSMemAlloc = W64OSMemAlloc(BlkType, dwSize, retMemHandle.getPool64())
			Case Else:
				Call throwPlatformError()
		End Select
		Call CheckError(OSMemAlloc)
	End Function
	
	Public Function OSLockObject(mH As LNMemHandle) As Long
		Select Case m_iPlatform
			Case PL_Win32:
				OSLockObject = W32OSLockObject(mH.getPool32())
			Case PL_Win64:
				OSLockObject = W64OSLockObject(mH.getPool64())
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
	
	Public Sub OSUnlockObject(mH As LNMemHandle)
		Select Case m_iPlatform
			Case PL_Win32:
				Call W32OSUnlockObject(mH.getPool32())
			Case PL_Win64:
				Call W64OSUnlockObject(mH.getPool64())
			Case Else:
				Call throwPlatformError()
		End Select
	End Sub
	
	Public Function OSMemFree(mH As LNMemHandle) As Integer
		Select Case m_iPlatform
			Case PL_Win32:
				OSMemFree = W32OSMemFree(mH.getPool32())
			Case PL_Win64:
				OSMemFree = W64OSMemFree(mH.getPool64())
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
	
	%REM
		Windows only! :(
	%END REM
	Public Sub GetStringFromMemory(dest_var As String, src_mem As Long, byte_count As Integer)
		Select Case m_iPlatform
			Case PL_Win32, PL_Win64:
				Call GetMemString(dest_var, src_mem, byte_count)
			Case Else:
				Call throwPlatformError()
		End Select
	End Sub
	
End Class
%REM
	Hash object;
	works by Windows Advapi32.dll
%END REM
Public Class Hash As apiBase
	Private m_hlHash As Long
	Private m_hdHash As Double
	Private m_hlProv As Long
	Private m_hdProv As Double
	Private arrBuffer(BUFF_ARR_DIM - 1) As Long
	
	
	Public Sub New()
		Call CheckErrorWinAPI(CryptAcquireContext())
		Call CheckErrorWinAPI(CryptCreateHash())
	End Sub
	
	Public Sub Delete()
		If m_hlHash <> 0 Or m_hdHash <> 0 Then Call CryptDestroyHash()
		If m_hlProv <> 0 Or m_hdProv <> 0 Then Call CryptReleaseContext()
	End Sub
	
	Public Sub UpdateHash(a_ptr As Long, a_size As Long)
		Call CheckErrorWinAPI(CryptHashData(a_ptr, a_size))
	End Sub
	
	Public Function GetFinalHash() As String		
		Call CheckErrorWinAPI(CryptGetHashParam())
		GetFinalHash = Hex$(arrBuffer(0)) + Hex$(arrBuffer(1)) + Hex$(arrBuffer(2)) + Hex$(arrBuffer(3)) + Hex$(arrBuffer(4))
	End Function
	
	Private Function CryptAcquireContext() As Long
		Select Case getPlatform()
			Case PL_Win32:
				CryptAcquireContext = W32CryptAcquireContext(m_hlProv, "", "", PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)
			Case PL_Win64:
				CryptAcquireContext = W64CryptAcquireContext(m_hdProv, "", "", PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
	
	Private Function CryptCreateHash() As Long
		Select Case getPlatform()
			Case PL_Win32:
				CryptCreateHash = W32CryptCreateHash(m_hlProv, CALG_SHA , 0, 0, m_hlHash)
			Case PL_Win64:
				CryptCreateHash = W64CryptCreateHash(m_hdProv, CALG_SHA , 0, 0, m_hdHash)
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
	
	%REM
		Function CryptDestroyHash
		Description: destroy hash object
	%END REM
	Private Function CryptDestroyHash() As Long
		Select Case getPlatform()
			Case PL_Win32:
				CryptDestroyHash = W32CryptDestroyHash(m_hlHash)
			Case PL_Win64:
				CryptDestroyHash = W64CryptDestroyHash(m_hdHash)
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
	
	%REM
		Function CryptReleaseContext
		Description: destroy (release) context
	%END REM
	Private Function CryptReleaseContext() As Long
		Select Case getPlatform()
			Case PL_Win32:
				Call W32CryptReleaseContext(m_hlProv, 0)
			Case PL_Win64:
				Call W64CryptReleaseContext(m_hdProv, 0)
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
	
	%REM
		Function CryptHashData
		Description: add data to hash object
	%END REM
	Private Function CryptHashData(a_ptr As Long, a_size As Long) As Long
		Select Case getPlatform()
			Case PL_Win32:
				CryptHashData = W32CryptHashData(m_hlHash, a_ptr, a_size, 0)
			Case PL_Win64:
				CryptHashData = W64CryptHashData(m_hdHash, a_ptr, a_size, 0)
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
	
	Private Function CryptGetHashParam() As Long
		Select Case getPlatform()
			Case PL_Win32:
				CryptGetHashParam = W32CryptGetHashParam(m_hlHash, HP_HASHVAL, arrBuffer(0), BUFF_ARR_DIM * Len(arrBuffer(0)), 0)
			Case PL_Win64:
				CryptGetHashParam = W64CryptGetHashParam(m_hdHash, HP_HASHVAL, arrBuffer(0), BUFF_ARR_DIM * Len(arrBuffer(0)), 0)
			Case Else:
				Call throwPlatformError()
		End Select
	End Function
End Class
'------------------- CLASS: Lotus Notes Memory BLOCK
Public Class LNMemBlock As LNMemBase
	Private m_blockID As LNMemStruct
	Private m_bIsLocked As Boolean
	Private m_ptr As Long
	
	Public Sub New(a_blockID As LNMemStruct)
		Set m_blockID = a_blockID
		m_ptr = NULLHANDLE
		m_bIsLocked = False
	End Sub
	
	Public Function OSLockBlock(block_id As LNMemStruct) As Long
		Dim mH As New LNMemHandle
		If m_iPlatform = PL_Win64 Then
			Call mH.setPool64(block_id.getPool64())
		Else
			Call mH.setPool32(block_id.getPool32())
		End If
		OSLockBlock = Me.OSLockObject(mH) + (block_id.getBlock() And 65535)	'make unsigned value if block_id.block < 0
	End Function
	
	Public Sub OSUnlockBlock(block_id As LNMemStruct)
		Call Me.OSUnlockObject(block_id)
	End Sub
	
	
	Public Function Lock() As Long
		If Not m_bIsLocked Then
			m_ptr = Me.OSLockBlock(m_blockID) + TYPE_WORD
			m_bIsLocked = True
		End If
		Me.Lock = m_ptr
	End Function
	
	Public Sub Unlock()
		If m_bIsLocked Then
			Call Me.OSUnlockBlock(m_blockID)
			m_bIsLocked = False
		End If
	End Sub
	
	Property Get Pointer As Long											' <=== Get pointer to locked memory
		Pointer = m_ptr
	End Property
	
	Sub Delete()
		Call Me.Unlock()
	End Sub
End Class
Sub Initialize
	Dim sHash As String
	Dim sItemName As String
	
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Set db = session.currentdatabase
	
	Const UNID = "88AC79D3F5729BFDC225822D005244CF"
	sItemName = "fdShortDescr"
	
	Dim doc As NotesDocument
	Set doc = db.Getdocumentbyunid(UNID)
	
	Dim apiDb As New apiDatabase(db)
	Dim apiDoc As New apiNote(doc, apiDb, False)
	
	Dim oAllHash As New Hash
	
	Dim prevItemBlockID As LNMemStruct, itemBlockID As New LNMemStruct, valueBlockID As New LNMemStruct
	Dim nValueDataType As Integer
	Dim nValueLen As Long
	Dim rc As Integer
	
	Call apiDoc.NSFItemInfo(sItemName, itemBlockID, nValueDataType, valueBlockID, nValueLen)
	
	Call AddItemValue2Hash(oAllHash, valueBlockID, nValueLen)
	
	Set prevItemBlockID = itemBlockID
	rc = apiDoc.NSFItemInfoNext(prevItemBlockID, sItemName, itemBlockID, nValueDataType, valueBlockID, nValueLen)
	
	If rc <> ERR_ITEM_NOT_FOUND Then
		If rc = 0 Then
			Call AddItemValue2Hash(oAllHash, valueBlockID, nValueLen)
		Else
			Call CheckError(rc)
		End If
	End If
	
	sHash = oAllHash.GetFinalHash()
	
	If Not session.IsOnServer Then
		MsgBox sHash,, "Hash"
	Else
		Print "Hash: " & sHash
	End If
	
End Sub
%REM
	returns zero unless returncode is non-zero in which case it throws an error
%END REM
Sub CheckError(rc As Integer)
	If rc <> 0 Then	
		Dim sBuffer As String * BUFFER_SIZE
		Dim nRetLength As Integer
		Dim sess As New NotesSession
		
		Dim api As New apiBase
		nRetLength = api.OSLoadString(NULLHANDLE, rc And &H3FFF, sBuffer, BUFFER_SIZE)
		
		If nRetLength > 0 Then
			Dim nErrCode As Integer, sErrText As String
			nErrCode = ERR_API_WITH_DESCR
			sErrText = Left(sBuffer, nRetLength)
			Select Case rc
			Case ERR_ITEM_NOT_FOUND:
				nErrCode = ERR_ITEM_NOT_FOUND
			Case 2567, -32355:
				'подмена идиотских кодов ошибок на наш, нормально обрабатываемый
				'Err = 2567   - Network operation did not complete in a reasonable amount of time; please retry
				'Err = -32355 - Ошибка "Операция остановлена по запросу пользователя"
				rc = 1221
			Case 549, 4000:
				If InStr(sErrText, "Неверный или несуществующий документ") <> 0 Or _
				InStr(sErrText, "Invalid or nonexistent document") <> 0 Then
					'Возможные варианты см. в обёртке Tools_Base.save()
					nErrCode = 4406		'NOTES_ERR_DOCUMENT_MISSING
				End If
			End Select
			Error nErrCode, "API Error: " + sErrText + " {" & rc & "}"
		Else
			Error ERR_API_WITHOUT_DESCR, Hex$(rc)
		End If		
	End If
End Sub

Private Sub AddItemValue2Hash(oHash As Hash, valueBlockID As LNMemStruct, nValueIDLen As Long)
	Dim oData As New LNMemBlock(valueBlockID)
	Call oHash.UpdateHash(oData.Lock(), nValueIDLen - 2)
End Sub

Public Function getPlatform() As Integer
	If m_iPlatform = 0 Then
		Dim ns As New NotesSession
		Select Case ns.Platform
		Case "Windows/32":
			m_iPlatform = PL_Win32
		Case	"Windows/64":
			m_iPlatform = PL_Win64
		Case "OS/2v2":
			m_iPlatform = PL_OS2
		Case "Linux":
			m_iPlatform = PL_Linux
		End Select
	End If
	getPlatform = m_iPlatform
End Function

Sub CheckErrorWinAPI(rc As Long)
	If rc = 0 Then Error ERR_API, "Ошибка при вызове API-функции."
End Sub