Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

StringC.inc - Hybrid COM String Class

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • StringC.inc - Hybrid COM String Class

    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
    stanthemanstan~gmail
    Dead Theory Walking
    Range Trie Tree
    HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

  • #2
    Code:
    '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
    '
    stanthemanstan~gmail
    Dead Theory Walking
    Range Trie Tree
    HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

    Comment


    • #3
      test/sample
      Code:
      '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
      stanthemanstan~gmail
      Dead Theory Walking
      Range Trie Tree
      HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

      Comment

      Working...
      X