Module BaseClass ClassDispatch inclusive ClassFactory

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.15
- Fixed GetIDsOfNames

The array of DispID is an array of Int32.
And the array of names is an array of pointers to names (x64 = 64bit?)

Can someone confirm this?
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.16
- Dispose object work now revers
- Save LinkedList Initialize object and Dispose object over Mutex
- Added global ObjectCounter over all Classes
- Change DllCanUnloadNow() with check ObjectCounter

:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.18
- Bugfix InitObject
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.19
- Moved ObjectCounter to ClassCommon

Update v1.20
- Bugfix RegisterServer
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.22
- Removed Macro AsNewMethode. AsMethode does the same
- Added Macro AsMethodeDisp. The Macro need type information over the method. *

* Creates the required procedure 'Disp[MethodeName[ (...). Up to 8 arguments are supported as standard variable types, as well as the return value as standard variable.

Names of standard argument types: (tArgX)
- Bool, Integer, Long, Float, Double, String

Names of standard return types: (tResult)
- Void, Object, Bool, Integer, Long, Float, Double, String

New shorter Example 4

Code: Select all

;-TOP

IncludeFile "Modul_BaseClassDispatch.pb"

; Create Logfile
ClassCommon::EnableClassDebug()

; *******************************************************************************

DeclareModule ClassTextObject
  
  UseModule ClassDispatch
  
  Structure sClassTextObject Extends sClassDispatch
    text.s
  EndStructure
  
  Interface iClassTextObject Extends iClassDispatch
    Upper.s()
    Lower.s()
    Reverse.s()
  EndInterface
  
  UnuseModule ClassDispatch
  
  Declare.i New(Text.s)
  
EndDeclareModule

Module ClassTextObject
  
  EnableExplicit
  
  UseModule ClassCommon
  UseModule ClassDispatch
  
  NewClass(iClassTextObject)
  
  ; ---------------------------------------------------------------------------
  
  ; Format: Text = Object.Upper
  
  Procedure.s Upper(*this.sClassTextObject) ; Result String
    ProcedureReturn UCase(*this\text)
  EndProcedure : AsMethodeDisp(Upper, String)
  
  ; ---------------------------------------------------------------------------
  
  ; Format: Text = Object.Lower
  
  Procedure.s Lower(*this.sClassTextObject) ; Result String
    ProcedureReturn LCase(*this\text)
  EndProcedure : AsMethodeDisp(Lower, String)
  
  ; ---------------------------------------------------------------------------
  
  ; Format : Text = Object.Reverse
  
  Procedure.s Reverse(*this.sClassTextObject) ; Result String
    ProcedureReturn ReverseString(*this\text)
  EndProcedure : AsMethodeDisp(Reverse, String)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Init(*this.sClassTextObject)
    ClassDebug("Init TextObject", *this)
  EndProcedure : AsInitalizeObject(Init)
  
  Procedure Dispose(*this.sClassTextObject)
    ClassDebug("Dispose TextObject", *this)
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New(text.s)
    Protected *obj.sClassTextObject
    AllocateObject(*obj, sClassTextObject)
    If *obj
      *obj\text = text
      InitalizeObject(*obj)
    EndIf
    ProcedureReturn *obj
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface(iClassTextObject)
  
EndModule

; ***************************************************************************************

DeclareModule ClassText
  
  UseModule ClassDispatch
  
  Structure sClassText Extends sClassDispatch
    
  EndStructure
  
  Interface iClassText Extends iClassDispatch
    Text(String.s)
  EndInterface
  
  UnuseModule ClassDispatch
  
  Declare.i New()
  
EndDeclareModule

Module ClassText
  
  EnableExplicit
  
  UseModule ClassCommon
  UseModule ClassDispatch
  
  NewClass(iClassText)
  
  ; ---------------------------------------------------------------------------
  
  ; Object = obj.Text("String")
  
  Procedure Text(*this.iClassText, String.s) ; Result: Object of iClassTextObject
    ProcedureReturn ClassTextObject::New(String)
  EndProcedure : AsMethodeDisp(Text, Object, String)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New()
    InitObject(sClassText)
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface(iClassText)
  
EndModule

; ***************************************************************************************

;- Test as DLL

CompilerIf #PB_Compiler_Debugger
  
  Debug "Test with Purebasic code"
  
  ClassDispatch::ShowClasses()
  
  *obj.ClassText::iClassText = ClassText::New()
  *obj2.ClassTextObject::iClassTextObject = *obj\Text("Hello World")
  Debug *obj2\Upper()
  Debug *obj2\Lower()
  Debug *obj2\Reverse()
  *obj2\Release()
  *obj\Release()
  
