passing null-terminated string from 3rd party DLL to Microsoft Access 2003

target audience:
    people w/ no control over the DLL-source, unable to change behavior of DLL

    people who don't want to pass an input-parameter to the DLL, which will be filled w/ the result in most other cases

    people who want to call a callback-function/sub inside Access

recommended reading:
http://msdn.microsoft.com/en-us/library/ms811463 or

more reading:

my working sample:
Option Compare Database
Option Explicit

Declare Sub WebGISConn_init Lib "P:\doswin\LDA\IPFLink\20110920\IPFLink.dll" Alias "IPFLink_init" (ByVal WebGISConn_CallBack As Long)
Declare Sub WebGISConn_showFeaturesInIMS Lib "P:\doswin\LDA\IPFLink\20110920\IPFLink.dll" Alias "IPFLink_showFeatureIDStringWithInterfaceInIMS" (ByVal feats As String, ByVal interf As String)

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
' testwrapper for easy call from "immediate window"
Public Sub testWebGIS()
Call initWebGIS
Call openWebGIS(428300001)
End Sub
' this SUB will be called from an external DLL
' e.g. clicked on a button in firefox w/ webgis
Public Sub WebGISConn_CallBack(ByVal interf As Long, ByVal feats As Long)

Dim idList As String
Dim layerInterface As String

On Error Resume Next

Debug.Print "dll is calling ... " & LPSTRtoBSTR(interf) & LPSTRtoBSTR(feats)
' TODO: open form w/ data
End Sub
' open object in browser w/ webgis
Public Sub openWebGIS(ByRef Id As Variant)
Dim idList As String
Dim layerInterface As String

idList = CStr(Id)
layerInterface = "LDA_obertaegigeDenkmale"

Call WebGISConn_showFeaturesInIMS(idList, layerInterface)
End Sub
' init DLL
' register access-callbackfunction
Public Sub initWebGIS()
Call WebGISConn_init(AddressOf WebGISConn_CallBack)
End Sub

' convert C-null-terminated string from DLL to vba BSTR string
Function LPSTRtoBSTR(ByVal lpsz As Long) As String

' Input: a valid LPSTR pointer lpsz
' Output: a sBSTR with the same character array

Dim cChars As Long

' Get number of characters in lpsz
cChars = lstrlenA(lpsz)

' Initialize string
LPSTRtoBSTR = String$(cChars, 0)

' Copy string
CopyMemory ByVal StrPtr(LPSTRtoBSTR), ByVal lpsz, cChars

' Convert to Unicode
LPSTRtoBSTR = Trim0(StrConv(LPSTRtoBSTR, vbUnicode))

End Function

Public Function Trim0(sName As String) As String
' Right trim string at first null.
Dim x As Integer
x = InStr(sName, vbNullChar)
If x > 0 Then Trim0 = Left$(sName, x - 1) Else Trim0 = sName
End Function

No comments:

Post a Comment