How to get String from Pointer in VB

[maheshkurmi]

Hi Guys
I am trying to stream mp3s from internet using FMOD 3.75 engine, for NeoPlayer I recently submitted at VBforum.
http://www.vbforums.com/showthread.php?t=642683
Fmod sends information about streaming data through call back function as as shown (C++ Decalaration)

FSOUND_METADATACALLBACK
Callback to receive a new piece of metadata from an internet stream
signed char F_CALLBACKAPI FSOUND_METADATACALLBACK(
char *name,
char *value,
void *userdata
);
Parameters
name Pointer to the name of the piece of metadata (null-terminated ASCII string)
value Pointer to the metadata (null-terminated ASCII string)
userdata Userdata that was specified in FSOUND_Stream_Net_SetMetadataCallback
Return ValueCurrently ignored


CPP Code for callback function

signed char F_CALLBACKAPI metacallback(char *name, char *value, void *userdata)
{
    if (!strcmp("ARTIST", name))
    {
        strcpy(artist, value);
        return TRUE;
    }

    if (!strcmp("TITLE", name))
    {
        strcpy(title, value);
        metanum++;
        return TRUE;
    }

    return TRUE;
}

//EVERYTHING WORKS FINE IN CPP (no error ever occurred)

My VB Code

Private Declare Function ConvCStringToVBString Lib "kernel32" Alias "lstrcpyA" (ByVal lpsz As String, ByVal pt As Long) As Long   
 
Public Function GetStringFromPointer(ByVal lpString As Long) As String
      Dim NullCharPos As Long
      Dim szBuffer As String
      szBuffer = String(255, 0) 
      ‘ I have tried increasing size of buffer even then it crashes sometimes
      ConvCStringToVBString szBuffer, lpString
      ' Look for the null char ending the C string
      NullCharPos = InStr(szBuffer, vbNullChar)
      GetStringFromPointer = Left(szBuffer, NullCharPos - 1)
 
End Function

But in VB application crashes many times, (it works many times as well), Kindly help me ...Please correct the VBcode, I think Icould't use pointers in VB properly.
Regards to all

[VBClassicRocks]

This should work for any length:

Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function StrFromPtr(ByVal lpStr As Long) As String
 Dim bStr() As Byte
 Dim cChars As Long
 On Error Resume Next
 ' Get the number of characters in the buffer
 cChars = lstrlen(lpStr)
 If cChars Then
  ' Resize the byte array
  ReDim bStr(0 To cChars - 1) As Byte
  ' Grab the ANSI buffer
  Call CopyMemory(bStr(0), ByVal lpStr, cChars)
 End If
 ' Now convert to a VB Unicode string
 StrFromPtr = StrConv(bStr, vbUnicode)
End Function

[maheshkurmi]

Thanks "VBclassivRocks" for the reply and valuable time u spent for the code.
But it is also not working properly, problem remains same, sometimes it works sometimes it crashes, I am soon attaching code so that u can better understand my problem.
Again thanks a lot.

[LaVolpe]

Could this be a c_Decl vs. c_StdCall issue. Does the C++ dll use standard call? VB expects c_StdCall and how memory is cleaned up depends on type of call.

[maheshkurmi]

Nice to get reply from u LAvolpe
this is VB Code that i am using

'this declaration is to set callback function
Public Declare Function FSOUND_Stream_Net_SetMetadataCallback Lib "fmod.dll" Alias "_FSOUND_Stream_Net_SetMetadataCallback@12" (ByVal Stream As Long, ByVal Callback As Long, ByVal userdata As Long) As Byte

Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal lpString As String) As Long
Private Declare Function lstrlen Lib "kernel32.dll" (ByVal lpString As String) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ConvCStringToVBString Lib "kernel32" Alias "lstrcpyA" (ByVal lpsz As String, ByVal pt As Long) As Long

'Pointer validation in StringFromPointer
Declare Function IsBadStringPtrByLong Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long


'this is function to set callback procedure
Call FSOUND_Stream_Net_SetMetadataCallback(Stream, AddressOf FSOUND_METADATACALLBACK, 0)

'This is callback function
Public Sub FSOUND_METADATACALLBACK(ByVal lpName As Long, ByVal Value As Long, ByVal userdata As Long)
     Debug.Print GetStringFromPointer(lpName) & GetStringFromPointer(Value)
End Sub


'This is to get string from pointer
Public Function GetStringFromPointer(ByVal lpString As Long) As String
    Dim NullCharPos As Long
    Dim szBuffer As String
    If IsBadStringPtrByLong(lpString, 1024) Then
        '\\ An error has occured - do not attempt to use this pointer
        Debug.Print "Attempt to read bad string pointer: " & lpString
        GetStringFromPointer = "xxxxx"
        Exit Function
    End If
    szBuffer = String$(1024, Chr(0))
    ConvCStringToVBString szBuffer, lpString
    'Look for the null char ending the C string
    NullCharPos = InStr(szBuffer, vbNullChar)
    GetStringFromPointer = Left(szBuffer, NullCharPos - 1)