CompilerElse
  
  ; Create DLL
  EnableExplicit
  
  Procedure InitDLL()
    Global ProgramId.s   = "PureExample4.Application"
    Global ClassId.s    = ClassCommon::GetGuidString(?CLSID_App); "{01AAD4B2-FFFF-4E08-FFFF-FFFF60FF3B24}"
    Global Description.s = "Purebasic Example 4 with simple object"
  EndProcedure : InitDLL()
  
  DataSection
    CLSID_App:
    Data.l $01AAD4B2
    Data.w $FFFF, $4E08
    Data.b $FF, $FF, $FF, $FF, $60, $FF, $3B, $24
  EndDataSection
  
  InitClassFactory(ProgramId, ClassId, Description, ClassText::@New(), ?CLSID_App)
  
CompilerEndIf
VBS
dim obj, obj2
set obj = createobject("PureExample4.Application")
set obj2 = obj.text("Hello World")

msgbox obj2.Upper
msgbox obj2.Lower
msgbox obj2.Reverse

msgbox obj.text("purebasic ").Upper & obj.text("rewoP").Reverse
set obj = Nothing
:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.23
- Added: UseProperty(...) and DefineProperty. Defining properties for direct access

New Example 1

Code: Select all

;-TOP

IncludeFile "Modul_BaseClassDispatch.pb"

; Create Logfile
ClassCommon::EnableClassDebug()

; *******************************************************************************

DeclareModule ClassUser
  
  UseModule ClassDispatch
  
  Structure sClassUser Extends sClassDispatch
    firstname.s
    lastname.s
    age.i
  EndStructure
  
  Interface iClassUser Extends iClassDispatch
    SetName(FirstName.s, LastName.s)
    GetName.s()
    GetFirstName.s()
    GetLastName.s()
  EndInterface
  
  UnuseModule ClassDispatch
  
  Declare.i New()
  
EndDeclareModule

Module ClassUser
  
  EnableExplicit
  
  UseModule ClassCommon
  UseModule ClassDispatch
  
  NewClass(iClassUser)
  
  ; ---------------------------------------------------------------------------
  
  UseProperty(sClassUser)
  DefineProperty(firstname)
  DefineProperty(lastname)
  DefineProperty(age)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Init(*this.sClassUser)
    *this\firstname = "no name"
    *this\lastname = "no name"
  EndProcedure : AsInitalizeObject(Init)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Dispose(*this.sClassUser)
    Debug "Dispose Object " + *this
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ---------------------------------------------------------------------------
  
  Procedure SetName(*this.sClassUser, FirstName.s, LastName.s)
    ClassDebug("Parameter: " + FirstName + ", " + LastName)
    With *this
      \firstname = FirstName
      \lastname = LastName
    EndWith
  EndProcedure : AsMethodeDisp(SetName, Void, String, String)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetName(*this.sClassUser)
    Protected text.s
    With *this
      text = "Name: " + \firstname + " " + \lastname + "; Age: " + Str(\age)
      ProcedureReturn text
    EndWith
  EndProcedure : AsMethodeDisp(GetName, String)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetFirstName(*this.sClassUser)
    Protected text.s
    With *this
      text = \firstname
      ProcedureReturn text
    EndWith
  EndProcedure : AsMethodeDisp(GetFirstName, String)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetLastName(*this.sClassUser)
    Protected text.s
    With *this
      text = \lastname
      ProcedureReturn text
    EndWith
  EndProcedure : AsMethodeDisp(GetLastName, String)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New()
    InitObject(sClassUser)
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface(iClassUser)
  
EndModule

; ***************************************************************************************

;- Test as DLL

EnableExplicit

Procedure InitDLL()
  Global ProgramId.s   = "PureExample.Application"
  Global ClassId.s     = "{01AAD4B2-FFFF-4E08-FFFF-FFFF60FF3B21}"
  Global Description.s = "Purebasic Example COM-DLL"
EndProcedure : InitDLL()

DataSection
  CLSID_App:
  Data.l $01AAD4B2
  Data.w $FFFF, $4E08
  Data.b $FF, $FF, $FF, $FF, $60, $FF, $3B, $21
EndDataSection

InitClassFactory(ProgramId, ClassId, Description, ClassUser::@New(), ?CLSID_App)
VBS
dim obj, text
set obj = createobject("PureExample.Application")

obj.SetName "Purebasic", "COM-Power"

