StringC.inc - Hybrid COM String Class

[Stanley Durham Member Find all posts View Profile Close Stanley Durham]

Dynamic String Class - Hybrid COM Object

the object may be store/restored in any LONG
h = o.Ptr : o.Ptr = h
so, you can store the dynamic string object in a UDT

Hybrid COM Object:
- must allocate internal memory before using object; o.Alloc()
- must free allocated memory before object goes out of scope; o.Free()

object also needs to be initialized with an error handler before use;
local e as ErrT 'Error.inc
o.Initialize(e)

same error handler should be used for all hybrid objects.

This seems like a lot of trouble at first, but the "hybrid" concept allows
you to build lightweight class, list/trees/stacks, with millions if instances
and still use them as PB COM objects.
cal also be stored and passed as a Long.

Hybrid COM Object is basically like C++, New & Delete; except only the
internal UDT is allocated and freed - not the whole object.

all source and sample/test app: StringC.zip
http://deadtheorywalking.com/pb.aspx
public domain - use at your own risk

Note: you need to download source to compile
error and memory lib not posted

[Stanley Durham Member Find all posts View Profile Close Stanley Durham]

'PB 5/9 .02
'StringC.inc
'
'   Dynamic String Class - Hybrid COM Object
'
#Include Once "GlobalMem.inc"
'
%StringC_Hash = 1795437505
'
Macro StringC_ErrStatus(exitWhat) = If pe = %null Or @pe.err Then Exit exitWhat
Macro StringC_ExitIf(test, message, exitWhat)
    If test Then
        Err_Set @pe, %ErrUndefined, "StringC.inc", "StringC", "StringI", FuncName$, message
        Exit exitWhat
    End If
End Macro
'
Type StringCT
    hash As Long
    Count As Long
    bytes As Byte Ptr
