Release the beast: Get$/Set$/GetPtr

**ReneMiner** · 22-07-2013, 10:02

the most dirty approach ever- but surprisingly it works.

Three functions that work on variables and one-dimensional arrays of strings and fixed size udts:

Edit:

This was the beginning, one page further and somewhere at the recents posts you'll find LazyFun.tBasicU - so this example just demonstrates what's possible.
In the meantime there's much more - there are a lot of functions to pointers, heap and even storing multidynamic data -find an overview here

Dword myPtr = GetPtr(ByVal sVariableName as String, Optional Index as Long, lSize as Long)

pass any variables name to receive a pointer,
give an index if you want a pointer to a certain element of one-dimensional arrays
pass for example a SizeOf() to lSize if you want a pointer to an non-string-array-element

String sContent = Get$(Byval sVariableName as String, Optional Index as Long, lSize as Long)

pass any variables name to receive its content in form of a string
give an index if you want the content of a certain element of one-dimensional arrays
pass for example a SizeOf() to lSize if you want the content of a non-string-array-element
pass lSize to receive just "Left$(lSize)" of a string-array-element

Dword myNewPtr = Set$(Byval sVariableName as String, byval sData as String, Optional Index as Long)

pass any variables name to change its content to sData
give an index if you want to change a certain element of one-dimensional arrays
receive the variables (new) pointer or 0 if fails

#MinVersion 1.9.7.0

Uses "console"

Declare Function VarInfo Lib "thinCore.DLL"                    _
                       Alias "thinBasic_VariableGetInfoEX"     _
                          (                                       _
                            ByVal SearchKey   As String         , _
                            ByRef MainType    As Long           , _   '---ATTENTION: parameter passed BYREF will return info
                            ByRef SubType     As Long           , _   '---ATTENTION: parameter passed BYREF will return info
                            ByRef IsArray     As Long           , _   '---ATTENTION: parameter passed BYREF will return info
                            ByRef DataPtr     As Long           , _   '---ATTENTION: parameter passed BYREF will return info
                            ByRef nElements   As Long           , _   '---ATTENTION: parameter passed BYREF will return info
                            Optional                              _
                            ByVal WhichLevel  As Long             _   
                          ) As Long

%Is_String = 30

' ---------------------------------------------------------------------------                
Function GetPtr(ByVal sName As String, Optional Index As Long, lSize As Long) As DWord
  
  ' returns pointer to any variable passed by name
  
  If Not VARIABLE_Exists(sName) Then Return 0
  
  Local lMainType, lSubType, lIsArray, lDataPtr, lnElements  As DWord
  VarInfo(sName, lMainType, lSubType, lIsArray, lDataPtr, lnElements)
 
  If Between(Index, 1, lnElements) Then 
    If lMainType = %Is_String Then
      Return Peek(DWord, lDataPtr + (Index - 1) * SizeOf(DWord)) 
    Else
      Return lDataPtr + (Index-1) * lSize   
    EndIf
  Else
    If lMainType = %Is_String Then
      Return Peek(DWord, lDataPtr)
    Else
      Return lDataPtr
    EndIf 
  EndIf

End Function

' ------------------------------------------------------------------------------
Function Get$(ByVal sName As String, Optional Index As Long, lSize As Long) As String
  
  ' returns content of variable passed by name
  If Not VARIABLE_Exists(sName) Then Return ""
  
  Local lMainType, lSubType, lIsArray, lDataPtr, lnElements  As DWord
  Local realPtr, realSize As DWord
  
  VarInfo(sName, lMainType, lSubType, lIsArray, lDataPtr, lnElements)
  
  If All( _ 
         lIsArray <> 0, _
         Between(Index, 1, lnElements) _
        ) Then  
    If lMainType = %Is_String Then 
      realPtr = Peek(DWord, lDataPtr + (Index - 1) * SizeOf(DWord)) 
      realSize = Peek(DWord, realPtr - SizeOf(DWord)) 
      If realSize = 0 Then Return ""
      If Between(lSize, 1, realSize) Then
        Function = Memory_Get(realPtr, lSize)
      Else 
        Function = Memory_Get(realPtr, realSize)
      EndIf  
    ElseIf lSize > 0 Then    
      Function = Memory_Get(lDataPtr + (Index - 1) * lSize, lSize)
    EndIf
  Else
    If lMainType = %Is_String Then   
      realPtr = Peek(DWord, lDataPtr)
      realSize = Peek(DWord, realPtr - SizeOf(DWord)) 
      If realSize = 0 Then Return ""
      If Between(lSize, 1, realSize) Then
        Function = Memory_Get(realPtr, lSize)
      Else 
        Function = Memory_Get(realPtr, realSize)
      EndIf
    ElseIf lSize > 0 Then 
      Function = Memory_Get(lDataPtr, lSize)
    EndIf
  
  EndIf      

