Modul BaseClass ClassDispatch inklusive ClassFactory

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von mk-soft »

Wie angekündigt ist jetzt die BassClass als ClassDispatch inklusive ClassFactory für eigene registrierte DLL verfügbar.
Somit kann man jetzt ohne viel Aufwand mit Purebasic DLL´s erstellen die man zum Beispiel in VBScript oder in Excel verwenden kann.

Es gibt drei möglichenkeiten die Methoden zu erstellen.

1. Methode
Die Methode hat die gleichen Argumente wie die Dispatch Invoke.

2. Methode
Es wird eine eigene Methode 'DispInvoke' erstellt mit den Argumenten von Dispatch Invoke.
Dazu wird eine Procedure mit den Prefix 'Disp' für die Methode erstellt.
Aus dieser wird dann die Methode aufgerufen.

3. Methode
Es wird eine Methode erstellt mit zusätzlichen Type Information über die Argumente. Es können Methoden mit bis zu acht Argumente definiert werden.

Es gib folgende Schlüsselnamen für die Datentypen.
- Bool, Integer, Long, Quad, Float, Double, String, Date, Variant
Zusätzlich gibt es folgende Datentypen für den Rückgabewert der Methode.
- Void, Object


Properties definieren:
Es gibt die möglichkeit die Properties für den direkten Zugriff zu definieren.

Dazu gibt es folgende Macros:
- UseProperty(sProperty), DefineProperty(Name), DefinePropertyDate(Name)
- DefinePropertyVariant(Name), DefinePropertyVariantByRef(Name)
Und mit eigenen Name
- DefinePropertyAs(Name, sProperty) and DefinePropertyDateAs(Name, sProperty)
- DefinePropertyVariantAs(Name, sProperty), DefinePropertyVariantByRefAs(Name, sProperty)

Entwickler Diagnose:
Zum testen der COM-DLL gibt es die möglichkeit Logfiles zu erstellen.
Hierfür gibt es die Macros 'ClassDebug' und 'ClassDebugEx'
Um alles Debugfunktionen zu entfernen wird die konstante '#EnableClassDebug' auf false gestzt.

Für die COM-DLL benötig man eine eigene CLSID.
Diese kann mit folgenden Code ersteltt werden.

Code: Alles auswählen

Procedure.s CreateCLSID()
  Protected Uuid.iid, result.s, i
  UuidCreate_(Uuid.iid)
  result = "DataSection" + #CRLF$
  result + "  CLSID_App:" + #CRLF$
  result + "  Data.l $" + RSet(Hex(Uuid\Data1), 8, "0") + #CRLF$
  result + "  Data.w $" + RSet(Hex(Uuid\Data2), 4, "0")
  result + ", $" + RSet(Hex(Uuid\Data3), 4, "0") + #CRLF$
  result + "  Data.b $" + RSet(Hex(Uuid\Data4[0]), 2, "0")
  For i = 1 To 7
    result + ", $" + RSet(Hex(Uuid\Data4[i]), 2, "0")
  Next
  result + #CRLF$
  result + "EndDataSection" + #CRLF$
  Debug result
EndProcedure :CreateCLSID()
Registrierung der COM-DLL
Registry DLL
For Registry DLL as 32bit DLL
%systemroot%\SysWow64\regsvr32.exe "FolderToDLL\YourDLL.dll"
As 64Bit DLL
%systemroot%\System32\regsvr32.exe "FolderToDLL\YourDLL.dll"

For Unregistry DLL as 32bit DLL
%systemroot%\SysWow64\regsvr32.exe -u "FolderToDLL\YourDLL.dll"
As 64Bit DLL
%systemroot%\System32\regsvr32.exe - u "FolderToDLL\YourDLL.dll"
Zur Übersicht habe ich ein neues Beispiel erstellt.

Das Modul 'Modul_BaseClassDispatch.pb' liegt im englischen Forum.
Ist einfacher an einer Stelle zu pflegen :wink:

Link zum englischen Forum: http://www.purebasic.fr/english/viewtop ... 12&t=68101
Zuletzt geändert von mk-soft am 20.05.2017 17:03, insgesamt 11-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von mk-soft »

Neue Beispiel als Übersicht...

Code: Alles auswählen

;-TOP

IncludeFile "Modul_BaseClassDispatch.pb"

; Create Logfile
ClassCommon::EnableClassDebug()

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