End Type
'
Class StringC
    Instance p As StringCT Ptr
    Instance pe As ErrT Ptr
    '
    Interface StringI : Inherit IUnknown
        '
        Method Initialize(e As ErrT)
            'set error handler
            pe = VarPtr(e)
        End Method
        '
        Method Alloc()
            'allocate new instance
            StringC_ErrStatus(Method)
            p = GMem_Alloc(SizeOf(@p), @pe)
            If @pe.err Then Exit Method
            @p.hash = %StringC_Hash
        End Method
        '
        Method Free()
            'free instance
            StringC_ErrStatus(Method)
            If p Then
                me.Clear()
                p = GMem_Free(p, @pe)
            End If
        End Method
        '
        Property Get Ptr() As Long
            'get current instance
            StringC_ErrStatus(Property)
            Property = p
        End Property
        '
        Property Set Ptr(ByVal hMem As Long)
            'set current instance
            StringC_ErrStatus(Property)
            p = hMem
            If p Then
                StringC_ExitIf(@p.hash <> %StringC_Hash, "invalid instance handle", Property)
            End If
        End Property
        '
        Method Clear()
            'null string
            StringC_ErrStatus(Method)
            StringC_ExitIf(p = %null, "null instance", Method)
            If @p.bytes Then @p.bytes = GMem_Free(@p.bytes, @pe)
            @p.bytes = %null
            @p.count = 0
        End Method
        '
        Property Get Count() As Long
            'get stored byte count
            '   strings stored with added null; o.Count() includes null
            '   buffers stored as is
            StringC_ErrStatus(Property)
            StringC_ExitIf(p = %null, "null instance", Property)
            Property = @p.count
        End Property
        '
        Property Get Str() As String
            'get string
            StringC_ErrStatus(Property)
            StringC_ExitIf(p = %null, "null instance", Property)
            If @p.count > 1 Then Property = Peek$(@p.bytes, @p.count - 1)
        End Property
        '
        Property Set Str(In ByRef v As String)
            'set string - null added to end of string
            StringC_ErrStatus(Property)
            StringC_ExitIf(p = %null, "null instance", Property)
            If @p.bytes Then @p.bytes = GMem_Free(@p.bytes, @pe)
            @p.count = Len(v) + 1
            @p.bytes = GMem_Alloc(@p.count, @pe)
            If @pe.err Then Exit Property
            Poke$ @p.bytes, v
        End Property
        '
        Property Get Len() As Long
            'get string length
            StringC_ErrStatus(Property)
            StringC_ExitIf(p = %null, "null instance", Property)
            If @p.count Then Property = @p.count - 1
        End Property
        '
        Method Compare(In ByRef v As String, Opt ByVal upperCase As Long) As Long
            'compare stored string to v
            'string = v : method = 0
            'string < v : method < 0
            'string > v : method > 0
            Local i, theEnd As Long
            Local cA, cB As Long
            Local lenA, lenB As Long
            Local result As Long
            Local pB As Byte Ptr
            '
            StringC_ErrStatus(Method)
            StringC_ExitIf(p = %null, "null instance", Method)
            '
            lenA = IIf&(@p.count, @p.count - 1, 0)
            lenB = Len(v)
            If lenA = 0 Then
                Method = IIf&(lenB, -1, 0)
            ElseIf lenB = 0 Then
                Method = 1
            Else
                theEnd = Min&(lenA, lenB) - 1
                pB = StrPtr(v)
                If upperCase Then
                    For i = 0 To theEnd
                        cA = @[email protected][i] : If cA>96 And cA<123 Then cA -= 32
                        cB = @pB[i]       : If cB>96 And cB<123 Then cB -= 32
                        result = cA - cB
                        If result Then
                            Method = result
                            Exit Method
                        End If
                    Next i
                Else
                    For i = 0 To theEnd
                        cA = @[email protected][i]
                        cB = @pB[i]
                        result = cA - cB
                        If result Then
                            Method = result
                            Exit Method
                        End If
                    Next i
                End If
                Method = lenA - lenB
            End If
        End Method
        '
        Property Get StrPtr() As Long
            'get pointer to stored string
            StringC_ErrStatus(Property)
            StringC_ExitIf(p = %null, "null instance", Property)
            Property = @p.bytes
        End Property
        '
        Property Get Buffer() As String
            'get stored buffer
            StringC_ErrStatus(Property)
            StringC_ExitIf(p = %null, "null instance", Property)
            If @p.count Then Property = Peek$(@p.bytes, @p.count)
        End Property
        '
        Property Set Buffer(In ByRef v As String)
            StringC_ErrStatus(Property)
            StringC_ExitIf(p = %null, "null instance", Property)
            If @p.bytes Then @p.bytes = GMem_Free(@p.bytes, @pe)
            @p.count = Len(v)
            If @p.count Then
                @p.bytes = GMem_Alloc(@p.count, @pe)
                Poke$ @p.bytes, v
            End If
        End Property
        '
    End Interface
    '
End Class
'

[Stanley Durham Member Find all posts View Profile Close Stanley Durham]

test/sample

'PB 9
%ErrHaltActive = 1
$TestSource = "StringC.bas"
$TestTitle = "String Class Test"
#Compile Exe "StringC.exe"
#Dim All
#Optimize Speed
#If Not %Def(%WINAPI)
    #Include Once "WIN32API.INC"
#EndIf
#Include Once "PBForms.INC"
#Include "StringC.inc"
'
%Dlg1    =  101
%BtnTest = 1002
%Lbx     = 1001
'
Global lbx As ListBoxI
Global tmr As TimerI
'
Sub BtnTest(ByVal hDlg As Long)
    Local e As ErrT
    Local s As StringI : s = Class "StringC" : s.Initialize(e)
    Local pz As Asciiz Ptr
    '
    lbx.Clear(2)
    '
    '   hybrid COM object - must be allocated before use
    s.Alloc()
    '
    '
    lbx.Add("")
    lbx.Add("set string: 'testing'")
    s.Str = "testing"
    lbx.Add("append; ' 123'")
    s.Str = s.Str + " 123"
    lbx.Add("string = " + $Dq + s.Str + $Dq)
    '
    lbx.Add("string Len() = " + Format$(s.Len))
    lbx.Add("Count() = " + Format$(s.Count))
    '
    lbx.Add("")
    lbx.Add("get ASCIIZ ptr")
    pz = s.StrPtr
    lbx.Add("@pz = " + $Dq + @pz + $Dq)
    '
    lbx.Add("")
    lbx.Add("set buffer: " + $Dq + "123" + $Dq)
    s.Buffer = "123"
    lbx.Add("buffer = " + $Dq + s.Buffer + $Dq)
    lbx.Add("Count() = " + Format$(s.Count))
    '
    '
    '   hybrid COM object - must free internal memory before object goes out of scope
    s.Free()
    '
    lbx.Add("")
    lbx.Add("done...")