msgbox obj.firstname
msgbox obj.lastname

obj.firstname = "Tom"
obj.lastname = "Smith"
obj.age = 51

msgbox obj.getname

set obj = Nothing
:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.25
- Added datatype date
- Cleanup code

In this I have revised my description in the first contribution :wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.27
- Optimize change Variant-Type to Purebasic-Variable
- Added Datatype Variant for Method and Property

New:
- There are new macros to define properties for Variant and Variant ByRef.
- DispInvoke now also supports the result type variant and argument type variant.

Short example

Code: Select all

;-TOP Example 1.3
IncludeFile "Modul_BaseClassDispatch.pb"

; Create Logfile
ClassCommon::EnableClassDebug()

; *******************************************************************************

DeclareModule ClassExample
  
  UseModule ClassDispatch
  ; Properties
  Structure sClassExample Extends sClassDispatch
    name.s
    data1.variant
    *data2.variant ; It must be allocated memory
    vResult.variant ; Helpbuffer for DispInvoke result of type Variant
  EndStructure
  
  ; Methodes
  Interface iClassExample Extends iClassDispatch
    GetName()
  EndInterface
  
  UnuseModule ClassDispatch
  ; Create new Object
  Declare.i New()
  
EndDeclareModule

Module ClassExample
  
  EnableExplicit
  
  UseModule ClassCommon
  UseModule ClassDispatch
  
  ; Create Class
  NewClass(iClassExample)
  
  ; ---------------------------------------------------------------------------
  
  ; Defined Public Properties
  UseProperty(sClassExample)
  DefineProperty(Name)
  DefinePropertyVariant(data1)
  DefinePropertyVariantByRef(data2)
  
  ; ---------------------------------------------------------------------------
  
  ; Do by new object
  Procedure Init(*this.sClassExample)
    ClassDebug("Init Object ", *this)
    *this\data2 = AllocateStructure(Variant)
  EndProcedure : AsInitalizeObject(Init)
  
  ; ---------------------------------------------------------------------------
  
  ; Do by release object
  Procedure Dispose(*this.sClassExample)
    ClassDebug("Dispose Object ", *this)
    FreeStructure(*this\data2)
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ---------------------------------------------------------------------------
  
  Procedure GetName(*this.sClassExample) ; Result pointer to Variant
    With *this
      SetVariantString(\vResult, \name)
      ProcedureReturn \vResult
    EndWith
  EndProcedure : AsMethodeDisp(GetName, Variant)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New()
    InitObject(sClassExample) ; Do not more
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface(iClassExample)
  
EndModule

; ***************************************************************************************

;- Create ClassFactory

EnableExplicit

; Always encapsulate in a procedure
Procedure InitDLL()
  Global ProgramId.s   = "PureExample.Application"
  Global ClassId.s     = ClassCommon::GetGuidString(?CLSID_App)
  Global Description.s = "Purebasic Example COM-DLL"
EndProcedure : InitDLL()

; Own CLSID
DataSection
  CLSID_App:
  Data.l $01AAD4B2
  Data.w $FFFF, $4E08
  Data.b $FF, $FF, $FF, $FF, $60, $FF, $3B, $21
EndDataSection

InitClassFactory(ProgramId, ClassId, Description, ClassExample::@New(), ?CLSID_App)
VBS
dim obj
set obj = createobject("PureExample.Application")

obj.name = now()
msgbox obj.getname()

obj.data1 = time()
obj.data2 = date()

msgbox "(" & obj.data1 & " " & obj.data2 & ")"

obj.data1 = "Purebasic Power"
msgbox obj.data1

set obj = Nothing
:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Update v1.28
- Bugfix CloneObject
- Added Constants #DISPID

Example 'How to create object with reference to parent object'

Rules:
- The method parent must deliver the object.
- When the object is created, the reference must be passed to the parent object.
- When the parent object is returned, the parent object's reference counter must be increased.

Code: Select all

;-TOP

; Example 1-4

IncludeFile "Modul_BaseClassDispatch.pb"

; Create Logfile
ClassCommon::EnableClassDebug()

; *******************************************************************************

DeclareModule ClassPosition
  
  UseModule ClassDispatch
  ; Properties
  Structure sClassPosition Extends sClassDispatch
    *parent
    PosX.i
    PosY.i
  EndStructure
  
  ; Methodes
  Interface iClassPosition Extends iClassDispatch
    Parent()
  EndInterface
  
  UnuseModule ClassDispatch
  ; Create new Object
  Declare.i New(*Parent, PosX, PosY)