DeclareModule ClassExample
  
  UseModule ClassDispatch
  ; Properties
  Structure sClassExample Extends sClassDispatch
    name.s
    value.d
    pbdate.i
  EndStructure
  ; Methodes
  Interface iClassExample Extends iClassDispatch
    SetName(Name.s)
    GetName.s()
    GetValue.d()
    SetValue(Value.d)
  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)
  DefineProperty(Value)
  ; Defined Public Property with own name
  DefinePropertyDateAs(Date, sClassExample\pbdate)
  
  ; ---------------------------------------------------------------------------
  
  ; ToDo first by new object
  Procedure Init(*this.sClassExample)
    ClassDebug("Init Object ", *this)
    *this\name = "Purebasic Power"
    *this\value = 0.0
    *this\pbdate = Date()
  EndProcedure : AsInitalizeObject(Init)
  
  ; ---------------------------------------------------------------------------
  
  ; ToDo by release object
  Procedure Dispose(*this.sClassExample)
    ClassDebug("Dispose Object ", *this)
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ---------------------------------------------------------------------------
  
  ; Own DispInvoke
  Procedure DispSetName(*this.iClassExample, DispId.l, *iid.IID, lcid.l, Flags.w, *DispParams.DISPPARAMS, *vResult.VARIANT, *ExcepInfo.EXCEPINFO, *ArgErr.Integer)
    Protected cArgs, *vArgs.udtArrayVariant, r1.i
    cArgs = *DispParams\cArgs
    *vArgs = *DispParams\rgvarg
    ; Check count of arguments
    If cArgs <> 1
      ProcedureReturn #DISP_E_BADPARAMCOUNT
    EndIf
    ; Invoke methode
    r1 = *this\SetName(GetVariantString(*vArgs\Arg[0]))
    ; Set result
    If *vResult
      SetVariantInteger(*vResult, r1)
    EndIf
    ProcedureReturn #S_OK
  EndProcedure
  
  Procedure SetName(*this.sClassExample, Name.s)
    With *this
      \name = Name
      ProcedureReturn Len(\name)
    EndWith
  EndProcedure : AsMethode(SetName)
  
  ; ---------------------------------------------------------------------------
  
  ; Create the DispInvoke over Macro
  Procedure.s GetName(*this.sClassExample)
    Protected text.s
    With *this
      text = \name
      ProcedureReturn text
    EndWith
  EndProcedure : AsMethodeDisp(GetName, String)
  
  ; ---------------------------------------------------------------------------
  
  ; Create the DispInvoke over Macro
  Procedure SetValue(*this.sClassExample, Value.d)
    With *this
      \value = Value
    EndWith
  EndProcedure : AsMethodeDisp(SetValue, Void, Double)
  
  ; ---------------------------------------------------------------------------
  
  ; Create the DispInvoke over Macro
  Procedure.d GetValue(*this.sClassExample)
    Protected value.d
    With *this
      value = \value
      ProcedureReturn value
    EndWith
  EndProcedure : AsMethodeDisp(GetValue, Double)
  
  ; ---------------------------------------------------------------------------
  
  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, len, text
set obj = createobject("PureExample.Application")

msgbox "Started: " & obj.date

len = obj.SetName("Purebasic COM-Power")
msgbox "Len of name: " & len

msgbox "Methode GetName: " + obj.getname
msgbox "Property Name: " + obj.name

obj.value = inputbox("Value:", Value)

msgbox "Methode GetValue: " + cstr(obj.getvalue)
msgbox "Property Value: " + cstr(obj.value)

set obj = Nothing
Zuletzt geändert von mk-soft am 14.05.2017 16:56, insgesamt 1-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von mk-soft »

Beispiel 3 Multiline Inputbox

Code: Alles auswählen

;-TOP

IncludeFile "Modul_BaseClassDispatch.pb"

; Create Logfile
ClassCommon::EnableClassDebug()

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

DeclareModule ClassDialog
  
  UseModule ClassDispatch
  
  Structure sClassDialog Extends sClassDispatch
    
  EndStructure
  
  Interface iClassDialog Extends iClassDispatch
    InputBox(*this.sClassDialog, DispId.l, *iid.IID, lcid.l, Flags.w, *DispParams.DISPPARAMS, *vResult.VARIANT, *ExcepInfo.EXCEPINFO, *ArgErr.Integer)
  EndInterface
  
  UnuseModule ClassDispatch
  
  Declare.i New()
  
EndDeclareModule