End Function

This code works sometimes but sometimes crashes IDE, even I cant trap error.
But in C++ the metadatacallback works quite well (using Visual C++),which i think because fmod is designed keeping only C++ in mind. Would u plz tell me if it is problem of declaration if yes then please let me know how to Convert 'cdecl' to 'stdcall' function from VB6‎
Thanks a lot....from ur fan: mahesh kurmi

[Merri]

If it is of any value, you can create a new BSTR with ANSI to Unicode conversion using a single API call:

Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As String

So code posted by VBClassicRocks would shorten to:

Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As String

Public Function StrFromPtr(ByVal lpStr As Long) As String
	StrFromPtr = SysAllocStringByteLen(lpStr, lstrlen(lpStr))
End Function

You may even want to call it directly instead of wrapping into a function

[LaVolpe]

I think Merri's solution will also cause random crashes if VBClassicRocks solution also crashed at times. My gut feeling is that the DLL is using c_Decl calling conventions. You should be able to find that info within the source.

VB cannot call cDECL functions correctly becuase it doesn't expect them. A hack/workaround is needed.
For example, zLIB.DLL was extremely popular before GDI+ came about. That DLL allowed us VBers to encode/decode PNG files, but it was written with cDECL conventions. Some nice souls out there converted the DLL to c_StdCall so we can use them in VB like other common APIs. Maybe the same thing applies here? Is there a c_STDCALL version of F_MOD?

Here is a link to a planetsourcecode project that uses Assembly to allow VB to call c_DECL functions. I can vouch for the author -- very good coder.

[maheshkurmi]

thanks again labolpe
I think u r right( actually u can never be wrong) the problem is in fmod callback itself.
I removed all code from FMOD_metadatacalllback still vb IDE crashes often. everything works fine if nocallback function is used, I.e. I donot set my callback function to receive metadata. also there is no error in streaming. also vbclassicrocks code works like charm in other cases(other than fmod callback).
thanks to all coders who responded. keep it up...

[LaVolpe]

Oh, wait a minute. Are you sure? Is the callback supposed to be Sub or Function with return value of Long/Boolean? You may want to play with that. I'd try these two first, in order of preference:

Public Function FSOUND_METADATACALLBACK(ByVal lpName As Long, ByVal Value As Long, ByVal userdata As Long) As Long
     ' Debug.Print GetStringFromPointer(lpName) & GetStringFromPointer(Value)
End Function 

... or ....

Public Function FSOUND_METADATACALLBACK(ByVal lpName As Long, ByVal Value As Long, ByVal userdata As Long) As Boolean
     ' Debug.Print GetStringFromPointer(lpName) & GetStringFromPointer(Value)
End Function

From a quick read on the function, it appears the return value is ignored.

If your project with the adjusted callback above stops crashing; then play with the string pointers.

[Merri]

I think Merri's solution will also cause random crashes if VBClassicRocks solution also crashed at times.

True; I only provided it as a shorter, cleaner & faster working solution


A rarity considering my codes often are the longest suggestions

[LaVolpe]

Merri. I like your solution. I've never used that API in my coding. Does it handle ANSI byte array to Unicode and also Unicode byte array to Unicode, or are there different calls?

Maheshkurmi. I've got this from one site:

typedef signed char (F_CALLBACKAPI *FSOUND_METADATACALLBACK)(char *name, char *value, int userdata);

Not familiar enough with the language to determine if return value should be long, boolean, byte. But it certainly appears the callback should be function vs. sub. Declaring callback incorrectly will result in crashes too.

[Merri]

LaVolpe:

