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

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

ok, on 2-dimensional arrays it would simple work by some multiplication + addition - but the user has to pass the correct calculated index. On moredimensional arrays one would need to know in which order they are stored. I don't...

For udt-array-substrings user needs to swap the sub-pointers himself after retrieving them using Get$.
Edit: now there's SetUdtStr to do that

**Petr Schreiber** · 22-07-2013, 11:29

Hi Rene,

I can't get it to work, do you use some special thinCore by any chance? Can you run this script:

Uses "Console", "File", "Crypto"

$DLL_CORE = APP_Path+"thinCore.dll"       
$BIN_CORE = FILE_Load($DLL_CORE)

DWord  cSize = FILE_Size($DLL_CORE)
DWord  cSig1 = HASH(1, $BIN_CORE)
DWord  cSig2 = iCrypto_MD5($BIN_CORE)      

String sOutput = "CoreTest v1.0" + $CRLF +           
                 "Core size        = " + Format$(cSize, "0,") + "b" + $CRLF +          
                 "Core signature 1 = " + Hex$(cSig1) + $CRLF +          
                 "Core signature 2 = " + Hex$(cSig2)                    
                 
PrintL sOutput
ClipBoard_SetText(sOutput)                 

PrintL
PrintL "(Info above placed to clipboard now, press any key to quit)"

WaitKey

On my PC I get:

CoreTest v1.0
Core size = 172,032b
Core signature 1 = CC97657E
Core signature 2 = A9A329C9

Petr

**ReneMiner** · 22-07-2013, 11:32

this is what I got:

CoreTest v1.0
Core size = 172,032b
Core signature 1 = 3E7670E0
Core signature 2 = 1DCD6500

**Petr Schreiber** · 22-07-2013, 11:37

Thanks,

looking at the signatures - it means you have different core than me, that is the reason why it works for you and not for me. I am on PC with clean 1.9.7.0 installation, I think, I didn't add any beta cores later.

Petr

**ReneMiner** · 22-07-2013, 11:42

probably you're right. I think I have it from somewhere of this thread, page 2 at bottom - but I'm not sure about it (date) - can very well be it was posted inside this attachement.

Anyway- there's a new version of Oxygen which uses in Examples\General\VarArrayPointers.tBasic the same thinCore-function - would you mind trying it?

+ + +

One more script to test the attached unit-file - the functions from above are included and a 'few' more - so those functions still work as described above.
I called it LazyFun(ctions) and it's filled with functions that I'd like to see as native tB-functions.
A few more are on my list as to receive the size of a variable passed "byName" since it could improve a few of the already existing functions when user does not need to pass them as parameters nor my - for example listview - would need to have storage-varaiables to what amount one element is sized.

So this is a script for test-run, should be saved next to the attachement.

Uses "Console"
#INCLUDE "lazyFun.tBasicU"

' ----------------
'[] Heap
' ----------------
DWord foo
String sX = "123456789|"

Heap_SetAt(VarPtr(foo), "I am an important thing to memorize")

PrintL $CRLF + Heap_Get$(foo) + $CRLF
PrintL $CRLF + "test instr-position: 'important' (9 chars)"
PrintL "found here : '" + Memory_Get(foo + Heap_Instr(foo, "important") - 1, 9) +"'"

Print $CRLF + "test Heap_Left$/Heap_Mid$:"
PrintL Heap_Left$(foo, 7) + "other " + Heap_Mid$(foo, 19, 5)

PrintL $CRLF + "test Heap_Right$ with fill-option:"
PrintL sX + sX + sX+ sX + sX +"<< 50"
PrintL Heap_Right$(foo, 50, Asc("."))
PrintL "-----------------------------------------"
PrintL $CRLF + "key to continue" + $CRLF
WaitKey
                                                  
                                                  
PrintL $CRLF + "this is a copy of foo:"
DWord dog = Heap_Copy(foo)
PrintL $CRLF + Heap_Get$(dog)
PrintL "append something now"
Heap_AppendAt(VarPtr(dog), " too!")
PrintL $CRLF + Heap_Get$(dog)
PrintL "-----------------------------------------"
PrintL $CRLF + "key to continue" + $CRLF
WaitKey
 