End Sub
'
Function PBMain()
    ShowDlg1 %HWND_Desktop
End Function
CallBack Function ShowDlg1Proc()
    Select Case As Long CbMsg
        Case %WM_InitDialog
             lbx = Class "ListBoxC"
             lbx.INI(Cb.Hndl, %Lbx)
             lbx.SetHorizontal(1000)
             tmr = Class "TimerC"
        Case %WM_Command
            Select Case As Long CbCtl
                Case %BtnTest
                    If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
                        BtnTest(Cb.Hndl)
                    End If
            End Select
    End Select
End Function
Function ShowDlg1(ByVal hParent As Dword) As Long
    Local lRslt  As Long
    Local hDlg   As Dword
    Local hFont1 As Dword
    Dialog New hParent, $TestTitle, 67, 61, 341, 241, %WS_Popup _
        Or %WS_Border Or %WS_DlgFrame Or %WS_Caption Or %WS_SysMenu Or _
        %WS_MinimizeBox Or %WS_ClipSiblings Or %WS_Visible Or %DS_ModalFrame _
        Or %DS_3DLook Or %DS_NoFailCreate Or %DS_SetFont, _
        %WS_Ex_ControlParent Or %WS_Ex_Left Or %WS_Ex_LtrReading Or _
        %WS_Ex_RightScrollbar, To hDlg
    Control Add ListBox, hDlg, %Lbx, , 5, 5, 330, 210, %WS_Child Or _
        %WS_Visible Or %WS_HScroll Or %WS_VScroll Or %LBS_Notify Or _
        %LBS_NoIntegralHeight, %WS_Ex_ClientEdge Or %WS_Ex_Left Or _
        %WS_Ex_LtrReading Or %WS_Ex_RightScrollbar
    Control Add Button,  hDlg, %BtnTest, "Test", 275, 220, 60, 15
    hFont1 = PBFormsMakeFont("Courier New", 9, 400, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)
    Control Send hDlg, %Lbx, %WM_SETFONT, hFont1, 0
    Dialog Show Modal hDlg, Call ShowDlg1Proc To lRslt
    DeleteObject hFont1
    Function = lRslt
End Function
Class ListBoxC
    Instance meHDlg As Long
    Instance meID As Long
    Interface ListBoxI
        Inherit IUnknown
        Method INI(ByVal hDlg As Long, ByVal Id As Long)
            meHDlg = hDlg
            meID = Id
        End Method
        Method SetHorizontal(ByVal Count As Long)
            Local hCntrl&
            Control Handle meHDlg, meID To hCntrl&
            SendMessage hCntrl&, %LB_SETHORIZONTALEXTENT, Count, 0
        End Method
        Method Clear(Opt doEventsCount As Long)
            ListBox Reset meHDlg, meID
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
        Method Add(ByVal s As String, Opt doEventsCount As Long) As String
            ListBox Add meHDlg, meID, s
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
    End Interface
    Class Method DoEventsCount(ByVal Count As Long)
        Local i As Long
        For i = 1 To Count
            Dialog DoEvents
        Next i
    End Method
End Class
Class TimerC
    Instance meTime As Double
    Interface TimerI
        Inherit IUnknown
        Method Start()
            meTime = Timer
        End Method
        Method Get() As String
            Method = "    Time: " + Format$(Timer - meTime, "###.###############")
        End Method
    End Interface
End Class