will PB ever support COM? 
Author Message
 will PB ever support COM?

Just a question.
Someone said, if you like to define your structures yourselves etc... I
don't like to rewrite all the code myself...

I believe this but some nice low level programmer could write templates for
IUnknown and IDispatch and of course for the exported functions such as
DllGetClassObject

The typelibrary can be compiled using MIDL and the TLB can be merged in the
DLL as a resource...

Here's a starting hint for a light weight COM object (enumerator) written in
VB 6

Option Explicit
' History:
'          29/01/2001 * Get's it's own heap to be independand by E. Nierop
'                     * Does not use a custom safearray
'          05/27/2000 * The object uses the
'                       SAFEARRAY from the
'                       FastCollection class.
'          04/26/2000 * Fixed a bug on the Next_
'                       method that which didn't
'                       return the item.
'          04/25/2000 * Code was released
'
'***************************************************************************
******************
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion(127) As Integer  ' Maintenance string for PSS usage.
End Type

Private Type IEnumVARIANT  ' Object struct
   vtable As Long       ' Pointer to vtable
   RefCount As Long     ' Reference count
   hHeap As Long        ' Handle of heap object used to create the object
   Items() As Variant
   MaxIdx As Long       ' Number of items
   CurrentIndex As Long ' Current index
End Type

'Private Const sIID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
'Private Const sIID_IEnumVARIANT = "{00020404-0000-0000-C000-000000000046}"

Private IID_IUnknown As UUID
Private IID_IEnumVARIANT As UUID

Public Const vbComError As Long = &H80070000
Public Const HEAP_ZERO_MEMORY = &H8&
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const S_FALSE = &H1&
Public Const E_NOTIMPL = &H80004001
Public Const VT_BYREF As Long = &H4000
Public Const VT_UNKNOWN As Long = vbDataObject

Public lngCodePage As Long
Public lngLCID As Long

Private sTimeSep As String
Private sTimeFormat As String
Private sLongTimeFormat As String

Private Const E_NOINTERFACE = &H80004002
Public Const E_FAIL As Long = &H80004005
Public Const E_INVALIDARG As Long = &H80070057
Public Const NORM_IGNORECASE As Long = &H1

Private Function QueryInterface(This As IEnumVARIANT, riid As UUID, lObj As
Long) As Long

    If IsEqualGUID(riid, IID_IUnknown) Or _
       IsEqualGUID(riid, IID_IEnumVARIANT) Then

       ' Return a pointer to
       ' this object
       lObj = VarPtr(This)

       ' Increment the reference count
       This.RefCount = This.RefCount + 1

    Else

       ' Set the return value to "Nothing"
       lObj = 0

       ' Return the error
       QueryInterface = E_NOINTERFACE

    End If

End Function

Private Function AddRef(This As IEnumVARIANT) As Long

    ' Increment the reference count
    This.RefCount = This.RefCount + 1

    ' Return the reference count
    AddRef = This.RefCount

End Function

Private Function Release(This As IEnumVARIANT) As Long
    Dim lPtr As Long
    ' Decrement the reference count
    This.RefCount = This.RefCount - 1

    ' Return the reference count
    Release = This.RefCount

    ' Destroy the object if
    ' the reference count is 0
    If This.RefCount = 0 Then

       ' Remove the reference from
       ' the items array
        kernel.ZeroMemory ByVal ArrayPtr.VarPtrVariantArray(This.Items()), 4
       'kernel.ZeroMemory ByVal kernel.VarPtrVariantArray(This.Items(),
This.Items()), 4

       ' Release the memory
       ' used by the v-table

       HeapFree This.hHeap, 0, This.vtable

       ' Release the object itself
        'for some or other reason varPtr(this) = lObjPtr
       HeapFree This.hHeap, 0, VarPtr(This)

    End If

End Function

Private Function Next_(This As IEnumVARIANT, ByVal celt As Long, rgVar As
Variant, ByVal lpCeltFetched As Long) As Long

    With This

       If .CurrentIndex <= .MaxIdx Then

          ' Return a copy of the
          ' stored variant

          VariantCopy rgVar, .Items(.CurrentIndex)

          ' Increment the index
          .CurrentIndex = .CurrentIndex + 1

          If lpCeltFetched Then kernel.MoveMemory ByVal lpCeltFetched, 1, 4

       Else

          If lpCeltFetched Then kernel.ZeroMemory ByVal lpCeltFetched, 4

          Next_ = S_FALSE

       End If

    End With

End Function

Private Function Clone(This As IEnumVARIANT, NewIEnumVARIANT As
IEnumVARIANT) As Long

   Clone = E_NOTIMPL

End Function

Private Function Reset(This As IEnumVARIANT) As Long

   This.CurrentIndex = 1