PrintL $CRLF + "now resize to 50 bytes and fill with sX: '" + sX +"'"
PrintL " 5 times, StrLen(sX): " + StrLen(sX)
Heap_ResizeAt(VarPtr(dog), 5 * StrLen(sX))  
Heap_Fill(dog, sX)
PrintL $CRLF + Heap_Get$(dog)
PrintL "-----------------------------------------"
PrintL $CRLF + "key to continue" + $CRLF
WaitKey
                                                
                                                
PrintL "dog-length = " + HEAP_Size(dog)
PrintL "fill with 'hello world !'"
Heap_Fill(dog, "hello world !")
PrintL $CRLF + Heap_Get$(dog)

PrintL $CRLF + "now resizing using %auto-switch"
' usually one would use SizeOf(some type) instead of Len here
Heap_ResizeAt(VarPtr(dog), Len("hello world !"), %auto)                

PrintL $CRLF + Heap_Get$(dog)
PrintL "-----------------------------------------"

PrintL $CRLF + "key to continue" + $CRLF
 
WaitKey
HEAP_Free(foo)
HEAP_Free(dog)

' ----------------
'[] SetUDTStr/GetDataPtr
' ----------------


PrintL $CRLF + "test to alter string inside udt"
Type t_test
  A As Byte
  B As Long
  C As String
End Type

Dim test(12) As t_test

SetUDTStr("test",7, UDT_ElementOffset(test(1).c), SizeOf(t_test), "I'm supposed to become no.7")

foo = GetDataPtr("test",7, UDT_ElementOffset(test(1).c), SizeOf(t_Test))
' in case Stringpointer peek StrPtr+StrPtrLen -
PrintL Memory_Get(Peek(DWord, foo), Peek(DWord, Peek(DWord, foo) - SizeOf(DWord)))
' but we have a function for this also:
PrintL StrAtPtr$ foo
PrintL test(7).c

PrintL $CRLF + "test variable in UDT:"

foo = GetDataPtr("test",6, UDT_ElementOffset(test(1).b), SizeOf(t_Test))
PrintL "requested adress" + Str$(foo)
PrintL "put 123 there" : Poke(Long, foo, 123)
PrintL "check content" + Str$(test(6).b)

'PrintL $CRLF + "key to continue" + $CRLF
'WaitKey


PrintL $CRLF + "key to end" + $CRLF
WaitKey

Edit:attachement removed. Some functions have been changed. find LazyFun.tBasicU here

**ReneMiner** · 23-07-2013, 07:42

I'm still nosy- I rewrote part of it using oxygen based on the mentioned example and it would be of interest to me if it works then:

Uses "Console", "Oxygen"

' shared points: 
Dim As Long pGetAnyPtr
Dim As Long pFinish

' setup O2-code:
O2_Basic RawText
 'From ThinCore header
  ! thinBasic_VariableGetInfoEX Lib "thinCore.dll"  (String SearchKey, sys *pMainType,*pSubType,*pIsArray,*pDataPtr,*pnElements,WhichLevel) As sys

  '---Equates for variable Main Type
    %MainType_IsNumber        = 20&
    %MainType_String          = 30&
    %MainType_IsString        = %MainType_String
    %MainType_Variant        = 50&
    %MainType_IsVariant      = %MainType_Variant
    %MainType_UDT            = 60&
    %MainType_IsUDT          = %MainType_UDT
  '---Equates for variable Sub Type
    %SubType_Byte            =  1&
    %SubType_Integer          =  2&
    %SubType_Word            =  3&
    %SubType_DWord            =  4&
    %SubType_Long            =  5&
    %SubType_Quad            =  6&
    %SubType_Single          =  7&
    %SubType_Double          =  8&
    %SubType_Currency        =  9&
    %SubType_Ext             = 10&
    %SubType_AsciiZ          = 25& 


  Function GetAnyPtr(bstring varname, Optional sys n, Optional Long lSize, Optional Long lOffset ) As sys, link #pGetAnyPtr
  ============================================================================
  '
  sys MainType, SubType, IsArray, DataPtr, nElements, WhichLevel
  thinBasic_VariableGetInfoEX Varname, MainType, SubType, IsArray, DataPtr, nElements, WhichLevel

  If MainType = %MainType_IsString Then
    If n <= nElements Then
      bstring Array At (DataPtr) 'thinBasic uses bstrings
      Return StrPtr Array[n]
    Else
      Return *DataPtr
    EndIf
  Else
    If n <= nElements And lSize > 0 Then DataPtr = DataPtr + (n-1) * lSize 
    DataPtr = DataPtr + lOffset
    Return DataPtr
  End If
  
  End Function


  Sub finish() link #pFinish
  ==========================
  terminate
  End Sub         