EndDeclareModule

Module ClassPosition
  
  EnableExplicit
  
  UseModule ClassCommon
  UseModule ClassDispatch
  
  ; Create Class
  NewClass(iClassPosition)
  
  ; ---------------------------------------------------------------------------
  
  UseProperty(sClassPosition)
  DefineProperty(PosX)
  DefineProperty(PosY)
  
  ; ---------------------------------------------------------------------------
  
  ; Get Parent Object
  Procedure Parent(*this.sClassPosition) ; Result Parent Object
    Protected *parent.IUnknown
    *parent = *this\parent
    If *parent
      *parent\AddRef() ; Add refcounter from parent object
    EndIf
    ProcedureReturn *parent
  EndProcedure : AsMethodeDisp(Parent, Object)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New(*Parent, PosX, PosY)
    Protected *obj.sClassPosition
    AllocateObject(*obj, sClassPosition)
    If *obj
      *obj\parent = *Parent
      *obj\PosX = PosX
      *obj\PosY = PosY
      InitalizeObject(*obj)
    EndIf
    ProcedureReturn *obj
  EndProcedure
  
EndModule

; *******************************************************************************

DeclareModule ClassExample
  
  UseModule ClassDispatch
  ; Properties
  Structure sClassExample Extends sClassDispatch
    name.s
    data1.variant
    *data2.variant ; It must be allocated memory
    vResult.variant ; Helpbuffer for DispInvoke result of type Variant
  EndStructure
  
  ; Methodes
  Interface iClassExample Extends iClassDispatch
    GetName()
    Position(Pos_X, Pos_Y)
  EndInterface
  
  UnuseModule ClassDispatch
  ; Create new Object
  Declare.i New()
  
EndDeclareModule

Module ClassExample
  
  EnableExplicit
  
  UseModule ClassCommon
  UseModule ClassDispatch
  
  ; Create Class
  NewClass(iClassExample)
  
  ; ---------------------------------------------------------------------------
  
  ; Defined Public Properties
  UseProperty(sClassExample)
  DefineProperty(Name)
  DefinePropertyVariant(data1)
  DefinePropertyVariantByRef(data2)
  
  ; ---------------------------------------------------------------------------
  
  ; Do by new object
  Procedure Init(*this.sClassExample)
    ClassDebug("Init Object ", *this)
    *this\data2 = AllocateStructure(Variant)
  EndProcedure : AsInitalizeObject(Init)
  
  ; ---------------------------------------------------------------------------
  
  ; Do by release object
  Procedure Dispose(*this.sClassExample)
    ClassDebug("Dispose Object ", *this)
    FreeStructure(*this\data2)
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ---------------------------------------------------------------------------
  
  Procedure GetName(*this.sClassExample) ; Result pointer to Variant
    With *this
      SetVariantString(\vResult, \name)
      ProcedureReturn \vResult
    EndWith
  EndProcedure : AsMethodeDisp(GetName, Variant)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Position(*this.sClassExample, PosX, PosY) ; Result pointer to Object
    With *this
      ProcedureReturn ClassPosition::New(*this, PosX, PosY)
    EndWith
  EndProcedure : AsMethodeDisp(Position, Object, Integer, Integer)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New()
    InitObject(sClassExample) ; Do not more
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface(iClassExample)
  
EndModule

; ***************************************************************************************

;- Create ClassFactory

EnableExplicit

; Always encapsulate in a procedure
Procedure InitDLL()
  Global ProgramId.s   = "PureExample.Application"
  Global ClassId.s     = ClassCommon::GetGuidString(?CLSID_App)
  Global Description.s = "Purebasic Example COM-DLL"
EndProcedure : InitDLL()

; Own CLSID
DataSection
  CLSID_App:
  Data.l $01AAD4B2
  Data.w $FFFF, $4E08
  Data.b $FF, $FF, $FF, $FF, $60, $FF, $3B, $21
EndDataSection

InitClassFactory(ProgramId, ClassId, Description, ClassExample::@New(), ?CLSID_App)
VBS
dim obj, obj2
set obj = createobject("PureExample.Application")

obj.name = "I like Purebasic!"

set obj2 = obj.position(20, 10)
msgbox "Parent Name : " & obj2.parent.name & vbNewLine & "PosX = " & obj2.posx & vbNewLine & "PosY = " & obj2.posy
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Rinzwind
Enthusiast
Enthusiast
Posts: 636
Joined: Wed Mar 11, 2009 4:06 pm
Location: NL

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by Rinzwind »

