' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * ' * Refreshing design, callbacks and string conversion (Visual Basic), part II, separate module for callback functions ' * ' * sample code from ' * LotusScript to Lotus C API Programmer Guide by Normunds Kalnberzins, (c) 2000-2003 ' * ' * http://www.ls2capi.com ' * ' * Author: Normunds Kalnberzins ' * ' * This code has been written as a sample to illustrate aspects of handling of Lotus C API from VisualBasic ' * and may be reused, modified on full responsibility of the developer and provided this notice is preserved ' * ' * The author does not guaranty it to fit any particular purpose and it is up to the developer ' * to modify, test it and determine the limits of its applicability ' * ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * * * * * * * * START (Function library) [DBREFRESH_CA ' * * * * * * * * ' * ' * callbacks go into separate public module ' * ' * * * * * * * * START (Const) [OS_TRANSLATE] ' * * * * * * * * ' * Const OS_TRANSLATE_LMBCS_TO_NATIVE = 1 Const OS_TRANSLATE_LMBCS_TO_UNICODE = 20 ' * * * * * * * * END (Const) [OS_TRANSLATE] ' * * * * * * * * ' * * * * * * * * START (Const) [NLS] ' * * * * * * * * ' * Const NLS_CS_ISO88591 = &H20 Const NLS_NONULLTERMINATE = 1 Const NLS_NULLTERMINATE = &H2 Const NLS_STRIPUNKNOWN = &H4 Const NLS_TARGETISLMBCS = &H8 Const NLS_SOURCEISLMBCS = &H10 Const NLS_TARGETISUNICODE = &H20 Const NLS_SOURCEISUNICODE = &H40 Const NLS_TARGETISPLATFORM = &H80 Const NLS_SOURCEISPLATFORM = &H100 Const NLS_NULLTERM% = -1 Const NLS_SIZEOFNULL = 1 Const NLS_MAXBYTESPERCHAR = 3 ' * * * * * * * * END (Const) [NLS] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSLOADSTRING] ' * * * * * * * * ' * Declare Private Sub W32_OSLoadString Lib "nnotes" Alias "OSLoadString" _ (ByVal null1 As Long, ByVal sError As Integer, ByVal errstr As String, _ ByVal LenStr As Integer) ' * * * * * * * * END (Declaration) [W32_OSLOADSTRING] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_NLS_LOAD_CHAR ' * * * * * * * * ' * Declare Private Function W32_NLS_load_charset Lib "nnotes" Alias "NLS_load_charset" (ByVal CSID As Integer, ppInfo As Long) As Integer ' * * * * * * * * END (Declaration) [W32_NLS_LOAD_CHARSE ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_NLS_UNLOAD_CH ' * * * * * * * * ' * Declare Private Function W32_NLS_unload_charset Lib "nnotes" Alias "NLS_unload_charset" (ByVal pInfo As Long) As Integer ' * * * * * * * * END (Declaration) [W32_NLS_UNLOAD_CHAR ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSGETLMBCSCLS ' * * * * * * * * ' * Declare Private Function W32_OSGetLMBCSCLS Lib "nnotes" Alias "OSGetLMBCSCLS" () As Long ' * * * * * * * * END (Declaration) [W32_OSGETLMBCSCLS] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_NLS_TRANSLATE ' * * * * * * * * ' * Declare Private Function W32_NLS_translate Lib "nnotes" Alias "NLS_translate" ( _ ByVal pString As Long, ByVal LenStr As Integer, _ ByVal pStringTarget As String, pSize As Integer, _ ByVal ControlFlags As Integer, ByVal pInfo As Long) As Integer ' * * * * * * * * END (Declaration) [W32_NLS_TRANSLATE] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_ODSREADMEMORY ' * * * * * * * * ' * Declare Private Sub W32_ODSReadMemory Lib "nnotes" Alias "ODSReadMemory" (pSource As Long, ByVal typeODS As Integer, pDest As Any, ByVal Iterations As Integer) ' * * * * * * * * END (Declaration) [W32_ODSREADMEMORY] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSTRANSLATETO ' * * * * * * * * ' * Declare Function W32_OSTranslateToStr Lib "nnotes" Alias "OSTranslate" (ByVal translateMode As Integer, ByVal inBuff As Long, ByVal inLen As Integer, ByVal outBuff As String, ByVal outLen As Integer) As Integer ' * * * * * * * * END (Declaration) [W32_OSTRANSLATETOST ' * * * * * * * * ' * * * * * * * * START (Method) [MSGPROCNLS] ' * * * * * * * * ' * Public Function MsgProcNLS (ByVal pMessage As Long, ByVal mType As Integer) As Integer Dim a As Integer, msg As String * 1024, msgStr As String Dim lenMsg As String, pInfo As Long, iLenMsg As Integer Dim irc As Integer Dim i As Long On Error Resume Next Dim p As Long p = pMessage If Not isNullString(p) Then ' needs some delay For i = 0 To 1000 msgStr = Hex(i) Next i pInfo = W32_OSGetLMBCSCLS msgStr = "*" & Hex(W32_NLS_load_charset(NLS_CS_ISO88591, pInfo)) msg = String$(1024, Chr(0)) ' TRANSLATE using NLS_TRANSLATE irc = W32_NLS_translate(pMessage, NLS_NULLTERM%, msg, 2048, NLS_SOURCEISLMBCS Or NLS_TARGETISPLATFORM, pInfo) If irc <> 0 Then Debug.Print "translate... failed:" & Hex(irc) Debug.Print pMessage, pInfo, "Error%", Hex(irc) ' , getError(irc) Else iLenMsg = InStr(msg, Chr(0)) Debug.Print "NLSTranslate déjà>", Left(msg, iLenMsg) End If W32_NLS_unload_charset pInfo End If End Function ' * * * * * * * * END (Method) [MSGPROCNLS] ' * * * * * * * * ' * * * * * * * * START (Method) [MSGPROCNATIVETOUNICODE ' * * * * * * * * ' * Public Function MsgProcNativeToUnicode (ByVal pMessage As Long, ByVal mType As Integer) As Integer Dim a As Integer, msg As String * 1024, msgStr As String Dim lenMsg As String, pInfo As Long, iLenMsg As Integer Dim irc As Integer On Error Resume Next Dim p As Long p = pMessage If Not isNullString(p) Then msg = String$(1024, Chr(0)) ' init buffer ' TRANSLATE_LMBCS_TO_NATIVE OS_TRANSLATE_LMBCS_TO_UNICODE lenMsg = W32_OSTranslateToStr(OS_TRANSLATE_LMBCS_TO_NATIVE, pMessage, getStringLength(pMessage), msg, 2048) Debug.Print "OSTranslate déjà>", Left(msg, lenMsg) End If End Function ' * * * * * * * * END (Method) [MSGPROCNATIVETOUNICODE] ' * * * * * * * * ' * * * * * * * * START (Method) [ISNULLSTRING] ' * * * * * * * * ' * Public Function isNullString (pBuffer As Long) Dim theByte As Integer, p As Long p = pBuffer W32_ODSReadMemory p, 3, theByte, 1 isNullString = IIf(theByte = 0, True, False) End Function ' * * * * * * * * END (Method) [ISNULLSTRING] ' * * * * * * * * ' * * * * * * * * START (Method) [GETERROR] ' * * * * * * * * ' * Private Function getError (errnum As Integer) As String Dim s As String * 256 W32_OSLoadString 0, errnum And &H3FFFFFFF, s, 256 getError = Left(s, InStr(s, Chr(0))) End Function ' * * * * * * * * END (Method) [GETERROR] ' * * * * * * * * ' * * * * * * * * START (Method) [GETSTRINGLENGTH] ' * * * * * * * * ' * Public Function getStringLength (pBuffer As Long) As Long Dim theByte As Integer, p As Long Dim i As Integer p = pBuffer Do W32_ODSReadMemory p, 3, theByte, 1 i = i + 1 Loop Until theByte = 0 getStringLength = i + 1 End Function ' * * * * * * * * END (Method) [GETSTRINGLENGTH] ' * * * * * * * * ' * * * * * * * * END (Function library) [DBREFRESH_CALL ' * * * * * * * *