This is a minimal example using a variant inside an structure and unicode strings:
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
FUNCTION B2A_ (BYVAL pbstr AS DWORD) AS STRING
LOCAL bstrlen AS LONG
IF pbstr = %NULL THEN EXIT FUNCTION
bstrlen = SysStringByteLen(BYVAL pbstr)
IF bstrlen THEN FUNCTION = ACODE$(PEEK$(pbstr, bstrlen))
END FUNCTION
FUNCTION BSTR_ (BYVAL s AS STRING) AS DWORD
s = UCODE$(s)
FUNCTION = SysAllocString(BYVAL STRPTR(s))
END FUNCTION
DECLARE SUB VariantInit LIB "OLEAUT32.DLL" ALIAS "VariantInit" (BYREF pvarg AS ANY)
DECLARE FUNCTION VariantClear LIB "OLEAUT32.DLL" ALIAS "VariantClear" (BYREF pvarg AS ANY) AS LONG
TYPE MyUDT
p1 AS LONG
p2 AS DWORD
v AS VARIANTAPI
END TYPE
FUNCTION PBMAIN () AS LONG
LOCAL hr AS LONG
LOCAL t AS MyUDT
LOCAL p AS DWORD
' Initialize the variant structure
VariantInit t.v
t.v.vt = %VT_BSTR
' Allocate a string in the variant
t.v.vd.bstrVal = BSTR_("My test string")
' Display the string
MSGBOX B2A_(t.v.vd.bstrVal)
' Change the contents of the string
p = BSTR_("My new string")
hr = SysReallocString(t.v.vd.bstrVal, BYVAL p)
SysFreeString p
' Display the changed string
MSGBOX B2A_(t.v.vd.bstrVal)
' Clear the variant structure
hr = VariantClear(t.v)
IF hr = %S_OK THEN t.v.vd.bstrVal = %NULL
END FUNCTION
And this is the same example using ansi strings:
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
FUNCTION AB2A_ (BYVAL pbstr AS DWORD) AS STRING
LOCAL bstrlen AS LONG
IF pbstr = %NULL THEN EXIT FUNCTION
bstrlen = SysStringByteLen(BYVAL pbstr)
IF bstrlen THEN FUNCTION = PEEK$(pbstr, bstrlen)
END FUNCTION
FUNCTION ABSTR_ (BYVAL s AS STRING) AS DWORD
FUNCTION = SysAllocStringByteLen(BYVAL STRPTR(s), LEN(s))
END FUNCTION
DECLARE SUB VariantInit LIB "OLEAUT32.DLL" ALIAS "VariantInit" (BYREF pvarg AS ANY)
DECLARE FUNCTION VariantClear LIB "OLEAUT32.DLL" ALIAS "VariantClear" (BYREF pvarg AS ANY) AS LONG
TYPE MyUDT
p1 AS LONG
p2 AS DWORD
v AS VARIANTAPI
END TYPE
FUNCTION PBMAIN () AS LONG
LOCAL hr AS LONG
LOCAL t AS MyUDT
LOCAL p AS DWORD
' Initialize the variant structure
VariantInit t.v
t.v.vt = %VT_BSTR
' Allocate a string in the variant
t.v.vd.bstrVal = ABSTR_("My test string")
' Display the string
MSGBOX AB2A_(t.v.vd.bstrVal)
' Change the contents of the string
p = ABSTR_("My new string")
hr = SysReallocString(t.v.vd.bstrVal, BYVAL p)
SysFreeString p
MSGBOX AB2A_(t.v.vd.bstrVal)
' Clear the variant structure before it goes out of scope
VariantClear t.v
IF hr = %S_OK THEN t.v.vd.bstrVal = %NULL
END FUNCTION
And this is how could be with native support for variants in structures:
TYPE MyUDT
p1 AS LONG
p2 AS DWORD
v AS VARIANT
END TYPE
FUNCTION PBMAIN () AS LONG
LOCAL t AS MyUDT
t.v = "My test string"
' Display the string
MSGBOX VARIANT$(t.v)
' Change the contents of the string
t.v = "My new string"
' Display the changed string
MSGBOX VARIANT$(t.v)
END FUNCTION
A dramatic difference, wow! Thanks Jose, nothing like an example, this one is an eye opener!
The usage of ReallocString can be simplified using a wrapper function, e.g.
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
FUNCTION B2A_ (BYVAL pbstr AS DWORD) AS STRING
LOCAL bstrlen AS LONG
IF pbstr = %NULL THEN EXIT FUNCTION
bstrlen = SysStringByteLen(BYVAL pbstr)
IF bstrlen THEN FUNCTION = ACODE$(PEEK$(pbstr, bstrlen))
END FUNCTION
FUNCTION BSTR_ (BYVAL s AS STRING) AS DWORD
s = UCODE$(s)
FUNCTION = SysAllocString(BYVAL STRPTR(s))
END FUNCTION
FUNCTION PBReallocString (BYREF pbstr AS DWORD, BYVAL s AS STRING) AS LONG
LOCAL p AS DWORD
p = BSTR_(s)
FUNCTION = SysReallocString(pbstr, BYVAL p)
SysFreeString p
END FUNCTION
DECLARE SUB VariantInit LIB "OLEAUT32.DLL" ALIAS "VariantInit" (BYREF pvarg AS ANY)
DECLARE FUNCTION VariantClear LIB "OLEAUT32.DLL" ALIAS "VariantClear" (BYREF pvarg AS ANY) AS LONG
TYPE MyUDT
p1 AS LONG
p2 AS DWORD
v AS VARIANTAPI
END TYPE
FUNCTION PBMAIN () AS LONG
LOCAL hr AS LONG
LOCAL t AS MyUDT
LOCAL p AS DWORD
' Initialize the variant structure
VariantInit t.v
t.v.vt = %VT_BSTR
' Allocate a string in the variant
t.v.vd.bstrVal = BSTR_("My test string")
' Display the string
MSGBOX B2A_(t.v.vd.bstrVal)
' Change the contents of the string
hr = PBReallocString(t.v.vd.bstrVal, "My new string")
' Display the changed string
MSGBOX B2A_(t.v.vd.bstrVal)
' Clear the variant structure
hr = VariantClear(t.v)
IF hr = %S_OK THEN t.v.vd.bstrVal = %NULL
END FUNCTION
Of course, the ideal solution is to have native support and don't worry about memory management. That is why we have chosen BASIC instead of C.
You could take it one stage further: once the variable is declared to be variant, there would be no need to refer to its type again during the course of the program - the compiler could manage all type conversions including those required for DLL calls. The only reason for NOT using variants, reverting to CPU types would be performance optimisation ie: for speed and space.
A variable may begin its career as a humble byte, get transformed into a double then to a BSTR before ending up as an integer parameter in a DLL call.
If variants can be detached from their MS / OLE roots they would make an excellent universal standard, accessible to different operating systems and languages.
PB already has support for CPU types, asciiz and fixd-length strings, non-redimensionable arrays, unions and embedded structures. Support for variants will add flexibility. When you will need sped, use CPU types and asciiz or fixed-length strings. When you need flexibility use variants.
Variants were added to add flexibility and language independence, and although they are tied to COM in Windows, a library can be developed to manage them without using COM.
My point is that, instead of adding native support for dynamic strings in structures--and then surely somebody will ask for native support for dynamic arrays, etc.--, PB can instead add native support for variants.
...and Structures in Dynamic Strings..
Well, I am going to drop variants into the R$ project, and see how the logistics of managing them works out. I already have assembler code for efficient conversions and use variant-like codings to indicate Type. Variants and their referenced structures can be accommodated in the global string array. So memory management will be down to the host Basic
But there are a number of types defined for variants, which are unfamiliar to me so I'll start with the simple ones. :)
Once you have got something into a dynamic string - you have complete control over it, using high or low level procedures.
Quote from: Charles Pegge on September 24, 2007, 09:14:13 PM
Once you have got something into a dynamic string - you have complete control over it, using high or low level procedures.
Well, it is the code produced by the compiler that give some sense to memory areas. Once memory is allocated you can give whatever meaning to it. A byte is a char and a number. A long is a number, a BSTR pointer, 4 chars, 2 integers. 16 bytes are a variant, 4 longs, a long plus an EXT plus an integer, and so on ... But you already know that. So just a bit of fantasy and all is almost possible.
But you are right, dynamic strings are perfect to allocate, change or de- allocate memory areas. Than just use pointers or logical structures to give meaning to consecutive bytes :D
There is a kaleidoscopic aspect to this - a language that can write its own scripts and execute them on-the-fly, and also write its own machine code and execute that too. It could be a programmer's heaven or a programmer's hell - writing the program that writes the program ..ad infinitum.
We will find out which. ;D
Why not make a simple dispatch?
Create a silly vtable based class, implement a simple dispatch and set it to a dispatch (or variant(?))
PB calls the deconstructor when an object was set in the correct way (variant > Set to dispatch)
from experiance, a 'poke' does no lead to destruction when out of scope.
In fact, the more flexible approach is to have classes and support for object variables. You will write a class to provide storage for the string (or variant or whatever), methods to handle it, add an object variable as a member of the udt and assign to it a pointer to an instance of the class. This way you can add support for anything you want. You will call the methods of the class as MyUdt.MyObjectVariable.MyMethod(MyParaemetrs).
Yes of course but several tried and possibly made some working stuff.
The thing i suggested is that we should avoid trying to create the perfect class system and then discover it get's to bloathed or to difficult to handle.
Therefore i only mentioned a simple dispatch at first, then i would suggest to *keep* the simple vtable calls or simple wrappers.
Main issue to me was the destructor handled by the compiler during getting out of scope.
I plan to do this in the year ~2015 so i guess you guys won't wait for me :)
Forget about bloat and complexities. You are always thinking in COM Automation and dispatch variables whereas I'm always thinking in direct calls. A custom class derived from IUnknown has very little overhead.
Just wait, i'll present my idea within the hour.
I have it already working..
Here is my implementation of a class in PB, you'll see you can extend it by adding functions to it and use call dword or a macro doing this for you.
Forget PB's dispatches on this one.
The VTABLE code:
Type VTableInfo
lParam As Long '[-2]
nAddref As Long '[-1]
' Object.. don't change from here
pObject As Dword Ptr
QueryInterface As Dword
AddRef As Dword
Release As Dword
End Type
Declare Function AddRef( ByVal pThis As Dword Ptr ) As Long
Function CreateVTableObject( ByRef vTable As VTableInfo, ByRef v As Variant, ByVal lParam As Dword ) As Long
Local lpvObj As VARIANTAPI Ptr
VTable.QueryInterface = 0
VTable.AddRef = CodePtr( AddRef )
VTable.Release = CodePtr( Release )
VTable.pObject = VarPtr( VTable.QueryInterface )
VTable.lParam = lParam
lpvObj = VarPtr( v )
@lpvObj.vt = %VT_Unknown
@lpvObj.vd.pdispVal = VarPtr( vTable.pObject )
Call Dword VTable.@pObject[1] Using AddRef( ByVal VarPtr( VTable.pObject ) )
End Function
Function AddRef( ByVal pThis As Dword Ptr ) As Long
Incr @pThis[-1]
MsgBox "AddRef " & Format$( @pThis[-1] ), %MB_TASKMODAL
End Function
Function Release( ByVal pThis As Dword Ptr ) As Long
Decr @pThis[-1]
MsgBox "Release " & Str$( @pThis[-1] ) & ", Data: " & Str$( @pThis[-2] ), %MB_TASKMODAL
If @pThis[-1] = 0 Then
' free class data here
End If
End Function
To make use of it you'll (unf) need to hold 2 variables, if one can get rid of this, please..
Function Test() As Long
' The object which will inform you when it get's destructed using the Release() call.
Local vObject As Variant
' Local VTable which holds additional info for vObject.
Local VTable1 As VTableInfo
' Create the object and set custom data, this could also be a pointer to class data.
CreateVTableObject( VTable1, vObject, 123 )
' The procedure is about to exit, PB will destroy the interface when getting out of scope.
' The Release() call is executed.
End Function
In case you need another reference, after using CreateVTableObject() you can simply use:
Local v2 As Variant
v2 = vObject
This will call Addref() and so on again..
Here is a version which does not require the 2nd var:
Type pvTableInfo
pSelf As Dword
lParam As Long '[-2]
nAddref As Long '[-1]
' Object.. don't change from here
pObject As Dword Ptr
QueryInterface As Dword
AddRef As Dword
Release As Dword
End Type
Declare Function AddRef( ByVal pThis As Dword Ptr ) As Long
Function CreatevTableObject( ByRef v As Variant, ByVal lParam As Dword ) As Long
Local lpvObj As VARIANTAPI Ptr
Local pvTable As pvTableInfo Ptr
pvTable = HeapAlloc( GetProcessHeap(), %HEAP_ZERO_MEMORY, SizeOf( pvTableInfo ) )
@pvTable.pSelf = pvTable
@pvTable.QueryInterface = 0
@pvTable.AddRef = CodePtr( AddRef )
@pvTable.Release = CodePtr( Release )
@pvTable.pObject = VarPtr( @pvTable.QueryInterface )
@pvTable.lParam = lParam
lpvObj = VarPtr( v )
@lpvObj.vt = %VT_Unknown
@lpvObj.vd.pdispVal = VarPtr( @pvTable.pObject )
Call Dword @pvTable.@pObject[1] Using AddRef( ByVal VarPtr( @pvTable.pObject ) )
End Function
Function AddRef( ByVal pThis As Dword Ptr ) As Long
Incr @pThis[-1]
MsgBox "AddRef " & Format$( @pThis[-1] ), %MB_TASKMODAL
End Function
Function Release( ByVal pThis As Dword Ptr ) As Long
Decr @pThis[-1]
MsgBox "Release " & Str$( @pThis[-1] ) & ", Data: " & Str$( @pThis[-2] ), %MB_TASKMODAL
If @pThis[-1] = 0 Then
' free custom class data here
'....
' Free the object from memory.
HeapFree( GetProcessHeap(), 0, ByVal @pThis[-3] )
End If
End Function
Function Test() As Long
' The object which will inform you when it get's destructed using the Release() call.
Local vObject As Variant
' Create the object and set custom data, this could also be a pointer to class data.
CreateVTableObject( vObject, 123 )
' Create another copy
Local v2 As Variant
v2 = vObject
' The procedure is about to exit, PB will destroy the interface when getting out of scope.
' The Release() call is executed.
End Function
Very interesting. Thanks for sharing. It proves that classes don't need to be bloated. But the problem is not to create a class, but to store, manage and retrieve the data when you deal with strings, arrays, udts, variants... What I want to see in a future version fo the compiler is something like:
CLASS MyClass
DIM s AS STRING
DIM v AS VARIANT
' More dims - this will be static data
INTERFACE MyInterface
' Methods to manage the data
MyMethod (params...)
LOCAL p as LONG
' More local variables if needed
' Code
END METHOD
' More methods
END INTERFACE
END CLASS
DIM pObj AS MyInterface
pObj = NEW MyClass
pObj.MyMethod (...)
Hah! you see..?
You make it complex right away. ( :) )
Like i said, this is the reason no one really prepared classes for pb.. since it 'must' look a la com.
This is PB, you'll never get the correct syntax, i was able to ~do as you suggest with PwrDev, i had classes in a module and when the code got generated it converted certain parts.
No my main issue was that we finally have a system which is cleaned up by the compiler for you, a deconstructer is the first one needs.
I left calling custom functions out but i had to go zzzz, i will write a better and modular class system and post it on the PB forum.
I'll try to keep it simple but it will never look like com (object.blabla)
The PwrDev classes *where* com since it bloathed it with a dispatch handler.
(Name > memberid's and so)
For PwrDev users: i never published this part since i was not satisfied with it, still to complex to work with.
For this new stuff, my methods will look like:
TheClassfunction( vObject, [other params] )
This is not an issue imo.
:)
(The lparam as i showed on creation will be removed then, a simple createobject() call would be needed)
Here is a simple example:
Macro vthisconv = Local pThis As Dword Ptr: pThis = Variant#( vThis ): If pThis = 0 Then Exit Function
Function SetParam( ByRef vThis As Variant, ByVal Value As Long ) As Long
vthisconv
@pThis[-2] = Value
End Function
Function GetParam( ByRef vThis As Variant ) As Long
vthisconv
Function = @pThis[-2]
End Function
Called with:
SetParam( vObject, 234 )
There really seems a future with this one..
Jose,
your example reminds me of VB.NET.
If we would really get this thing, it would be possible to represent all sorts of "real world" datastructures without workarounds directly into PB representatives.
I worked a few hours on this today and came up with the following.
This is the custom part iow a construction to create 'class1'
The VarClass code is uniform and does not need any attention, it's just a simple include.
The destructor might be helpful for 'your' dynamic strings issue.
I'll post this code within a few hours on the pb site.
'-----------------------------------------------------------------------
' The class's public data, there is no private data
'-----------------------------------------------------------------------
Type Class1_PublicData
lParam As Long
szText As Asciiz * 10
End Type
'-----------------------------------------------------------------------
' Wrapper to instantiate this class more easily
'-----------------------------------------------------------------------
Function Class1_Create( ByRef vNewObject As Variant ) As Long
VarClass_CreateObject( vNewObject, Class1_PublicData, CodePtr( Class1_Constructor ), CodePtr( Class1_Destructor ) )
End Function
'-----------------------------------------------------------------------
' The class's contructor and destructor, these are optional.
' A destructor is useful to free memory like when using pointers in the public data and so.
'-----------------------------------------------------------------------
Function Class1_Constructor( ByVal pThis As Dword Ptr ) As Long
MsgBox "Class1_Constructor", %MB_TASKMODAL
End Function
Function Class1_Destructor( ByVal pThis As Dword Ptr ) As Long
MsgBox "Class1_Destructor", %MB_TASKMODAL
End Function
'-----------------------------------------------------------------------
' The class's parameters, just pass the variant object.
'-----------------------------------------------------------------------
Function Class1_SetParam( ByRef vThis As Variant, ByVal Value As Long ) As Long
VarClass_VariantToPublicData( Class1_PublicData )
@PublicData.lParam = Value
End Function
Function Class1_GetParam( ByRef vThis As Variant ) As Long
VarClass_VariantToPublicData( Class1_PublicData )
Function = @PublicData.lParam
End Function
Function Class1_SetText( ByRef vThis As Variant, szText As Asciiz ) As Long
VarClass_VariantToPublicData( Class1_PublicData )
@PublicData.szText = szText
End Function
Function Class1_GetText( ByRef vThis As Variant ) As String
VarClass_VariantToPublicData( Class1_PublicData )
Function = @PublicData.szText
End Function
Test function used.
'-----------------------------------------------------------------------
' Test function, shows how to create an instance of class1.
' It also shows how to create another reference to the same object (v2)
'-----------------------------------------------------------------------
Function Test() As Long
' The object which will inform you when it get's destructed using the Release() call.
Local vObject As Variant
' Create the object and set custom data, this could also be a pointer to class data.
Class1_Create( vObject )
' Create another reference to vObject.
Local v2 As Variant
v2 = vObject
Class1_SetParam( vObject, 234 )
Class1_SetText( vObject, Time$ )
Local lParam As Long
Local sText As String
lParam = Class1_GetParam( v2 )
sText = Class1_GetText( v2 )
MsgBox Str$( lParam ) & ", " & sText
' The procedure is about to exit, PB will destroy the interface when getting out of scope.
' The Release() call is executed.
End Function
It's online now, good luck :)