Module ClassDialog
  
  EnableExplicit
  
  UseModule ClassCommon
  UseModule ClassDispatch
  
  CompilerIf Defined(pData, #PB_Structure) = 0
    Structure pData
      StructureUnion
        llVal.q[0]
        lVal.l[0]
        bVal.b[0]
        iVal.w[0]
        fltVal.f[0]
        dblVal.d[0]
        boolVal.w[0]
        bool.w[0]
        scode.l[0]
        cyVal.l[0]
        date.d[0]
        bstrVal.i[0]
        varVal.VARIANT[0]
        Value.VARIANT[0]
      EndStructureUnion
    EndStructure
  CompilerEndIf

  NewClass(iClassDialog)
  
  ; ---------------------------------------------------------------------------
  
  Procedure saCreateSafeArray(vartype, Lbound, Elements)
    Protected rgsabound.SAFEARRAYBOUND, *psa
    rgsabound\lLbound = Lbound
    rgsabound\cElements = Elements
    *psa = SafeArrayCreate_(vartype, 1, rgsabound)
    ProcedureReturn *psa
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  ; Format:
  ; List = obj.InputBox(Titel, Message1, Message2, Message3, ..., MessageX)

  Procedure InputBox(*this.sClassDialog, DispId.l, *iid.IID, lcid.l, Flags.w, *DispParams.DISPPARAMS, *vResult.VARIANT, *ExcepInfo.EXCEPINFO, *ArgErr.Integer)
    Protected cArgs, *vArgs.udtArrayVariant
    Protected r1.s, count, index , x, y, iArg, btnOk, *psa.safearray
    
    cArgs = *DispParams\cArgs
    *vArgs = *DispParams\rgvarg
    If cArgs < 2
      ProcedureReturn #DISP_E_BADPARAMCOUNT
    EndIf
    ; Create Dialog
    iArg = cArgs - 1
    count = cArgs - 1
    y = 5
    If OpenWindow(0, #PB_Ignore, #PB_Ignore, 480, 30 * count + 40, GetVariantString(*vArgs\Arg[iArg]))
      For index = 0 To count - 1
        iArg - 1
        TextGadget(#PB_Any, 5, y + 3, 120, 24, GetVariantString(*vArgs\Arg[iArg]))
        StringGadget(index, 130, y, 340, 24, "")
        y + 30
      Next
      btnOk = ButtonGadget(#PB_Any, 180, y, 120, 25, "Ok")
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_Gadget
            If EventGadget() = btnOk
              Break
            EndIf
          Case #PB_Event_CloseWindow
            Break
        EndSelect
      ForEver
      ; Create array für result
      *psa = saCreateSafeArray(#VT_VARIANT, 0, count) 
      If Not *psa
        CloseWindow(0)
        ProcedureReturn #E_OUTOFMEMORY
      EndIf
      ; Fill array from diaglog
      For index = 0 To count - 1
        SetVariantString(*psa\pvData\Value[index], GetGadgetText(index))
      Next
      ; Set result to array
      *vResult\vt = #VT_ARRAY | #VT_VARIANT
      *vResult\parray = *psa
      CloseWindow(0)
      ProcedureReturn #S_OK
    Else
      ProcedureReturn #E_OUTOFMEMORY
    EndIf
  EndProcedure : AsMethode(InputBox)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New()
    InitObject(sClassDialog)
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface(iClassDialog)
  
EndModule

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

Procedure InitDLL()
  Global ProgramId.s   = "PureExample3.Application"
  Global ClassId.s    = ClassCommon::GetGuidString(?CLSID_App) ;"{01AAD4B2-FFFF-4E08-FFFF-FFFF60FF3B23}"
  Global Description.s = "Purebasic Example 3 Dialog"
EndProcedure : InitDLL()

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

InitClassFactory(ProgramId, ClassId, Description, ClassDialog::@New(), ?CLSID_App)

; ***************************************************************************************
VB-Script
dim obj, list, item, text
set obj = createobject("PureExample3.Application")
'list = obj.InputBox("Multi Input Box", "Fisrst Name:", "Last name:")
list = obj.InputBox("Multi Input Box", "Fisrst Name:", "Last name:", "Age:")
For Each item In list
text = text + item + vbNewLine
next
msgbox text
set obj = Nothing
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von mk-soft »

Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von GPI »

Ok, ich hab eine blöde Verständnisfrage.
Es geht um deine Klasse ClassDispatch und die Methode GetIDsOfNames
Das entspricht doch der COM-Klasse IDispatch, oder?

Bei dir wird die Namen-Tabelle so interpretiert, das sie alle Member-Namen darstellen.

Wenn ich hier nachlese: https://msdn.microsoft.com/de-de/librar ... s.85).aspx
When GetIDsOfNames is called with more than one name, the first name (rgszNames[0]) corresponds to the member name, and subsequent names correspond to the names of the member's parameters
Dann heißt es aber, das in der Namensliste in [0] ein Methode steht und in [1] Ein Parameter dieser Methode steht! oder Interpretiere ich da was falsch?
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von mk-soft »

Das ist schon richtig, aber für diesen Parameter müsste auch eine DispID und eine Methode angelegt werden die mit Invoke aufgerufen werden kann.
Wird aber nicht unbedingt benötigt, halte aber die Möglichkeit offen.

Habe auch bis jetzt noch kein Beispiel oder Dokumentation dafür gefunden um diese zu testen und zu implementieren...

P.S.
Bei anderen Sprachen setzt man ein Hacken um ein COM-Objekt zu erstellen und es wird alles automatisch erledigt.
Geht natürlich so nicht mit Purebasic. Habe aber das Grundlegende so weit wie es geht mit schon implementiert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von GPI »

mk-soft hat geschrieben:P.S.
Bei anderen Sprachen setzt man ein Hacken um ein COM-Objekt zu erstellen und es wird alles automatisch erledigt.
Geht natürlich so nicht mit Purebasic. Habe aber das Grundlegende so weit wie es geht mit schon implementiert.
Leider. Gilt für Objekte/Klassen allgemein. Da sind alle versatzstücke vorhanden, man weigert sich leider, sie engültig zusammenzusetzen....
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von GPI »

Ich hab heute was durchaus spannendes gefunden:
https://msdn.microsoft.com/de-de/librar ... s.85).aspx

Minimum die DispCallFunc() Funktion dürfte für dich sein. Damit werden quasi die DISP*-Proceduren überflüssig.Die Variant-Parameter werden hier einfach in einen normalen Aufruf umgewandelt.

Ich experimentiere gerade mit CreateDispTypeInfo, DispGetIDsOfNames und DispInvoke. Wenn man sich wirklich die Mühe macht, die Methoden mit parameter aufzuzählen, erledigen die Routinen wirklich alles, sogar das umwandeln.

Nur CreateStdDispatch mag bisher nicht bei mir - der gibt einfach das Objekt frei und macht nichts... Würde viel Schreibarbeit ersparen.

__________________________________________________
URL-Tags hinzugefügt
03.05.2017
RSBasic
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von mk-soft »

Wird eher komplizierter.
Für CreateStdDispatch muss vorher schon das Object mit der Schnittstelle IUnknown angelegt sein um diese dann über Umweg eine IDispatch zu erstellen.

Dafür sollte man aber ein Extra-Thread auf machen wo jeder sich mit Automation-Schnittstellen auseinandersetzt und Erfahrungen austauscht.

P.S.
Was bei der Automation DispInvoke(...) passiert, sind bei mir die Procedure Disp[MethodeName](...) für die verschiedenen Methoden.
Hatte sehr lange überlegt wie diese über Macros automatisiert werden kann. Bin aber zu dem Ergebnis gekommen das dieses nur über ein Precompiler zu lösen ist.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Modul BaseClass ClassDispatch inklusive ClassFactory

Beitrag von GPI »

mk-soft hat geschrieben:Wird eher komplizierter.
Für CreateStdDispatch muss vorher schon das Object mit der Schnittstelle IUnknown angelegt sein um diese dann über Umweg eine IDispatch zu erstellen.

Dafür sollte man aber ein Extra-Thread auf machen wo sich mit Automation-Schnittstellen auseinandersetzt und Erfahrungen austauscht.

P.S.
Was bei der Automation DispInvoke(...) passiert, sind bei mir die Procedure Disp[MethodeName](...) für die verschiedenen Methoden.
Hatte sehr lange überlegt wie diese über Macros automatisiert werden kann. Bin aber zu dem Ergebnis gekommen das dieses nur über ein Precompiler zu lösen ist.
Trotzdem würde ich mir DispCallFunc_() anschauen, da fehlt dann die Typenüberprüfung, aber wenn wer Müll übergibt, bekommt Müll zurück ;)

Die Frage ist halt was geschickter ist. Für jede Prozedur eine Eigene "Disp"-Routine, oder ein Macrokonstrukt, das die iTypeInfo-Class erstellt. Ich stell mir das so vor:

Code: Alles auswählen

DefineTypinfo(class)
method("Get()")
method("set(int.i)")
EndDefine
Also in Macro einen String übergeben, der weiterverarbeitet wird. Style ist identisch zu Interface/Endinterface, so das man das einfach kopiert und umklammert.
Darf dann nur in Proceduren benutzt werden, weil es Code erzeugt.

Aber jetzt spiel ich erstmal rum, wie Properties etc. funktionieren und ein neuer Thread dürfte auch interessant sein.
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Antworten