End RawText
         
         
If O2_Error <> "" Then
  PrintL "Can not run - Error within o2-script:" + $CRLF
  PrintL O2_Error   
  WaitKey
  Stop
Else
  ' can run
  O2_Exec
End If     
' -----------------------------------------------------
' tB-section

Declare Function GetAnyPtr(ByVal String, _
                  Optional ByVal DWord,  _
                  Optional ByVal Long,   _
                  Optional ByVal Long    _
                           ) As DWord At pGetAnyPtr

Declare Sub Finish() At pFinish


' tests : 
' string-array
String a(3)
a(1)="Apples"
a(2)="Bananas" 
a(3)="Corn"
DWord p=GetAnyPtr("a",2)              'pointer to Bananas 


If p Then PrintL Memory_Get(p, Peek(DWord, p - SizeOf(DWord)))   

' simple string
String b = "I am here"
p = GetAnyPtr("b")
If p Then PrintL Memory_Get(p, Peek(DWord, p - SizeOf(DWord)))   
PrintL $CRLF

' simple numeral
DWord q = GetAnyPtr("p")
If q Then 
  PrintL "p located at:" + Str$(q)
  PrintL "p contains  :" + Str$(Peek(DWord,q))
EndIf
PrintL $CRLF

' udt-array  
Type t_Test
  X As Byte
  Y As String
  Z As Double
End Type
Dim test(12) As t_Test 

' udt-numeral
Test(7).Z = 12.34567890 

PrintL $CRLF + "ask for pointer to test(7).Z:"
p = GetAnyPtr("test", 7, SizeOf(t_Test), UDT_ElementOffset(Test(1).Z))
If p Then PrintL "found double at p: " + Peek(Double, p)
PrintL $CRLF

' udt-string
Test(8).Y = "I am test(8).Y"

PrintL $CRLF + "ask for pointer to test(8).Y:"
q = GetAnyPtr("test", 8, SizeOf(t_Test), UDT_ElementOffset(Test(1).Y))
If q Then PrintL "found string at q: " + Memory_Get(Peek(DWord, q), Peek(DWord, Peek(DWord, q) - SizeOf(DWord)))


PrintL $CRLF + "any key to end"
WaitKey
Finish()

**Petr Schreiber** · 23-07-2013, 08:51

Works okay for me!

Petr

**ReneMiner** · 23-07-2013, 09:03

Originally Posted by Petr Schreiber

Works okay for me!

Petr

Assume you mean the last posted test-script using oxygen and not the stuff above it - or did you get some other thinCore.dll in the meantime? - that tells me
old thinCore had no optional WhichLevel ??? - or:
it works through oxygen but not in plain thinBasic. so there must be something through using those "safe sys-pointer-variables".
There's nothing equal to these in tB...yet...

There seems to be an advantage using oxygen on thincore+pointer-stuff through using these sys-variables.
Currently I'm trying some function to find out the size of an element, probably have to use Function thinBasic_ArrayGetInfo() for this but using it always crashes even if I request another Pointer using thinBasic_ArrayGetPtr().