End Function

Private Function Skip(This As IEnumVARIANT, ByVal celt As Long) As Long

   This.CurrentIndex = This.CurrentIndex + celt

End Function

Private Function AddrOf(ByVal Add As Long) As Long
   AddrOf = Add
End Function

Public Function CreateIEnumVARIANT(ByVal nrElements As Long, vtArray() As
Variant) As IUnknown
    Static vtable(0 To 6) As Long
    Dim IEnm As IEnumVARIANT
    Dim lPtr As Long
   ' Initialize IIDs
    'IIDFromString sIID_IEnumVARIANT, IID_IEnumVARIANT

    IID_IEnumVARIANT.Data1 = &H20404
    IID_IEnumVARIANT.Data4(0) = &HC0
    IID_IEnumVARIANT.Data4(7) = &H46

    'IIDFromString sIID_IUnknown, IID_IUnknown
    IID_IUnknown.Data4(7) = &H46

    Dim lObjPtr As Long
    Dim lPtr2 As Long
   ' Create the v-table
   vtable(0) = AddrOf(AddressOf QueryInterface) ' IUnknown.QueryInterface
   vtable(1) = AddrOf(AddressOf AddRef)         ' IUnknown.AddRef
   vtable(2) = AddrOf(AddressOf Release)        ' IUnknown.Release
   vtable(3) = AddrOf(AddressOf Next_)          ' IEnumVARIANT.Next
   vtable(4) = AddrOf(AddressOf Skip)           ' IEnumVARIANT.Skip
   vtable(5) = AddrOf(AddressOf Reset)          ' IEnumVARIANT.Reset
   vtable(6) = AddrOf(AddressOf Clone)          ' IEnumVARIANT.Clone

   ' Fill a temporary IEnumVariant struct
    With IEnm
      ' Copy the pointer to
        'kernel.MoveMemory ByVal kernel.VarPtrVariantArray(.Items(),
.Items()), ByVal kernel.VarPtrVariantArray(vtArray(), vtArray()), 4
        kernel.MoveMemory ByVal ArrayPtr.VarPtrVariantArray(.Items()), _
                        ByVal ArrayPtr.VarPtrVariantArray(vtArray()), 4

        .CurrentIndex = 0
        .MaxIdx = nrElements

        .hHeap = kernel.HeapCreate(0, 28 + LenB(IEnm), 28 + LenB(IEnm))

        .RefCount = 1

        ' Allocate memory for the vtable
        .vtable = HeapAlloc(.hHeap, HEAP_ZERO_MEMORY, 28)
        ' Copy the v-table
        kernel.MoveMemory ByVal .vtable, vtable(0), 28
        lObjPtr = HeapAlloc(.hHeap, HEAP_ZERO_MEMORY, LenB(IEnm))
   End With
   ' Allocate memory for the object
   ' Copy the struct to the allocated memory
   kernel.MoveMemory ByVal lObjPtr, IEnm, LenB(IEnm)
   'kernel.VarPtrVariantArray lPtr, IEnm.Items()
   'delete the pointer to the temp array
   kernel.ZeroMemory ByVal ArrayPtr.VarPtrVariantArray(IEnm.Items()), 4
   'kernel.ZeroMemory ByVal kernel.VarPtrVariantArray(IEnm.Items(),
IEnm.Items()), 4
   ' Copy the pointer to the return value
   kernel.MoveMemory CreateIEnumVARIANT, lObjPtr, 4
End Function

--
Egbert Nierop



Tue, 02 Dec 2003 01:58:42 GMT  
 will PB ever support COM?
Follow the weblinks on www.powerbasic.com and check out jazzage..
Com ala pointers

Quote:

>Just a question.
>Someone said, if you like to define your structures yourselves etc... I
>don't like to rewrite all the code myself...

>I believe this but some nice low level programmer could write templates for
>IUnknown and IDispatch and of course for the exported functions such as
>DllGetClassObject

>The typelibrary can be compiled using MIDL and the TLB can be merged in the
>DLL as a resource...

>Here's a starting hint for a light weight COM object (enumerator) written
in
>VB 6

>Option Explicit
>' History:
>'          29/01/2001 * Get's it's own heap to be independand by E. Nierop
>'                     * Does not use a custom safearray
>'          05/27/2000 * The object uses the
>'                       SAFEARRAY from the
>'                       FastCollection class.
>'          04/26/2000 * Fixed a bug on the Next_
>'                       method that which didn't
>'                       return the item.
>'          04/25/2000 * Code was released
>'
>'**************************************************************************
*
>******************
>Private Type OSVERSIONINFO
>   dwOSVersionInfoSize As Long
>   dwMajorVersion As Long
>   dwMinorVersion As Long
>   dwBuildNumber As Long
>   dwPlatformId As Long
>   szCSDVersion(127) As Integer  ' Maintenance string for PSS usage.
>End Type