Does this DLL also work 'registry free''? Any example of the manifest file(s)?

I tried this for the initial example in the post... no luck

Code: Select all

<xml version="1.0" encoding="utf-8"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <assemblyIdentity name="Test6.exe"
                    version="1.0.0.0"
                    processorArchitecture="ia64"
                    type="win32"
                    />
  <file name="Example1.dll">
    <comClass clsid="{01AAD4B2-FFFF-4E08-FFFF-FFFF60FF3B21}"
              threadingModel="Apartment"
              progid="PureExample.Application"
              description="PureExample.Application" />
  </file>
</assembly>
Rinzwind
Enthusiast
Enthusiast
Posts: 636
Joined: Wed Mar 11, 2009 4:06 pm
Location: NL

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by Rinzwind »

Ah got it working after MANY attempts. The caching of manifests does not help at all...

Example64.sxs.manifest

Code: Select all

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
    type="win32"
    name="Example64.sxs"
    version="1.0.0.0" />
<file name="Example64.dll">
    <comClass
        description="Purebasic Example COM-DLL"
        clsid="{01AAD4B2-FFFF-4E08-FFFF-FFFF60FF3B21}"
		progid="PureExample.Application"
		/>
</file>
</assembly>
client embedded manifest (<filename>.exe.manifest)

Code: Select all

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">

<assemblyIdentity
  type="win32"
  name="client"
  version="1.0.0.0" />
  <dependency>
          <dependentAssembly>
              <assemblyIdentity
                  type="win32"
                  name="Example64.sxs"
                  version="1.0.0.0" />
          </dependentAssembly>
  </dependency>
</assembly>
Or just combined and embedded into the exe

Code: Select all

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <assemblyIdentity
    version="1.0.0.0"
    processorArchitecture="amd64"
    name="CompanyName.ProductName.YourApp"
    type="win32" />
  <description></description>
  <dependency>
    <dependentAssembly>
      <assemblyIdentity
        type="win32"
        name="Microsoft.Windows.Common-Controls"
        version="6.0.0.0"
        processorArchitecture="amd64"
        publicKeyToken="6595b64144ccf1df"
        language="*" />
    </dependentAssembly>
  </dependency>
	<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
    <security>
      <requestedPrivileges>
        <requestedExecutionLevel
          level="asInvoker"
          uiAccess="false"/>
        </requestedPrivileges>
       </security>
  </trustInfo>
	<file name="Example64.dll">
		<comClass
			description="Purebasic Example COM-DLL"
			clsid="{01AAD4B2-FFFF-4E08-FFFF-FFFF60FF3B21}"
			progid="PureExample.Application"
			/>
	</file>
</assembly>
Rinzwind
Enthusiast
Enthusiast
Posts: 636
Joined: Wed Mar 11, 2009 4:06 pm
Location: NL

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by Rinzwind »

Any reason and way to speed things up when calling a com-procedure? Seems so much more slower in a tight loop then one created in VB6? Some meta-data missing? Both called from vbscript as in a for loop as 'fair' test. In pure PB it is fast. The com-function call in VBScript on the PB com-object is much slower than a VB6 created com-object.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by mk-soft »

Debug output (logging) is enabled by default.
Each access to the object is logged in a file.
That consumes already times much time.

Module Common
#EnableClassDebug = #True


Each parameter is checked and if necessary adjusted by the automation function VariantChangeType.
This also takes a little more time than a direct access.

When debug output is turned on, you can track which calls are executed in the object until you have a result from a method.

Info:
A standard DLL with a pull function is therefore always faster than a COM object DLL.

P.S.
There are two ways to use a COM object.
With late binding: Call using the functions of the IDispatch.
With early binding: Direct calls to the methods. For this, the caller must know the entire interface with all parameters.

There is also the optimized interface for late binding 'IDispatchEX'. If this interface does not exist, the caller automatically returns to the interface 'IDispatch'.

Unfortunately I did not find an open description and examples in 'C' of the interface 'IDispatchEx' for the implementation for my module.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Rinzwind
Enthusiast
Enthusiast
Posts: 636
Joined: Wed Mar 11, 2009 4:06 pm
Location: NL

Re: Module BaseClass ClassDispatch inclusive ClassFactory

Post by Rinzwind »

Argh stupid me. The obvious escaped me... the debug code was the problem indeed.

Thanks for your work. Keep it up and going 8)

ps. if you ever look at this project again, a way to automatically generate a typelib would be a nice-to-have.
Post Reply