ANSI byte array (I haven't tested it, but should beat S = StrConv(ByteArray, vbUnicode) easily)

Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As String

Dim S As String
S = SysAllocStringByteLen(VarPtr(ByteArray(0)), UBound(ByteArray) + 1)

Unicode byte array (S = ByteArray is superior though, unless you want only a small piece of a big byte array)

' String -> Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Dim S As String
PutMem4 VarPtr(S), SysAllocStringByteLen(VarPtr(ByteArray(0)), UBound(ByteArray) + 1)
Debug.Print S

[Vbstr]

If it is of any value, you can create a new BSTR with ANSI to Unicode conversion using a single API call:

Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As String

SysAllocStringByteLen
This function takes an ANSI string as input, and returns a BSTR that contains an ANSI string. This function does not perform any ANSI to Unicode translation.
http://msdn.microsoft.com/en-us/library/ms891286.aspx

[Merri]

Vbstr: no, in itself doesn't, but VB does when you give String datatype to an API declaration, and in this case the end result is ANSI to Unicode for the output string.

[petersen]

Maheshkurmi,

This is but a long shot.

Since you mentioned that ".... in VB application crashes many times, (it works many times as well) ....", would you try to just revise a code line as follows:

Change original:

GetStringFromPointer = Left(szBuffer, NullCharPos - 1)

to:

If NullCharPos > 1 Then
      GetStringFromPointer = Left(szBuffer, NullCharPos - 1)
End if

[maheshkurmi]

thanks to all my friends/experts for kind support, Inspite of all ur efforts and suggestion the problem is not resolved yet. But I am very very happy to get such a great support. I am now planning to get Tite info using winsock separately. As soon as I complete it iwill submit it.
Again thanks a lot..
mahesh kurmi

[RAFAAJ2000]

Hi all,

Sorry to revive this old thread but does anyone have an idea why VBClassicRocks's code doesn't work for 64 bit systems

Here is the adapted code for 64 bit :

Declare PtrSafe Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As String) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function StrFromPtr(ByVal lpStr As LongPtr) As String
    Dim bStr() As Byte
    Dim cChars As Long
    On Error Resume Next
    ' Get the number of characters in the buffer
    cChars = lstrlen(lpStr)
    If cChars Then
     ' Resize the byte array
     ReDim bStr(0 To cChars - 1) As Byte
     ' Grab the ANSI buffer
     Call CopyMemory(bStr(0), ByVal lpStr, cChars)
    End If
    ' Now convert to a VB Unicode string
    StrFromPtr = StrConv(bStr, vbUnicode)
End Function


Public Sub Test()
    Dim sSomeString As String
    Dim lPtr As LongPtr
    
    sSomeString = "Hello"
    lPtr = StrPtr(sSomeString)
    
    MsgBox StrFromPtr(lPtr)
End Sub

[RAFAAJ2000]

My bad ... I was wrongly passing the actual string in the Destination param of the CopyMemory API instead of passing its Pointer
Ok .. in case anyone is interested , the following code is what worked for me:

Private Declare PtrSafe Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As String) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

Function StrFromPtr(ByVal Ptr As LongPtr) As String
    Dim sBuffer As String
    Dim lStringLen As Long
    
    lStringLen = lstrlen(Ptr)
    If lStringLen > 0 Then
        sBuffer = String$(lStringLen, 0)
        CopyMemory ByVal StrPtr(sBuffer), ByVal CLng(Ptr), lStringLen * 2 '(*2 unicode string assumed)
        StrFromPtr = sBuffer
    End If
End Function

Sub Test()
    Dim sSomeString As String
    Dim lPtr As LongPtr
    
    sSomeString = "Hello"
    lPtr = StrPtr(sSomeString)
    
    MsgBox StrFromPtr(lPtr)
End Sub

[RAFAAJ2000]

Actually, I spoke too soon

The above code dosn't work for stings longer than 5 characters !

Try passing a string longer than 5 chrs as shown in the following test code and you will see that only the first 5 letters are returned !

Private Declare PtrSafe Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As String) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

Function StrFromPtr(ByVal Ptr As LongPtr) As String
    Dim sBuffer As String
    Dim lStringLen As Long

    lStringLen = lstrlen(Ptr)
    If lStringLen > 0 Then
        sBuffer = String$(lStringLen, 0)
        CopyMemory ByVal StrPtr(sBuffer), ByVal CLng(Ptr), lStringLen * 2 '(*2 unicode string assumed)
        StrFromPtr = sBuffer
    End If
End Function

Sub Test()
    Dim sSomeString As String
    Dim lPtr As LongPtr

    sSomeString = "Hello World"
    lPtr = StrPtr(sSomeString)

    MsgBox StrFromPtr(lPtr)
End Sub

So back to square one .... Any light on this anyone ?
Regards.

[RAFAAJ2000]

Ok .. This is the only way I could make this work for any string length in a 64 bit environement

Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyW" _
(ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

Function StrFromPtr(ByVal Ptr As LongPtr) As String
    Dim sBuffer As String
    Dim lBufferPtr As LongPtr
    
    sBuffer = String$(1024, " ")
    lBufferPtr = lstrcpy(ByVal StrPtr(sBuffer), Ptr)
    If lBufferPtr <> 0 Then
        sBuffer = Replace(sBuffer, vbNullChar, "")
        StrFromPtr = RTrim$(sBuffer)
    End If
End Function

Sub Test()
    Dim sSomeString As String
    Dim sStringFromPointer As String
    Dim lPtr As LongPtr

    sSomeString = "Hello World ... This is a long string !"
    lPtr = StrPtr(sSomeString)
    sStringFromPointer = StrFromPtr(lPtr)
    
    MsgBox sStringFromPointer
    
    Debug.Print "(Initial String)= "; sSomeString
    Debug.Print "(Length of String)= "; Len(sSomeString); "caracters"
    Debug.Print
    Debug.Print "(Returned String from Pointer)= "; sStringFromPointer
    Debug.Print "(Length of String from Pointer)= "; Len(sStringFromPointer); "caracters"
End Sub

[Bonnie West]

The benchmarks here supports Merri's claims that SysAllocStringByteLen is faster than any other alternative.

Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal lpString As Long) As Long