End Function    
' ------------------------------------------------------------------------------
Function Set$(ByVal sName As String, ByVal sData As String, Optional Index As Long) As DWord
 
  ' change value of any variable passed by name
  ' returns pointer to (new) variables location
 
  If Not VARIABLE_Exists(sName) Then Return 0
 
  Local lMainType, lSubType, lIsArray, lDataPtr, lnElements As DWord
  Local lDummyPtr As DWord
  
  VarInfo(sName, lMainType, lSubType, lIsArray, lDataPtr, lnElements)
  
  If All( _ 
          lIsArray <> 0, _
          Between(Index, 1, lnElements) _
         ) Then
    
    If lMainType = %Is_String Then 
      VarInfo("sData", lMainType, lSubType, lIsArray, lDummyPtr, lnElements)
    ' -- this does the trick:
      Memory_Swap(lDataPtr + (Index - 1) * SizeOf(DWord), lDummyPtr, SizeOf(DWord)) 
      Function = Peek(DWord, lDataPtr + (Index - 1) * SizeOf(DWord))
    ElseIf sData <> "" Then
      Memory_Set(lDataPtr + (Index - 1) * Peek(DWord, StrPtr(sData) - 4), sData) 
      Function = lDataPtr + (Index - 1) * Peek(DWord, StrPtr(sData) - 4) 
    EndIf
    
  Else
  
    If lMainType = %Is_String Then 
      VarInfo("sData", lMainType, lSubType, lIsArray, lDummyPtr, lnElements)
    ' -- dirty- ain't it?  
      Memory_Swap(lDataPtr, lDummyPtr, SizeOf(DWord)) 
      Function = Peek(DWord, lDataPtr)
    ElseIf sData <> "" Then
      Memory_Set(lDataPtr, sData) 
      Function = lDataPtr
    EndIf 
    
  EndIf       

End Function

' ------------------------------------------------------------------------------
' all from here is just some testing:

Dim foo As String = "abc" 
Dim dog As Ext = 1.2345678
Dim oops(3) As String

Type t_udt
  a As Byte
  b As Long
  c As Double
End Type   

Dim udt(5) As t_udt  
Dim dummy As t_udt
  
Dim i As Long

Do 

  PrintL $CRLF + "First test: simple string-variable"   + $CRLF
  PrintL "assign 'abc' to 'foo' now"
  foo = "abc"
  PrintL "foo-ptr    :" + Str$(GetPtr("foo"))
  PrintL "foo-content: " + foo
  PrintL "Get$('foo'): " + Get$("foo")
  PrintL $CRLF
  PrintL "Set$('foo','hello world!') now"
  PrintL "foo-ptr    :" + Str$(Set$("foo", "hello world!"))
  PrintL "foo-content: " + foo
  PrintL "Get$('foo'): " + Get$("foo")

  PrintL $CRLF + "any key to continue" + $CRLF
  WaitKey
  
  PrintL $CRLF + "Second test: string-array" + $CRLF
  For i = 1 To 3
    PrintL "Set$('oops','I am oops(" + i + ")', " + i + ") now" 
    Set$("oops","I am oops("+ i +")", i)
  Next
  For i = 1 To 3
    PrintL "oops("+i+") contains: " + oops(i) 
    PrintL "Get$('oops',"+i+")  : " + Get$("oops", i)
  Next  
  PrintL $CRLF + "any key to continue" + $CRLF
  WaitKey
  
  PrintL $CRLF + "Third test: simple numeric variable" + $CRLF
  PrintL "dog current :" + Str$(dog)
  PrintL "dog-pointer :" + Str$(GetPtr("dog"))
  PrintL $CRLF
  PrintL "double content now" 
  Set$("dog", MKE$( CVE(Get$("dog",, SizeOf(Ext))) * 2))
  PrintL "Get$('dog',,SizeOf(Ext)): " + CVE(Get$("dog",, SizeOf(Ext))) 
  PrintL "re-check dog            :" + Str$(dog)
  PrintL $CRLF + "any key to continue" + $CRLF
  WaitKey
 
  PrintL $CRLF + "Fourth test: fixed size udt-array variable" + $CRLF
  dummy.a += 1
  dummy.b += 2   
  dummy.c += 3.45
  
  Set$("udt", Memory_Get(VarPtr(dummy), SizeOf(t_udt)), 3)
  PrintL "udt(3).a:" + Str$(udt(3).a)
  PrintL "udt(3).b:" + Str$(udt(3).b)
  PrintL "udt(3).c:" + Str$(udt(3).c)
 
  PrintL "------------------------------------------------"
  PrintL $CRLF + "ESC to end, any other key to re-run" + $CRLF

Loop While WaitKey <> "[ESC]"

Not possible:
any actions on multidimensional arrays, there's only possible to receive pointer to very first element
Set$/Get$ on udt-substrings directly