>Private Type IEnumVARIANT  ' Object struct
>   vtable As Long       ' Pointer to vtable
>   RefCount As Long     ' Reference count
>   hHeap As Long        ' Handle of heap object used to create the object
>   Items() As Variant
>   MaxIdx As Long       ' Number of items
>   CurrentIndex As Long ' Current index
>End Type

>'Private Const sIID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
>'Private Const sIID_IEnumVARIANT = "{00020404-0000-0000-C000-000000000046}"

>Private IID_IUnknown As UUID
>Private IID_IEnumVARIANT As UUID

>Public Const vbComError As Long = &H80070000
>Public Const HEAP_ZERO_MEMORY = &H8&
>Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
>Private Const S_FALSE = &H1&
>Public Const E_NOTIMPL = &H80004001
>Public Const VT_BYREF As Long = &H4000
>Public Const VT_UNKNOWN As Long = vbDataObject

>Public lngCodePage As Long
>Public lngLCID As Long

>Private sTimeSep As String
>Private sTimeFormat As String
>Private sLongTimeFormat As String

>Private Const E_NOINTERFACE = &H80004002
>Public Const E_FAIL As Long = &H80004005
>Public Const E_INVALIDARG As Long = &H80070057
>Public Const NORM_IGNORECASE As Long = &H1

>Private Function QueryInterface(This As IEnumVARIANT, riid As UUID, lObj As
>Long) As Long

>    If IsEqualGUID(riid, IID_IUnknown) Or _
>       IsEqualGUID(riid, IID_IEnumVARIANT) Then

>       ' Return a pointer to
>       ' this object
>       lObj = VarPtr(This)

>       ' Increment the reference count
>       This.RefCount = This.RefCount + 1

>    Else

>       ' Set the return value to "Nothing"
>       lObj = 0

>       ' Return the error
>       QueryInterface = E_NOINTERFACE

>    End If

>End Function

>Private Function AddRef(This As IEnumVARIANT) As Long

>    ' Increment the reference count
>    This.RefCount = This.RefCount + 1

>    ' Return the reference count
>    AddRef = This.RefCount

>End Function

>Private Function Release(This As IEnumVARIANT) As Long
>    Dim lPtr As Long
>    ' Decrement the reference count
>    This.RefCount = This.RefCount - 1

>    ' Return the reference count
>    Release = This.RefCount

>    ' Destroy the object if
>    ' the reference count is 0
>    If This.RefCount = 0 Then

>       ' Remove the reference from
>       ' the items array
>        kernel.ZeroMemory ByVal ArrayPtr.VarPtrVariantArray(This.Items()),
4
>       'kernel.ZeroMemory ByVal kernel.VarPtrVariantArray(This.Items(),
>This.Items()), 4

>       ' Release the memory
>       ' used by the v-table

>       HeapFree This.hHeap, 0, This.vtable

>       ' Release the object itself
>        'for some or other reason varPtr(this) = lObjPtr
>       HeapFree This.hHeap, 0, VarPtr(This)

>    End If

>End Function

>Private Function Next_(This As IEnumVARIANT, ByVal celt As Long, rgVar As
>Variant, ByVal lpCeltFetched As Long) As Long

>    With This

>       If .CurrentIndex <= .MaxIdx Then

>          ' Return a copy of the
>          ' stored variant

>          VariantCopy rgVar, .Items(.CurrentIndex)

>          ' Increment the index
>          .CurrentIndex = .CurrentIndex + 1

>          If lpCeltFetched Then kernel.MoveMemory ByVal lpCeltFetched, 1, 4

>       Else

>          If lpCeltFetched Then kernel.ZeroMemory ByVal lpCeltFetched, 4

>          Next_ = S_FALSE

>       End If

>    End With

>End Function

>Private Function Clone(This As IEnumVARIANT, NewIEnumVARIANT As
>IEnumVARIANT) As Long

>   Clone = E_NOTIMPL

>End Function

>Private Function Reset(This As IEnumVARIANT) As Long

>   This.CurrentIndex = 1

>End Function

>Private Function Skip(This As IEnumVARIANT, ByVal celt As Long) As Long

>   This.CurrentIndex = This.CurrentIndex + celt

>End Function

>Private Function AddrOf(ByVal Add As Long) As Long
>   AddrOf = Add
>End Function