Private Declare Function PutMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByVal NewVal As Long) As Long

Private Declare Function SysAllocString Lib "oleaut32.dll" (Optional ByVal pszStrPtr As Long) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32.dll" (Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As String
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

'Returns a copy of a null-terminated ANSI string (LPSTR/LPCSTR) from the given pointer
Public Function GetStrFromPtrA(ByVal Ptr As Long) As String
    GetStrFromPtrA = SysAllocStringByteLen(Ptr, lstrlenA(Ptr))
End Function

'Returns a copy of a null-terminated Unicode string (LPWSTR/LPCWSTR) from the given pointer
Public Function GetStrFromPtrW(ByVal Ptr As Long) As String
    #If WantFasterWay Then
    PutMem4 VarPtr(GetStrFromPtrW), SysAllocString(Ptr)
    #Else
    SysReAllocString VarPtr(GetStrFromPtrW), Ptr
    #End If
End Function

@ RAFAAJ2000

Try this (untested!) 64-bit VBA version of the GetStrFromPtrW function in the quote above:

Private Declare PtrSafe Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long



'Returns a copy of a null-terminated Unicode string (LPWSTR/LPCWSTR) from the given pointer
Public Function GetStrFromPtrW(ByVal Ptr As LongPtr) As String
    SysReAllocString VarPtr(GetStrFromPtrW), Ptr
End Function

[RAFAAJ2000]

Thanks Mr Bonnie West

Indeed, the SysReAllocString approach seems faster , simpler and worked for me like a charm

Regards

[RAFAAJ2000]

Hi there,

After testing the methods above (ie: using SysReAllocString as well as lstrcpy ), the result is not consistent .... occasionally, the returned string contains garbage caracters or is simply wrong ... Is there a way of locking the String Pointer so that it always points to the correct string ?

Regards

[Bonnie West]

After testing the methods above (ie: using SysReAllocString as well as lstrcpy ), the result is not consistent .... occasionally, the returned string contains garbage caracters or is simply wrong ... Is there a way of locking the String Pointer so that it always points to the correct string ?

Without seeing your actual code, it is hard to say what could be the problem.



BTW, I recommend that you start a new thread in the Office Development forum instead of replying further in this old thread since your question is more about VBA and not about VB6.

[RAFAAJ2000]

Without seeing your actual code, it is hard to say what could be the problem.

The code is rather involved that's why I didn't post it here

BTW, I recommend that you start a new thread in the Office Development forum instead of replying further in this old thread since your question is more about VBA and not about VB6.

Although this is eventually needed for an excel project, I think that posting these kind of API quetions in an office forum wouldn't yield many answers if any at all

Thank you

[VanGoghGaming]

I am using these functions to get objects and strings from pointers:

Public Function PtrToObj(ByVal lObjectPointer As Long) As Object
Dim objTemp As Object
    ObjectPtr(objTemp) = lObjectPointer: Set PtrToObj = objTemp: ObjectPtr(objTemp) = 0&
End Function

Public Function PtrToStr(ByVal lStringPointer As Long) As String
Dim sTemp As String
    StringPtr(sTemp) = lStringPointer: PtrToStr = sTemp: StringPtr(sTemp) = 0&
End Function

where "ObjectPtr" and "StringPtr" are two helper functions from this great typelib: Visual Basic 6 Virtual Machine Type Library

[Elroy]

Adding a reference to an instantiated object is pretty easy (with plenty of references in these forums for usage):

Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long

A BSTR from a pointer is a bit more complex, because you have to answer the question: Do we want a copy of the original string (and then let VB handle the cleanup), or do we want a "temp" string that points to the original string (i.e., an alias) that we'll explicitly cleanup ourselves? Also, we need to know what kind of string (AsciiZ, Unicode BSTR, UTF-8, other???) that our pointer is pointing at. And, however those questions are answered, some use of the MultiByteToWideChar, WideCharToMultiByte, lstrlenW, lstrlenA, and maybe RtlMoveMemory will get it done.

As far as something like SysAllocString or SysReAllocString (mentioned above), I suppose we can use that, but it's easy enough to allocate a string in VB6 without an API call.