>Public Function CreateIEnumVARIANT(ByVal nrElements As Long, vtArray() As
>Variant) As IUnknown
>    Static vtable(0 To 6) As Long
>    Dim IEnm As IEnumVARIANT
>    Dim lPtr As Long
>   ' Initialize IIDs
>    'IIDFromString sIID_IEnumVARIANT, IID_IEnumVARIANT

>    IID_IEnumVARIANT.Data1 = &H20404
>    IID_IEnumVARIANT.Data4(0) = &HC0
>    IID_IEnumVARIANT.Data4(7) = &H46

>    'IIDFromString sIID_IUnknown, IID_IUnknown
>    IID_IUnknown.Data4(7) = &H46

>    Dim lObjPtr As Long
>    Dim lPtr2 As Long
>   ' Create the v-table
>   vtable(0) = AddrOf(AddressOf QueryInterface) ' IUnknown.QueryInterface
>   vtable(1) = AddrOf(AddressOf AddRef)         ' IUnknown.AddRef
>   vtable(2) = AddrOf(AddressOf Release)        ' IUnknown.Release
>   vtable(3) = AddrOf(AddressOf Next_)          ' IEnumVARIANT.Next
>   vtable(4) = AddrOf(AddressOf Skip)           ' IEnumVARIANT.Skip
>   vtable(5) = AddrOf(AddressOf Reset)          ' IEnumVARIANT.Reset
>   vtable(6) = AddrOf(AddressOf Clone)          ' IEnumVARIANT.Clone

>   ' Fill a temporary IEnumVariant struct
>    With IEnm
>      ' Copy the pointer to
>        'kernel.MoveMemory ByVal kernel.VarPtrVariantArray(.Items(),
>.Items()), ByVal kernel.VarPtrVariantArray(vtArray(), vtArray()), 4
>        kernel.MoveMemory ByVal ArrayPtr.VarPtrVariantArray(.Items()), _
>                        ByVal ArrayPtr.VarPtrVariantArray(vtArray()), 4

>        .CurrentIndex = 0
>        .MaxIdx = nrElements

>        .hHeap = kernel.HeapCreate(0, 28 + LenB(IEnm), 28 + LenB(IEnm))

>        .RefCount = 1

>        ' Allocate memory for the vtable
>        .vtable = HeapAlloc(.hHeap, HEAP_ZERO_MEMORY, 28)
>        ' Copy the v-table
>        kernel.MoveMemory ByVal .vtable, vtable(0), 28
>        lObjPtr = HeapAlloc(.hHeap, HEAP_ZERO_MEMORY, LenB(IEnm))
>   End With
>   ' Allocate memory for the object
>   ' Copy the struct to the allocated memory
>   kernel.MoveMemory ByVal lObjPtr, IEnm, LenB(IEnm)
>   'kernel.VarPtrVariantArray lPtr, IEnm.Items()
>   'delete the pointer to the temp array
>   kernel.ZeroMemory ByVal ArrayPtr.VarPtrVariantArray(IEnm.Items()), 4
>   'kernel.ZeroMemory ByVal kernel.VarPtrVariantArray(IEnm.Items(),
>IEnm.Items()), 4
>   ' Copy the pointer to the return value
>   kernel.MoveMemory CreateIEnumVARIANT, lObjPtr, 4
>End Function

>--
>Egbert Nierop



Tue, 02 Dec 2003 04:23:38 GMT  
 will PB ever support COM?
Hi Egbert,

COM support in PowerBASIC is high on the wish list, but R&D have not
stated when COM support will be implemented.  

In case you are not aware, PowerBASIC, Inc. operate a "no-vaporware"
policy - therefore, it is unlikely R&D/Sales will preannounce features
before the product is available for shipping.  

Finally, thanks for taking the time to post this code and ask the
question!

Quote:

>Just a question.

<snip>

Lance
PowerBASIC Support

-------------------------------------------------------------------------
PowerBASIC, Inc.      | 800-780-7707 Sales | "We put the Power in Basic!"
316 Mid Valley Center | 831-659-8000 Voice | http://www.powerbasic.com



Tue, 02 Dec 2003 19:44:50 GMT  
 
 [ 3 post ] 

 Relevant Pages 

1. OCX/COM support in PB/DLL

2. add support for COM and OCXs to PB/DLL-CC

3. add COM components and OCXs support to PB/DLL-CC

4. Announcing the JazzAge COM Wizard for PB/DLL and PB/CC

5. will realbasic ever support oracle

6. Is PC-NFS ever going to support BIND

7. Was there ever F9x OS/2 support?

8. JA COM/PB 2.0 release

9. FREE: create advanced COM components in PB/DLL

10. OutPut to COM from PB\DLL

11. Delete pb@football.com?

12. PB 3.2.PB/Vision 2.0 Timerinstallcode.Shared Arrays

 

 
Powered by phpBB® Forum Software