COM Objekte

Josh · **Registriert:** 04.08.2009 17:24

ts-soft hat geschrieben:

Ich freu mich schon auf das Beispiel :allright:

ja, lang lang ist's her, aber mein pb-bock war zwischendurch auf unter null und ich hab selbst noch einiges ausprobieren müssen. da es hier nicht nur um code geht und ich da ein bischen mehr ausgeholt hab, ist das in den tuts besser aufgehoben. wahrscheinlich bin ich eh schon der siebzehnte, der hier darüber schreibt, aber was solls. ein tut über com von maestro höchstpersönlich gibts übrigens hier. was ich jetzt hier schreiben, ist das, was ich mir in der letzten zeit so angelesen habe. bitte mich nicht gleich zu steinigen, wenn nicht alles stimmt. bitte posten, damit ich die fehler korrigieren kann.
Bild

com ist keine einbahnstraße. trotzdem wird der haupteinsatz in der nutzung von vorgegebenen com-objekten liegen. deswegen spreche ich in nachfolgenden text immer von der seite des com-nutzers, außer wenn ich mich ausdrücklich auf den com-anbieter beziehe. viele punkte gelten natürlich für beide seiten. in codebeispielen lasse ich vieleicht einige aspekte weg. oft sind wenige codezeilen schneller verständlich, auch wenn diese in einem lauffähigen programm noch ergänzt gehören (z.b. mit sicherheitsabfragen).

Objekte allgemein
da ein com-objekt eigentlich nur ein normales objekt mit ein paar standards ist, sollte man die funktion eines objektes erst mal intus haben. wenn du dich mal ein bischen damit beschäftigst, ist es eigentlich gar nicht so kompliziert. das wichtigste dabei ist, dass deine vTable im objekt an erster stelle eingetragen ist und dass die methoden in der vTable und im interface die gleiche reihenfolge haben. ein beispiel von einem einfachen objekt von ts-soft findest du hier. hier erstellt ts-soft erst mal eine klasse, in zeile 46 ruft er die new-methode auf und erstellt aus der klasse ein neues objekt.

Com-Objekte
um evtl. missverständnissen vorzubeugen. com hat nichts mit einer bestimmten programmiersprache, nichts mit oop, nichts mit windows und nichts mit microsoft zu tun. com ist ein festgelegter standard, der auf allen maschinen funktioniert, die mit 0 und 1 umgehen können. com hat in der grundform relativ einfache regeln. in verschiedenen programmiersprachen gibt es aufsätze, die das com handling stark vereinfachen. in pb fehlt dazu leider die native unterstützung und da werden wir auch noch warten bis wir schwarz sind. trotzdem ist es bis zu einem gewissen grad relativ einfach, com auch in pb zu nutzen.

Arten des Zugriffes

grundsätzlich muss man zwischen zwei arten des zugriffes auf die com-methoden unterscheiden. auf manche com-objekte ist der zugriff nur mit einer der beiden möglichkeiten gegeben. dies ist davon abhängig, ob das interface komplett bekannt ist und ob das interface IDispatch (siehe nächster punkt) implementiert ist. im idealfall ist das com-objekt so ausgelegt, dass beide zugriffsarten zulässig sind.

Frühe Bindung (statische Bindung, Early Binding, VTable Binding)

im prinzip geht hier nur darum, den richtigen einsprungspunkt für die methoden zu bekommen. das läuft wie in diesem beispiel und wenn das interface bekannt ist, kann auf die gleiche weise auf jedes com-objekt zugegriffen werden. wie man in diesem fall zum objekt kommt, da lasse ich mich später noch aus. da mit dem interface und dem objekt bereits zur kompilierungszeit alle einsprungspunkte bekannt sind, wird bei der kompilierung bereits alles aufgelöst und die exe braucht von einem interface gar nichts mehr zu wissen. leider ist der geschwindigkeitsvorteil nicht sooo gravierend, da der prozessübergreifende speicherzugriff das meiste an zeit wegfrisst. in einer dll sollte der zeitvorteil wieder größer sein, wenn alles in einem prozess abgehandelt wird. der zugriff auf diese art ist in pb am einfachsten zu verwirklichen und ist mit ein paar codezeile erstellt.

vorteile:
- einfach zu erstellen
- schneller zugriff

nachteile:
- bei einer neuen version des com-objektes könnte sich das interface ändern (nach meiner meinung zu vernachlässigen, da ein ordentlicher programmierer neue methoden einfach hinten anhängt)
- scriptsprachen können nicht mit früher bindung auf com-objekte zugreifen, da eben nichts kompiliert wird (ist aber nur als com-anbieter interessant)
- funktioniert nicht immer (hat zumindest bei mir manchmal probleme gemacht)

beispiel vb6:
Dim oWorksheet As Excel.Worksheet
mit der definition Worksheet kann vb das interface auslesen und damit bereits zur compilierungszeit auflösen

bemerkung:
dass der zugriff mit früher bindung nicht immer funktioniert, liegt evtl. noch an einer microsoft eigenheit. da haben die ganze arbeit geleistet und zur allgemeinen verwirrung im objektbrowser schnittstellen zu klassen upgegraded, was sie aber definitiv nicht sind. bin noch nicht dazugekommen mir das genauer anzuschauen ob es daran liegen könnte.

Späte Bindung (dynamische Bindung, Late Binding, Automation)

in gewissen situationen muss man auf ein objekt zugreifen, ohne zu wissen was einem entgegenkommt. ein beispiel wäre die pb-ide. wenn ich das objekt jedes tabs abfragen könnte, wüßte ich noch immer nicht, was hinter diesem objekt steckt. es könnte ein code sein, es könnte aber auch ein projekt sein. in einem solchen fall gibt es immer eine gemeinsame methode, die z.b. TabTyp heißen könnte. daraus frage ich dann ab, ob es ein code oder projekt ist und weiß damit, welche weiteren methoden mir zur verfügung stehen. wie man in diesem fall auf die methoden zugreifen kann, darauf komm ich später zurück.

vorteile:
- flexibler bei einer neuen version des com-objektes
- interface muss bei programmerstellung nicht bekannt sein

Nachteile:
- aufwändiger code erforderlich
- langsamer zugriff

beispiel vb6:
Dim oWorksheet As Object
zur kompilierungszeit ist nichts anderes bekannt, als dass es sich um ein objekt handelt.

bemerkung:
selbst bei einem unbekanntem objekt sollte es mit einem rumpfobjekt möglich sein auf die gemeinsamen methoden mittels früher bindung zuzugreifen und dann mit dem ergebnis das richtige interface zu benutzen. noch nicht probiert, sollte in den meisten fällen aber funktionieren.

Die beiden wichtigsten Interfaces

com bietet eine vielzahl von standardinterfaces, wovon zwei aber besonders hervorgehoben werden müssen, weil ohne die beiden in com gar nichts geht.

IUnknown

jedes com-objekt hat als mindestvoraussetzung die methoden dieses interfaces zu implementieren und IUnknown ist quasi die mutter aller com-objekte. wenn die drei methoden von IUnknown implementiert sind, ist ein einfaches com-objekt schon fertig. es steht nirgends geschrieben, dass ein com-objekt registriert sein muss, ein interfaceId oder weiteren schnickschnack haben muss. wenn dann noch ein paar zusätzliche methoden integriert werden, kann das com-objekt schon verwendet werden. IUnknown enthält folgende drei methoden:

Code:
Interface IUnknown
QueryInterface(a, b)
AddRef()
Release()
EndInterface

wenn nur die methoden von IUnknown implementiert sind, kann auf das com-objekt nur mit früher bindung zugegriffen werden.

QueryInterface aus sicht des com-nutzers:

ein com-objekt kann nicht nur selbst methoden implementiert haben, die klasse kann auch noch weitere schnittstellen zur verfügung stellen. mit QueryInterface können diese abgefragt werden.

AddRef/Release aus sicht des com-nutzers:

mit diesen beiden methoden wird der referenzzähle des objektes beeinflusst. der referenzzähler ist für die lebendsdauer des com-objektes zuständig. dieser beinhaltet immer die anzahl, wie oft ein zeiger auf das objekt (oder auf eine weitere schnittstelle der klasse) gespeichert worden ist. sobald dieser einmal auf 0 geht, zerstört sich das objekt selbst. in den meisten fällen braucht durch den nutzer nichts gemacht werden. sollte jedoch ein zeiger auf dieses com-objekt kopiert oder gelöscht werden, dann weiß das com-objekt ja nichts davon und AddRef/Release ist vom benutzer auszulösen. AddRef/Release gibt den wert des referenzzählers zurück. wenn man im entwicklungsstadium diesen wert mal zur kontrolle wissen will, dann immer in der reihenfolge objekt\AddRef() : Debug objekt\Release() abfragen. umgekehrt wäre das ein fall für schrödingers katze, wenn der referenzzähler bereits auf 1 steht.

die kontrolle über den referenzzähler zu behalten ist sehr wichtig, damit das com-objekt sich auch selbst zerstören kann. sonst bleibt das com-objekt bestehen und die anwendung des com-anbieters wird nicht beendet. bei abfrage des referenzzählers ist zu beachten, dass schnittstellen oft den referenzzähler der klasse benützen, obwohl die abfrage in der schnittstelle erfolgt ist. also nicht gleich verzweifeln, wenn der referenzzähler einer schnittstelle nicht auf 0 geht. erst wenn alle referenzen auf die schnittstellen der klasse und auf die klasse selbst entfernt sind, dann wird der referenzzähler auch auf 0 gehen.

ich habe schon öfter gesehen, dass der referenzzähler z.b. nach einem QueryInterface sofort wieder released wird. dies halte ich für keine gute praxis und geht vollkommen an der idee des referenzzählers vorbei. erst wenn der verweis aus der objektvariablen gelöscht wird, dann sollte auch das objekt released werden. wenn man das konsequent durchzieht, dann lässt sich das auch gut handeln und gibt weniger probleme, als wenn ich einen teil gleich und einen teil später released. der referenzzähler soll ja wirklich darstellen, wie oft noch ein verweis auf das objekt existiert.

QueryInterface aus sicht des com-anbieters:

dazu ist jetzt eine interfaceId (IID) notwendig. das heißt noch immer nicht, dass das com-objekt registriert sein muss. die IID muss lediglich dem anbieter und dem nutzer bekannt sein. in einfachen fällen genügt auch die IID_IUnknown alleine.
Code:
Procedure.l QueryInterface (*This.cSH_Site, *iid.IID, *Object.Integer)
Define *Me.cSH = *This\Me

;Standardzuweisungen auf eigenes Objekt
If CompareMemory(*iid, *This\IID, 16) Or CompareMemory(*iid, ?IID_IUnknown, 16)
*Object\i = *This
*This\cntRef + 1
ProcedureReturn #S_OK
EndIf

;Unbekanntes Interface
*Object\i = 0
ProcedureReturn #E_NOINTERFACE

EndProcedure
da passiert jetzt folgendes: der nutzer des com-objektes fragt mit der beiden bekannten IID über QueryInterface an, ob es sich um das gewünschte objekt handelt. Wenn QueryInterface nun feststellt, yeah, thats me, dann gibt es im procedurparameter einen zeiger auf das eigene objekt zurück. da davon ausgegangen werden kann, dass der nutzer diesen zeiger auch speichert, wird der referenzzähler gleich um eins erhöht. von der prozedur wird #S_OK zurückgegeben. das gleiche passiert, wenn der nutzer mit der IID_IUnknown anfragt. Wenn mit einer unbekannten IID angefragt wird, wird einfach #E_NOINTERFACE zurückgegeben.

wie schon geschrieben, kann eine klasse ja nicht nur eigene methoden zur verfügung stellen, sondern auch noch eigene schnittstellen beinhalten. dann führt aber kein weg mehr daran vorbei, jede coklasse braucht eine eigene IID, die beiden nutzern bekannt sein muss. obiger code wäre dann noch z.b. wie folgt zu ergänzen:
Code:
;SiteWindow Objekt zuweisen (wenn nicht vorhanden, dann erstellen)
If CompareMemory(*iid, ?IID_IActiveScriptSiteWindow, 16)
If *Me\oActiveScriptSiteWindow = 0
*Me\oActiveScriptSiteWindow = cSH_SiteWindow_New(*Me)
*Me\oActiveScriptSiteWindow\AddRef()
EndIf
*Object\i = *Me\oActiveScriptSiteWindow
*Me\oActiveScriptSiteWindow\AddRef()
ProcedureReturn #S_OK
EndIf
in diesem beispiel passiert folgendes: der nutzer des com-objektes fragt mit dem IID_IActiveScriptSiteWindow bei QueryInterface nach, ob es sich um das gewünschte objekt handelt. QueryInterface hat im ersten vergleich aber festgestellt, dass es sich nicht um das eigene com-objekt handelt. also: ne du, das bin nicht ich, aber ich weiß was. QueryInterface erstellt in diesem fall (falls noch nicht vorhanden) das gewünschte schnittstellenobjekt und gibt einen objektzeiger darauf über den prozedurparameter zurück.

IDispatch

IDispatch ist eine erweiterung von IUnknown und enthält vier methoden mit denen mit später bindung auf die methoden des com-objektes zugegriffen werden kann. wenn das interface bekannt ist, sollte man mit früher und später bindung auf das objekt zugreifen können. nur nebenbei bemerkt. wenn das com-objekt IDispatchEx unterstützt, dann sollte man diese methoden verwenden, da die leichter zum handeln sind.

Code:
Interface IDispatch Extends IUnknown
GetTypeInfoCount(a)
GetTypeInfo(a, b, c)
GetIDsOfNames(a, b, c, d, e)
Invoke(a, b, c, d, e, f, g, h)
EndInterface

die ersten beiden methoden sind zum zugriff auf die methoden nicht unbedingt erforderlich. der zugriff erfolgt in zwei schritten mit den methoden GetIDsOfNames und Invoke.

GetIDsOfNames / Invoke aus sicht des com-nutzers:

diese beiden methoden werden benötigt um auf das die einzelnen funktionen des com-objektes mit später bindung zugreifen zu können. zuerst wird mit GetIDsOfNames mittels des methodennames die DispId ermittelt. aus performancegründen sollte diese nur einmal abgefragt und für spätere zugriffe zwischengespeichert werden.

BStrings allocieren und frei geben

normalerweise ist es ja so, dass immer die anwendung, die einen speicher reserviert hat, diesen auch wieder frei geben muss. bei com verhält sich das ein bischen anders. grundsätzlich sind bStrings mit der api SysAllocString zu erstellen und mit der api SysFreeString wieder freizugeben. erst dadurch ist gewährleistet, dass jeder der beiden an com beteiligten partner den speicher auch wieder frei geben kann.

in beispiel 1 weiter unten wird von excel ein bstring mit dem titel übergeben. dazu sollte man sich immer überlegen, gibt es für den com-partner irgendeinen grund, irgendein ereignis wann er seinen bstring wieder frei geben sollte. in dem beispiel ist eigentlich vollkommen klar, es gibt keinen. excel sagt sich nicht, heute ist mittwoch, es ist 17:43, draußen scheint die sonne und weil ich grad lust und laune habe, gebe ich den speicher wieder frei. also kann es nur die aufgabe des empfängers sein, dass er den bstring wieder frei gibt, auch wenn er ihn nicht allociert hat.

gerade bei diesen bstrings sollte man fürchterlich aufpassen, dass diese ordentlich freigegeben werden. da die bstrings durch eine api reserviert werden, werden sie weder durch beenden des eigenen pb-programmes noch durch beenden des partnerprogrammes frei gegeben. da feiern die bstrings speicherparty bis zum abwinken, d.h. bis zum ausschalten des computers.

wenn der bstring in einer variant-struktur steht, kann auch die api VariantClear verwendet werden. bei windowseigenen methoden, die im msdn dokumentiert sind, steht meistens auch dabei, wer für die freigabe zuständig ist.

bei variants könnte das gleiche wie bei den bstrings gelten. dort ist es aber meistens so, dass der aufrufer einen varianttyp zur verfügung stellen muss und der partner schreibt dann was rein. safearrays könnten auch noch in dieses kapitel fallen, hab ich mich aber noch nicht damit beschäftigt.

Wie kommt man zu den Interfaces und IID's

ich verwende den OLE/COM Interfacegenerator von Stefan Moebius. den gibts hier zum downloaden. den interfacegenerator starten, dann z.b. die datei Excel.exe auswählen, auf create drücken und nach ein paar sekunden ist alles fertig. das ganze dann als pbi datei speichern und mit einem XIncludeFile in die anwendung einbinden.

leider hat das teil einen großen nachteil. da es fast in jeder anwendung ein interface mit dem namen 'Application' gibt, kommt es schnell mal zu problemen. es wäre hilfreich, wenn man einen string eingeben könnte, der jedem interface sozusagen als namespace vorangestellt wird. ich empfehle auf jeden fall, bei den optionen die möglichkeit Add Compiler directives auszuschalten. wenn es überschneidungen in der benamsung gibt, dann soll es gleich beim compilieren ordentlich krachen und nicht, dass dann für excel das applicationinterface aus word verwendet wird, nur weil dieses zufällig vorher erstellt wurde.

ach ja, hätte ich fast vergessen. der OLE/COM interfacegenerator leidet auch ein bischen alzheimer und vergiss schon mal einen parameter. dann kommt noch dazu, dass der interfacegenerator auch die dispinterfaces und die iid's für die dispinterfaces erzeugt, obwohl die eigentlich vollkommen nutzlos und nur verwirrend sind. wenn mal gar nichts funktioniert, dann am besten immer einen anderen viewer zum vergleichen bereit halten. ich verwende den oleview.exe von microsoft. den gibts hier zum downloaden.

wenn es sich nur um einzelne und kleinere interfaces handelt, die im msdn beschrieben sind, nicht umscheissen und lange suchen woraus die generiert werden können. es ist schneller die einfach selber zu schreiben schreiben.

Warum es erforderlich sein kann, selbst com-objekte anzubieten

einige anwendungen erfordern, dass man selbst ein com-objekt erstellt, das dann benutzt werden kann um die fremdanwendung zu steuern. so sind zum beispiel beim erstellen eines scripthostes einige com-objekte mit etlichen schnittstellen zu erstellen. über diese objekte wird dann die ganze kommunikation z.b. für fehler, skriptabbruch und debugging durchgeführt. allerdings handelt es sich hier um lauter objekte mit früher bindung, die on the fly erstellt werden können. ein weiteres beispiel ist dieser code von freak, wo er auch schnell mal das com-objekt NewSink erstellt.

Tipp zum erforschen von Klassen

wenn ihr mal eine com-anwendung selber erstellt oder gezwungen seid ein com-objekt selber zu erstellen, dann schreibt ihr ja in QueryInterface erst mal die standardzuweisungen auf euer eigenes objekt. schickt aber keinesfalls dann alles andere gleich in den nirvana. macht für euch eine message, dass ein unbekanntes interface angefragt wurde. da kommen oft sachen zutage, von denen ihr noch nie was gehört habt und momentan auch nicht wisst, was damit anzufangen ist. sucht in der registry oder im internet nach der iid und legt diese an. dann macht für jedes dieser unbekannten interfaces in QueryInterface einen eigenen vergleich und schickt es dann einzeln in den nirvana.

irgendwann kommt ihr dann wahrscheinlich bei euerem projekt auch auf den punkt, wo zwar alles ohne fehler läuft, ihr euch aber fragt 'was nun?'. mit einem blick auf die noch nicht implementierten schnittstellen kommt dann oft der große AHA effekt.

COMate

im zusammenhang von pb und com muss auf jeden fall auch noch COMate erwähnt werden. COMate arbeitet mit später bindung und hat dafür auch die gleichen vor- und nachteile. bei vielen gleichen zugriffen muss auf jeden fall mit COMate_PrepareStatement gearbeitet werden, sonst kommen unerträgliche laufzeiten zustande.

DCom

nur der vollständigkeitshalber sei hier noch DCom erwähnt. hier handelt es sich um eine com schnittstelle, die nicht nur über die prozessgrenzen sondern auch über die rechnergrenzen hinaus verwendet werden kann. ich hatte vor einiger zeit das zweifelhafte vergnügen, auf der seite eines unserer forumsmitglieder einen virus auszufassen, der mit DCom gearbeitet hat. nachdem ich den DCom dienst abwürgen konnte, konnte ich wieder normal arbeiten. das einzige was nicht funktioniert hat, waren die standard internetspiele wie reversi und backgammon. ergo: DCom ist für windowsspiele und viren zuständig :wink:

Beispiele und Laufzeiten

in den nachfolgenden beiträgen habe ich ein paar beispiele erstellt. generell sollen die beispiele eher einen rahmen zeigen. die beispiele sind sehr einfach und geradlinig programmiert. gerade bei der späten bindung kann durch ein paar prozeduren etliches an arbeit wegfallen. die meisten beispiele sind so nicht feldtauglich, da nur die allernotwendigsten sicherheitsabfragen eingebaut sind.

bitte alle beispiele mit unicodeunterstützung abspeichern

Beispiele 1-3
beispiel zum lesen/setzen von ein paar attribute und verwenden eines enumobjektes in excel. die vergleichszeiten für 10k durchläufe sehen bei mir folgendermaßen aus:

- frühe bindung: 1.234 ms
- späte bindung: 1.796 ms
- mit comate: 3.547 ms

Beispiele 4+5
hier habe ich ein selbstregistrierende com-dll mit dualinterface erstellt. die vergleichszeiten sehen bei mir für 1 mio durchläufe folgendermaßen aus:

- frühe bindung: 47 ms
- vba: 1.218 ms
- vbs: 2.546 ms
- comate: 2.969 ms

Josh · **Registriert:** 04.08.2009 17:24

Beispiel 1) Zugriff auf eine Excelanwendung mit früher Bindung

ich habe als beispie excel gewählt, weil das wahrscheinlich die meisten auf ihrem computer haben. die pbi datei mit den interfaces will ich hier nicht reinstellen, weil die 22k zeilen hat. bitte die datei ExcelTestEB.pbi downloaden und im gleichen verzeichnis wie ExcelTestEB.pb speichern. wenn diese pbi datei mit euerer excelversion nicht funktioniert, dann bitte mit dem interfacegenerator wie oben im text beschrieben eine neue pbi datei aus Excel.exe generieren. folgende änderungen sind dann noch durchzuführen:

- im interface Worksheets (nicht zu verwechseln mit _Worksheet, IWorksheet, IWorksheets) die methode get_Item(Index.p-variant) auf get_Item(Index.p-variant, RHS.l) ändern.
- den interfaces IFont, IToolbar, IPicture, Points, Point und IDummy im namen den prefix xsl_ voranstellen, weil es diese interfaces standardmäßig in pb schon gibt.

download ExcelTestEB.pbi für excel v10

zum testen die beiden pb-dateien im gleichen verzeichnis mit unicodeunterstützung abspeichern. wenn jemand erfolgreich eine pbi datei für eine andere excel version generiert hat, dann bitte hochladen und link bekanntgeben. wenn mein link auch für andere excelversionen funktionert, dann bitte auch kurz posten.

ExcelTestEB.pb

Code:

  EnableExplicit

  IncludeFile "ExcelTestEB.pbi"

  Define ClsId.IID
  Define *oExcelApp   ._Application
  Define *oExcelSheets.IWorksheets
  Define *oExcelSheet ._WorkSheet
  Define Item.VARIANT
  Define *BStr
  Define time.l
  Define cnt.l
  Define hr.l

  CoInitialize_ (0)

 ;Klassenid für Excel suchen und Objektverweis auf Application erstellen
  hr = CLSIDFromProgID_(@"EXCEL.APPLICATION", @ClsId)
  If hr : MessageRequester(Str(hr), "KlassenId konnte nicht ermittelt werden") : End : EndIf
  hr = GetActiveObject_(@ClsId, 0, @*oExcelApp)
  If hr : MessageRequester (Str(hr), "Excel muss geöffnet sein") : End : EndIf

 ;CoKlasse. Standardinterface auslesen
  *oExcelApp\QueryInterface (?IID__Application, @*oExcelApp)
  *oExcelApp\Release()

  Debug "------------------------------------------------------------"

 ;Den Titel von Excel anzeigen
  *oExcelApp\get_Caption (@*BStr)
  Debug "Alter Exceltitel: " + PeekS (*BStr)
  SysFreeString_ (*BStr)

 ;Den Titel von Excel ändern
  *oExcelApp\put_Caption ("*** Titel mit früher Bindung erstellt ***")
  Debug "Neuer Exceltitel wurde erstellt"

  Debug "------------------------------------------------------------"

 ;Zeiger auf die Tabellenblätter holen
  *oExcelApp\get_WorkSheets (@*oExcelSheets)

 ;Anzahl der Tabellenblätter anzeigen
  *oExcelSheets\get_Count (@cnt)
  Debug "Anzahl der Tabellenblätter: " + Str(cnt)

  Debug "------------------------------------------------------------"

 ;Zeiger auf das 2. Tabellenblatt holen
  Item\vt = #VT_I4 : Item\lVal = 2
  *oExcelSheets\get_Item (Item, @*oExcelSheet)

 ;CoKlasse. Standardinterface auslesen
  *oExcelSheet\QueryInterface (?IID__Worksheet, @*oExcelSheet)
  *oExcelSheet\Release()

 ;Den Namen des Tabellenblattes anzeigen
  *oExcelSheet\get_Name (@*Bstr)
  Debug "Alter Tabellenblattname: " + PeekS (*BStr)
  SysFreeString_ (*BStr)

 ;Den Namen des Tabellenblattes ändern
  *oExcelSheet\put_Name ("Name frühe Bindung")
  Debug "Neuer Tabellenblattname wurde erstellt"

 ;Das zweite Tabellenblatt aktivieren
  *oExcelSheet\Activate()
  Debug "Zweites Tabellenblatt aktiviert"

  Debug "------------------------------------------------------------"

 ;Wert aus Zelle lesen und schreiben entfällt, Excel V10 ist nicht fähig dazu.
 ;Spätere Versionen nicht getestet.
  Debug "Zelle lesen/schreiben für frühe Bindung entfällt"

  Debug "------------------------------------------------------------"

 ;Tabellenblattname 10000x auslesen
  time = ElapsedMilliseconds()
  For cnt = 1 To 10000
    *oExcelSheet\get_Name (@*Bstr)
    SysFreeString_ (*BStr)
  Next
  MessageRequester ("Tabellenblattname 10.000x lesen", "Zeit EB: " + Str (ElapsedMilliseconds() - time ) + "ms")

  Debug "------------------------------------------------------------"

 ;Objektverweise freigeben
  *oExcelApp\Release()    : *oExcelApp    = 0
  *oExcelSheets\Release() : *oExcelSheets = 0
  *oExcelSheet\Release()  : *oExcelSheet  = 0

  CoUninitialize_()

Josh · **Registriert:** 04.08.2009 17:24

Beispiel 2) Zugriff auf eine Excelanwendung mit später Bindung

ExcelTestLB.pb

Code:

  EnableExplicit

  #DISPID_VALUE                  =  0
  #DISPID_UNKNOWN                = -1
  #DISPID_STARTENUM              = #DISPID_UNKNOWN
  #DISPID_PROPERTYPUT            = -3
  #DISPID_NEWENUM                = -4
  #DISPID_EVALUATE               = -5
  #DISPID_CONSTRUCTOR            = -6
  #DISPID_DESTRUCTOR             = -7
  #DISPID_COLLECT                = -8
  #DISPID_THIS                   = -613

  DataSection

    IID_NULL: ; {00000000-0000-0000-0000-000000000000}
    Data.l $00000000
    Data.w $0000,$0000
    Data.b $00,$00,$00,$00,$00,$00,$00,$00

    IID_IDispatch: ; {00020400-0000-0000-C000-000000000046}
    Data.l $00020400
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46

  EndDataSection

  Define ClsId.IID
  Define *oExcelApp   .IDispatch
  Define *oExcelSheets.IDispatch
  Define *oExcelSheet .IDispatch
  Define MethodName.String
  Define DispId.l
  Define DispIdNamed.l
  Define DispParPropGet.DISPPARAMS
  Define DispParPropPut.DISPPARAMS
  Define DispParMethods.DISPPARAMS
  Define vResult.VARIANT
  Dim    vArgs.VARIANT(20)
  Define *BStr
  Define time.l
  Define cnt.l
  Define hr.l

  CoInitialize_ (0)

 ;Standard DispParams für PropertyGet setzen
  DispParPropGet\cArgs  = 0
  DispParPropGet\rgvarg = 0
  DispParPropGet\cNamedArgs = 0
  DispParPropGet\rgdispidNamedArgs = 0

 ;Standard DispParams für PropertyPut setzen
  DispIdNamed = #DISPID_PROPERTYPUT
  DispParPropPut\cArgs  = 1
  DispParPropPut\rgvarg = @vArgs()
  DispParPropPut\cNamedArgs = 1
  DispParPropPut\rgdispidNamedArgs = @DispIdNamed

 ;Standard DispParams für Methoden setzen
  DispParMethods\rgvarg = @vArgs()
  DispParMethods\cNamedArgs = 0
  DispParMethods\rgdispidNamedArgs = 0

 ;Klassenid für Excel suchen und Objektverweis auf Application erstellen
  hr = CLSIDFromProgID_(@"EXCEL.APPLICATION", @ClsId)
  If hr : MessageRequester(Str(hr), "KlassenId konnte nicht ermittelt werden") : End : EndIf
  hr = GetActiveObject_(@ClsId, 0, @*oExcelApp)
  If hr : MessageRequester(Str(hr), "Excel muss geöffnet sein") : End : EndIf

  Debug "------------------------------------------------------------"

 ;Zeiger auf Application holen
  *oExcelApp\QueryInterface(?IID_IDispatch, @*oExcelApp)
  *oExcelApp\Release()

 ;Den Titel von Excel anzeigen
  MethodName\s = "Caption"
  *oExcelApp\GetIDsOfNames(?IID_NULL, @MethodName, 1, #LOCALE_USER_DEFAULT, @DispId)
  *oExcelApp\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYGET, @DispParPropGet, @vResult, 0, 0)
  Debug "Alter Exceltitel: " + PeekS (vResult\bstrVal)
  VariantClear_(@vResult)

 ;Den Titel von Excel ändern
  vArgs(0)\vt      = #VT_BSTR
  vArgs(0)\bstrVal = SysAllocString_ ("*** Titel mit später Bindung erstellt ***")
  *oExcelApp\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYPUT, @DispParPropPut, 0, 0, 0)
  Debug "Neuer Exceltitel wurde erstellt"
  VariantClear_(@vArgs(0))

  Debug "------------------------------------------------------------"

 ;Zeiger auf die Tabellenblätter holen
  MethodName\s = "WorkSheets"
  *oExcelApp\GetIDsOfNames(?IID_NULL, @MethodName, 1, #LOCALE_USER_DEFAULT, @DispId)
  *oExcelApp\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYGET, @DispParPropGet, @vResult, 0, 0)
  *oExcelSheets = vResult\pdispVal

 ;Anzahl der Tabellenblätter anzeigen
  MethodName\s = "Count"
  *oExcelSheets\GetIDsOfNames(?IID_NULL, @MethodName, 1, #LOCALE_USER_DEFAULT, @DispId)
  *oExcelSheets\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYGET, @DispParPropGet, @vResult, 0, 0)
  Debug "Anzahl der Tabellenblätter: " + Str (vResult\lVal)

  Debug "------------------------------------------------------------"

 ;Zeiger auf das 2. Tabellenblatt holen
  MethodName\s = "Item"
  vArgs(0)\vt   = #VT_I4
  vArgs(0)\lVal = 2
  DispParMethods\cArgs  = 1
  *oExcelSheets\GetIDsOfNames(?IID_NULL, @MethodName, 1, #LOCALE_USER_DEFAULT, @DispId)
  *oExcelSheets\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYGET | #DISPATCH_METHOD, @DispParMethods, @vResult, 0, 0)
  *oExcelSheet = vResult\pdispVal

 ;Den Namen des Tabellenblattes anzeigen
  MethodName\s = "Name"
  *oExcelSheet\GetIDsOfNames(?IID_NULL, @MethodName, 1, #LOCALE_USER_DEFAULT, @DispId)
  *oExcelSheet\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYGET, @DispParPropGet, @vResult, 0, 0)
  Debug "Alter Tabellenblattname: " + PeekS (vResult\bstrVal)
  VariantClear_(@vResult)

 ;Den Namen des Tabellenblattes ändern
  vArgs(0)\vt      = #VT_BSTR
  vArgs(0)\bstrVal = SysAllocString_ ("Name späte Bindung")
  DispParMethods\cArgs  = 1
  DispParMethods\rgvarg = @vArgs()
  *oExcelSheet\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYPUT, @DispParPropPut, @vResult, 0, 0)
  Debug "Neuer Tabellenblattname wurde erstellt"
  VariantClear_(@vResult)

 ;Das zweite Tabellenblatt aktivieren
  MethodName\s = "Activate"
  DispParMethods\cArgs  = 0
  *oExcelSheet\GetIDsOfNames(?IID_NULL, @MethodName, 1, #LOCALE_USER_DEFAULT, @DispId)
  *oExcelSheet\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_METHOD, @DispParMethods, @vResult, 0, 0)
  Debug "Zweites Tabellenblatt aktiviert"

  Debug "------------------------------------------------------------"

 ;DispId auslesen
  MethodName\s = "Cells"
  *oExcelSheet\GetIDsOfNames(?IID_NULL, @MethodName, 1, #LOCALE_USER_DEFAULT, @DispId)

 ;Den Wert aus Zelle A1 auslesen (muss in diesem Fall nummerisch sein)
  DispParMethods\cArgs  = 2
  vArgs(0)\vt = #VT_I4 : vArgs(0)\lVal = 1 ;Spalte
  vArgs(1)\vt = #VT_I4 : vArgs(1)\lVal = 1 ;Zeile
  *oExcelSheet\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYGET | #DISPATCH_METHOD, @DispParMethods, @vResult, 0, 0)
  VariantChangeType_ (vResult, vResult, 0, #VT_I8)
  Debug "Alter Wert aus Zelle A1: " + Str(vResult\llVal)

 ;Neuen Wert in Zelle C4 setzen
  DispParPropPut\cArgs  = 3
  vArgs(0)\vt = #VT_I4 : vArgs(0)\lVal = 123 ;neuer Wert
  vArgs(1)\vt = #VT_I1 : vArgs(1)\lVal = 3   ;Spalte
  vArgs(2)\vt = #VT_I1 : vArgs(2)\lVal = 4   ;Zeile
  *oExcelSheet\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYPUT | #DISPATCH_METHOD, @DispParPropPut, @vResult, 0, 0)
  Debug "Neuer Wert in Zelle C4 gesetzt"

  Debug "------------------------------------------------------------"

 ;Tabellenblattname 10000x auslesen
  time = ElapsedMilliseconds()
  MethodName\s = "Name"
  *oExcelSheet\GetIDsOfNames(?IID_NULL, @MethodName, 1, #LOCALE_USER_DEFAULT, @DispId)
  For cnt = 1 To 10000
    *oExcelSheet\Invoke(DispId, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_PROPERTYGET, @DispParPropGet, @vResult, 0, 0)
    VariantClear_(@vResult)
  Next
  MessageRequester ("Tabellenblattname 10.000x lesen", "Zeit LB: " + Str (ElapsedMilliseconds() - time ) + "ms")

  Debug "------------------------------------------------------------"

 ;Objektverweise freigeben
  *oExcelApp\Release() : *oExcelApp = 0

  CoUninitialize_()

Josh · **Registriert:** 04.08.2009 17:24

Beispiel 3) Zugriff auf eine Excelanwendung mit COMate

ExcelTestLB.pb

Code:

  EnableExplicit

  XIncludeFile "COMatePLUS.pbi"

  Define oExcelApp   .COMateObject
  Define oExcelSheets.COMateObject
  Define oExcelSheet .COMateObject
  Define *ComateStatement
  Define time.l
  Define cnt.l

 ;Objektverweis auf Excel erstellen
  oExcelApp = COMate_GetObject ("", "Excel.Application")
  If oExcelApp = 0 : MessageRequester ("", "Excel muss geöffnet sein") : End : EndIf

  Debug "------------------------------------------------------------"

 ;Den Titel von Excel anzeigen
  Debug "Alter Exceltitel: " + oExcelApp\GetStringProperty ("Caption")

 ;Den Titel von Excel ändern
  oExcelApp\SetProperty ("Caption = '*** Titel mit COMate erstellt ***'")
  Debug "Neuer Exceltitel wurde erstellt"

  Debug "------------------------------------------------------------"

 ;Zeiger auf die Tabellenblätter holen
  oExcelSheets = oExcelApp\GetObjectProperty ("Worksheets")

 ;Anzahl der Tabellenblätter anzeigen
  Debug "Anzahl der Tabellenblätter: " + Str (oExcelSheets\GetIntegerProperty ("Count"))

  Debug "------------------------------------------------------------"

 ;Zeiger auf das 2. Tabellenblatt holen
  oExcelSheet = oExcelSheets\GetObjectProperty ("Item = 2")

 ;Den Namen des Tabellenblattes anzeigen
  Debug "Alter Tabellenblattname: " + oExcelSheet\GetStringProperty ("Name")

 ;Den Namen des Tabellenblattes ändern
  oExcelSheet\SetProperty ("Name = 'Name COMate'")
  Debug "Neuer Tabellenblattname wurde erstellt"

 ;Das zweite Tabellenblatt aktivieren
  oExcelSheet\Invoke ("Activate")
  Debug "Zweites Tabellenblatt aktiviert"

  Debug "------------------------------------------------------------"

 ;Den Wert aus Zelle A1 auslesen (muss in diesem Fall nummerisch sein)
  Debug "Alter Wert aus Zelle A1: " + Str(oExcelSheet\GetIntegerProperty ("Cells(1,1)"))

 ;Neuen Wert in Zelle C4 setzen
  oExcelSheet\SetProperty ("Cells(4,3) = 55")
  Debug "Neuer Wert in Zelle C4 gesetzt"

  Debug "------------------------------------------------------------"

 ;Tabellenblattname 10000x auslesen
  *ComateStatement = COMate_PrepareStatement("Name")
  time = ElapsedMilliseconds()
  For cnt = 1 To 10000
    oExcelSheet\GetStringProperty ("Name", *ComateStatement)
  Next
  MessageRequester ("Tabellenblattname 10.000x lesen", "Zeit COMate: " + Str (ElapsedMilliseconds() - time ) + "ms")

  Debug "------------------------------------------------------------"

 ;Objektverweise freigeben
  oExcelApp\Release() : oExcelApp = 0

Josh · **Registriert:** 04.08.2009 17:24

Beispiel 4) Erstellen einer selbstregistrierenden Com-Dll mit Dualinterface

mit dem code eine dll erstellen (unicode nicht vergessen) und dann die dll mit regsvr32 registrieren

Rechnen.pb

Code:

  EnableExplicit

;------ Konstanten -----

  #RechnenPlus  = 101
  #RechnenMinus = 102

;;=
;------ Strukturen -----

  Structure udtClassFactory
    *VTable
    cntRef.l
    cntLock.l
    *oOwn.IUnknown
  EndStructure

  Structure udtApplication
    *VTable
    cntRef.l
    *oOwn.IUnknown
    *oPar.IUnknown
    *oApp.IUnknown
  EndStructure

  Structure EXCEPINFO
    wCode.w
    wReserved.w
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 : padding1.b[4] : CompilerEndIf
    bstrSource.s
    bstrDescription.s
    bstrHelpFile.s
    dwHelpContext.l
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 : padding2.b[4] : CompilerEndIf
    *pvReserved
    *pfnDeferredFillIn
    sCode.l
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 : padding3.b[4] : CompilerEndIf
  EndStructure

;;=
;------ Deklarationen -----

  Declare.d AP_RechnenPlus  (*This, a.d, b.d, *res=0)
  Declare.d AP_RechnenMinus (*This, a.d, b.d, *res=0)

;;=

;-===== ENTWICKLUNGS PROZEDUREN ===================================================================

 ;Was hier steht, kann vor dem kompilieren der endgültigen DLL gelöscht werden

  Procedure ShowGuidString(*Guid.GUID)
    Define msg.s

    msg + RSet (Hex(*Guid\Data1   , #PB_Long), 8, "0") + "-"
    msg + RSet (Hex(*Guid\Data2   , #PB_Word), 4, "0") + "-"
    msg + RSet (Hex(*Guid\Data3   , #PB_Word), 4, "0") + "-"
    msg + RSet (Hex(*Guid\Data4[0], #PB_Byte), 2, "0")
    msg + RSet (Hex(*Guid\Data4[1], #PB_Byte), 2, "0") + "-"
    msg + RSet (Hex(*Guid\Data4[2], #PB_Byte), 2, "0")
    msg + RSet (Hex(*Guid\Data4[3], #PB_Byte), 2, "0")
    msg + RSet (Hex(*Guid\Data4[4], #PB_Byte), 2, "0")
    msg + RSet (Hex(*Guid\Data4[5], #PB_Byte), 2, "0")
    msg + RSet (Hex(*Guid\Data4[6], #PB_Byte), 2, "0")
    msg + RSet (Hex(*Guid\Data4[7], #PB_Byte), 2, "0")

    SetClipboardText (msg)

    MessageRequester ("IID-String", msg + #CRLF$ + #CRLF$ + "Der IID-String wurde in die Zwischenablage kopiert")

  EndProcedure

;;=================================================================================================

;-===== DLL PROZEDUREN ============================================================================

  ProcedureDLL AttachProcess(Instanz)
  EndProcedure
  ProcedureDLL DetachProcess(Instanz)
  EndProcedure
  ProcedureDLL AttachThread (Instanz)
  EndProcedure
  ProcedureDLL DetachThread (Instanz)
  EndProcedure

;;=================================================================================================

;-===== COM PROZEDUREN ============================================================================

  ProcedureDLL.l DllRegisterServer  ()
    Define ProgrammId.s
    Define KlassenId.s
    Define Beschreibung.s
    Define DllName.s
    Define hKey.l
    Define ret.l

    ProgrammId   = "Rechnen.Application"
    KlassenId    = "{BC2F3427-426C-4B9F-A695-761A58D79A33}"
    Beschreibung = "Pb - Rechnen mit COM-DLL"
    DllName      = ProgramFilename()

    ret + RegCreateKeyEx_(#HKEY_CLASSES_ROOT, ProgrammId, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @hKey, 0)
    ret + RegSetValueEx_ (hKey, "", 0, #REG_SZ, Beschreibung, StringByteLength(Beschreibung) + 2)
    ret + RegCloseKey_   (hKey)

    ret + RegCreateKeyEx_(#HKEY_CLASSES_ROOT, ProgrammId + "\CLSID", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @hKey, 0)
    ret + RegSetValueEx_ (hKey, "", 0, #REG_SZ, KlassenId, StringByteLength(KlassenId) + 2)
    ret + RegCloseKey_   (hKey)

    ret + RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\" + KlassenId, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @hKey, 0)
    ret + RegSetValueEx_ (hKey, "", 0, #REG_SZ, Beschreibung, StringByteLength(Beschreibung) + 2)
    ret + RegCloseKey_   (hKey)

    ret + RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\" + KlassenId + "\InprocServer32", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @hKey, 0)
    ret + RegSetValueEx_ (hKey, "", 0, #REG_SZ, DllName, StringByteLength(DllName) + 2)
    ret + RegCloseKey_   (hKey)

    ret + RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\" + KlassenId + "\ProgId", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @hKey, 0)
    ret + RegSetValueEx_ (hKey, "", 0, #REG_SZ, Beschreibung, StringByteLength(Beschreibung) + 2)
    ret + RegCloseKey_   (hKey)

    If ret
      ProcedureReturn #SELFREG_E_CLASS
    EndIf

  EndProcedure
  ProcedureDLL.l DllUnregisterServer()
    Define ProgrammId.s
    Define KlassenId.s
    Define ret.l

    ProgrammId   = "Rechnen.Application"
    KlassenId    = "{BC2F3427-426C-4B9F-A695-761A58D79A33}"

    ret + RegDeleteKey_(#HKEY_CLASSES_ROOT, "CLSID\" + KlassenId + "\ProgId")
    ret + RegDeleteKey_(#HKEY_CLASSES_ROOT, "CLSID\" + KlassenId + "\InprocServer32")
    ret + RegDeleteKey_(#HKEY_CLASSES_ROOT, "CLSID\" + KlassenId)

    ret + RegDeleteKey_(#HKEY_CLASSES_ROOT, ProgrammId + "\CLSID")
    ret + RegDeleteKey_(#HKEY_CLASSES_ROOT, ProgrammId)

    If ret
      ProcedureReturn #SELFREG_E_CLASS
    EndIf

  EndProcedure
  ProcedureDLL.l DllGetClassObject  (*rclsid.IID, *riid.iid, *ppvObject.Integer)
    Define *oNew.udtClassFactory

    If CompareMemory(*rclsid, ?CLSID_Rechnen, 16)
      If CompareMemory(*riid, ?IID_IClassFactory, 16)

       ;Klassenobjekt erstellen
        *oNew        = AllocateMemory (SizeOf(udtClassFactory))
        *oNew\VTABLE = ?VT_ClassFactory
        *oNew\oOwn   = *oNew
        *ppvObject\i = *oNew : *oNew\oOwn\AddRef()
        ProcedureReturn #S_OK

      EndIf
    EndIf

   ;Unbekannte Klasse
    MessageRequester ("DLL", "DllGetClassObject hat nach einer unbekannten Klasse angefragt")
    *ppvObject\i = 0
    ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE

  EndProcedure
  ProcedureDLL.l DllCanUnloadNow    ()
  EndProcedure

;;=================================================================================================

;-===== CLASS FACTORY =============================================================================

  Procedure.l CF_QueryInterface (*This.udtClassFactory, *iid.IID, *Object.Integer)

   ;Standardzuweisungen auf eigenes Objekt
    If CompareMemory(*iid, ?IID_IUnknown, 16) Or CompareMemory(*iid, ?IID_IDispatch, 16) Or CompareMemory(*iid, ?IID_IClassFactory, 16)
      *Object\i = *This : *This\oOwn\AddRef()
      ProcedureReturn #S_OK
    EndIf

   ;IClassFactoryEx ist momentan nicht implementiert
    If CompareMemory(*iid, ?IID_IClassFactoryEx, 16)
      *Object\i = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf

   ;Unbekanntes Interface
    MessageRequester("CF" , "QueryInterface hat nach einem nicht impletierten Interface angefragt")
    *Object\i = 0
    ProcedureReturn #E_NOINTERFACE

  EndProcedure
  Procedure.l CF_AddRef         (*This.udtClassFactory)

    *This\cntRef + 1
    ProcedureReturn *This\cntRef

  EndProcedure
  Procedure.l CF_Release        (*This.udtClassFactory)

   ;Wenn Referenzzähler nicht auf 0 kommt
    If *This\cntRef > 1
      *This\cntRef - 1
      ProcedureReturn *This\cntRef
    EndIf

   ;Eigenes Objekt auflösen
    FreeMemory(*This)
MessageRequester ("CF", "AUFGELÖST")
    ProcedureReturn 0

  EndProcedure
  Procedure.l CF_CreateInstance (*This.udtClassFactory, *pUnkOuter, *riid.IID, *ppvObject.Integer)
    Define *oNew.udtApplication

   ;Aggregation wird momentan nicht unterstützt
    If *pUnkOuter
      MessageRequester ("CF", "Aggregation wird nicht unterstützt")
      *ppvObject\i = 0
      ProcedureReturn #CLASS_E_NOAGGREGATION
    EndIf

   ;Eine neues Applikationsobjekt erstellen
    If CompareMemory(*riid, ?IID_IUnknown, 16) Or CompareMemory(*riid, ?IID_IDispatch, 16)
      *oNew         = AllocateMemory (SizeOf(udtApplication))
      *oNew\VTable  = ?VT_Application
      *oNew\oOwn    = *oNew
      *oNew\oPar    = *oNew
      *oNew\oApp    = *oNew
      *ppvObject\i  = *oNew : *oNew\oOwn\AddRef()
      ProcedureReturn #S_OK
    EndIf

   ;Nicht implementierte Klasse wurde angefragt
    MessageRequester ("CF", "Unbekannte Klasse wurde angefragt")
    *ppvObject\i = 0
    ProcedureReturn #E_NOINTERFACE

  EndProcedure
  Procedure.l CF_LockServer     (*This.udtClassFactory, fLock.b)

    If fLock = #False
      *This\cntLock - 1
    Else
      *This\cntLock + 1
    EndIf

    ProcedureReturn #S_OK

  EndProcedure

;;=================================================================================================

;-===== CLASS APPLICATION =========================================================================

  Procedure.l AP_QueryInterface   (*This.udtApplication, *iid.IID, *Object.Integer)

   ;Standardzuweisungen auf eigenes Objekt
    If CompareMemory(*iid, ?IID_IUnknown, 16) Or CompareMemory(*iid, ?IID_IDispatch, 16)
      *Object\i = *This : *This\oOwn\AddRef()
      ProcedureReturn #S_OK
    EndIf

   ;IDispatchEx ist momentan nicht implementiert
    If CompareMemory(*iid, ?IID_IDispatchEx, 16)
      *Object\i = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf

   ;IObjectWithSite ist momentan nicht implementiert
    If CompareMemory(*iid, ?IID_IObjectWithSite, 16)
      *Object\i = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf

   ;IPersistStreamInit ist momentan nicht implementiert
    If CompareMemory(*iid, ?IID_IPersistStreamInit, 16)
      *Object\i = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf

   ;IPersistPropertyBag ist momentan nicht implementiert
    If CompareMemory(*iid, ?IID_IPersistPropertyBag, 16)
      *Object\i = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf

   ;Unbekanntes Interface
    MessageRequester("App" , "QueryInterface hat nach einem nicht implementierten Interface angefragt")
    *Object\i = 0
    ProcedureReturn #E_NOINTERFACE

  EndProcedure
  Procedure.l AP_AddRef           (*This.udtApplication)

    *This\cntRef + 1
    ProcedureReturn *This\cntRef

  EndProcedure
  Procedure.l AP_Release          (*This.udtApplication)

   ;Wenn Referenzzähler nicht auf 0 kommt
    If *This\cntRef > 1
      *This\cntRef - 1
      ProcedureReturn *This\cntRef
    EndIf

   ;Eigenes Objekt auflösen
    FreeMemory(*This)
MessageRequester ("AP", "AUFGELÖST")
    ProcedureReturn 0

  EndProcedure
  Procedure.l AP_GetTypeInfoCount (*This.udtApplication, *CntTypeInfo.Long)

    *CntTypeInfo\l = 0
    ProcedureReturn #S_OK

  EndProcedure
  Procedure.l AP_GetTypeInfo      (*This.udtApplication, TypeInfo.l, LocalId.l, *ppTypeInfo.Integer)

    ProcedureReturn #S_OK

  EndProcedure
  Procedure.l AP_GetIDsOfNames    (*This.udtApplication, *iid.IID, *Name.String, cntNames.l, lcid.l, *DispId.Long)

    If *Name\s = "RechnenPlus"  : *DispId\l = #RechnenPlus  : EndIf
    If *Name\s = "RechnenMinus" : *DispId\l = #RechnenMinus : EndIf

  EndProcedure
  Procedure.l AP_Invoke           (*This.udtApplication, DispId.l, *iid.IID, lcid.l, Flags.w, *DispParams.DISPPARAMS, *vResult.VARIANT, *ExcepInfo.EXCEPINFO, *ArgErr.Integer)
    Dim vArg.VARIANT(20)

    CopyMemory (*DispParams\rgvarg, @vArg(), 20 * SizeOf(VARIANT))
    VariantChangeType_(vArg(0), vArg(0), 0, #VT_R8)
    VariantChangeType_(vArg(1), vArg(1), 0, #VT_R8)

    Select DispId
      Case #RechnenPlus  : *vResult\vt = #VT_R8 : *vResult\dblVal = AP_RechnenPlus  (*This, vArg(1)\dblVal, vArg(0)\dblVal)
      Case #RechnenMinus : *vResult\vt = #VT_R8 : *vResult\dblVal = AP_RechnenMinus (*This, vArg(1)\dblVal, vArg(0)\dblVal)
    EndSelect

  EndProcedure
  Procedure.d AP_RechnenPlus      (*This.udtApplication, a.d, b.d, *res.Double=0)
    Define result.d

    result = a + b

    If *res : *res\d = result : EndIf
    ProcedureReturn result

  EndProcedure
  Procedure.d AP_RechnenMinus     (*This.udtApplication, a.d, b.d, *res.Double=0)
    Define result.d

    result = a - b

    If *res : *res\d = result : EndIf
    ProcedureReturn result

  EndProcedure

;;=================================================================================================

;-===== DATA SECTION ==============================================================================

  DataSection

    VT_ClassFactory:
    Data.i @CF_QueryInterface()
    Data.i @CF_AddRef()
    Data.i @CF_Release()
    Data.i @CF_CreateInstance()
    Data.i @CF_LockServer()

    VT_Application:
    Data.i @AP_QueryInterface()
    Data.i @AP_AddRef()
    Data.i @AP_Release()
    Data.i @AP_GetTypeInfoCount()
    Data.i @AP_GetTypeInfo()
    Data.i @AP_GetIDsOfNames()
    Data.i @AP_Invoke()
    Data.i @AP_RechnenPlus()
    Data.i @AP_RechnenMinus()

    CLSID_Rechnen: ; {BC2F3427-426C-4B9F-A695-761A58D79A33}
    Data.l $BC2F3427
    Data.w $426C,$4B9F
    Data.b $A6,$95,$76,$1A,$58,$D7,$9A,$33

    IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
    Data.l $00000000
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46

    IID_IDispatch: ; {00020400-0000-0000-C000-000000000046}
    Data.l $00020400
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46

    IID_IDispatchEx: ; {A6EF9860-C720-11D0-9337-00A0C90DCAA9}
    Data.l $A6EF9860
    Data.w $C720,$11D0
    Data.b $93,$37,$00,$A0,$C9,$0D,$CA,$A9

    IID_IClassFactory: ; {00000001-0000-0000-C000-000000000046}
    Data.l $00000001
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46

    IID_IClassFactoryEx: ; {342D1EA0-AE25-11D1-89C5-006008C3FBFC}
    Data.l $342D1EA0
    Data.w $AE25,$11D1
    Data.b $89,$C5,$00,$60,$08,$C3,$FB,$FC

    IID_IObjectWithSite: ; {FC4801A3-2BA9-11CF-A229-00AA003D7352}
    Data.l $FC4801A3
    Data.w $2BA9,$11CF
    Data.b $A2,$29,$00,$AA,$00,$3D,$73,$52

    IID_IPersistStreamInit: ; {7FD52380-4E07-101B-AE2D-08002B2EC713}
    Data.l $7FD52380
    Data.w $4E07,$101B
    Data.b $AE,$2D,$08,$00,$2B,$2E,$C7,$13

    IID_IPersistPropertyBag: ; {37D84F60-42CB-11CE-8135-00AA004BB851}
    Data.l $37D84F60
    Data.w $42CB,$11CE
    Data.b $81,$35,$00,$AA,$00,$4B,$B8,$51

  EndDataSection

  ;;=================================================================================================

Josh · **Registriert:** 04.08.2009 17:24

Beispiel 5) Verschiedene Tests der DLL aus Beispiel 4

RechnenTestEB.pb

Code:

  EnableExplicit

  DataSection
    IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
    Data.l $00000000
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  EndDataSection

  Interface IRechnen Extends IDispatch
    RechnenPlus.d  (a.d, b.d, *Result=0)
    RechnenMinus.d (a.d, b.d, *Result=0)
  EndInterface

  Define ClsId.IID
  Define *oRechnen.IRechnen
  Define time.l
  Define cnt.l
  Define hr.l

  CoInitialize_ (0)

 ;Klassenid für Excel suchen und Objektverweis auf Application erstellen
  hr = CLSIDFromProgID_(@"Rechnen.APPLICATION", @ClsId)
  If hr : MessageRequester(Str(hr), "KlassenId konnte nicht ermittelt werden") : End : EndIf
  hr = CoCreateInstance_(@CLSID, 0, 1, ?IID_IUnknown,  @*oRechnen)
  If hr : MessageRequester (Str(hr), "Fehler beim erstellen des Klassenobjektes") : End : EndIf

 ;Testberechnungen durchführen
  Debug *oRechnen\RechnenPlus  (5, 4)
  Debug *oRechnen\RechnenMinus (5, 4)

 ;Zeittest
  time = ElapsedMilliseconds()
  For cnt = 1 To 1000000
    *oRechnen\RechnenPlus (cnt , 4)
  Next
  MessageRequester ("Zeit EB", Str(ElapsedMilliseconds()-time))

 ;Objektverweise freigeben
  *oRechnen\Release() : *oRechnen = 0

  CoUninitialize_()

RechnenTestComate.pb

Code:

  EnableExplicit

  XIncludeFile "COMatePLUS.pbi"

  Define oRechnen.COMateObject
  Define *ComateStatement
  Define time.l
  Define cnt.l

 ;Objektverweis auf Rechnen erstellen
  oRechnen = COMate_CreateObject ("Rechnen.Application")
  If oRechnen = 0 : MessageRequester ("", "Fehler bei Objekterstellung") : End : EndIf

 ;Testberechnungen durchführen
  Debug oRechnen\GetRealProperty ("RechnenPlus (5, 4)")
  Debug oRechnen\GetRealProperty ("RechnenMinus(5, 4)")

 ;Zeittest
  *ComateStatement = COMate_PrepareStatement("RechnenPlus (" + Str(@cnt) + " As long BYREF, 4)")
  time = ElapsedMilliseconds()
  For cnt = 1 To 1000000
    oRechnen\GetRealProperty ("", *ComateStatement)
  Next
  MessageRequester ("Zeit EB", Str(ElapsedMilliseconds()-time))

 ;Objektverweise freigeben
  oRechnen\Release() : oRechnen = 0

Rechnen mit Vba

Code:

Dim oRechnen As Object
Set oRechnen = CreateObject ("Rechnen.Application")
MsgBox oRechnen.RechnenPlus (5, 4) & vbCrLf & oRechnen.RechnenMinus (5, 4)

Dim StartTime, EndTime
StartTime = Timer
For cnt = 1 To 1000000
  res = oRechnen.RechnenPlus(cnt, 4)
Next
EndTime = Timer
MsgBox EndTime - StartTime
  
 Set oRechnen = Nothing

Rechnen mit Vbs

Code:

Dim oRechnen
Set oRechnen = CreateObject ("Rechnen.Application")
MsgBox oRechnen.RechnenPlus (5,4) & vbCrLf & oRechnen.RechnenMinus (5,4)

Dim StartTime, EndTime
StartTime = Timer
For cnt = 1 To 1000000
  res = oRechnen.RechnenPlus (cnt, 4)
Next
EndTime = Timer
MsgBox EndTime - StartTime

Set oRechnen = Nothing

Josh · **Registriert:** 04.08.2009 17:24

halte ich mal frei. vieleicht hab ich noch mal bock das bespiel 4 um eine tlb zu erweitern

Kukulkan · **Verfasst:** 19.05.2010 14:33

Wow, super Sache das :allright:

Danke!

ts-soft · **Registriert:** 08.09.2004 00:57 **Wohnort:** Berlin

Danke, endlich mal nützliche Hinweise zur Com-Programmierung in deutsch!

Kiffi · **Registriert:** 08.09.2004 08:21 **Wohnort:** Amphibios 9

@Josh: vielen Dank für Dein Tutorial! :allright:

Zum Thema COMate muss ich allerdings noch eines bemerken:

In der Tat ist COMate nicht die performanteste Art und Weise auf COM-Objekte
zuzugreifen. Das liegt u.a. auch daran, dass der zu übergebende Commandstring
geparst werden muss. Das wirkt sich natürlich grade in Schleifen ungünstig auf
die Ausführungszeiten aus.

Aus diesem Grund hat Stephen schon seit längerem COMate_PrepareStatement()
zur Verfügung gestellt. Hiermit besteht die Möglichkeit, einen Commandstring im
Vorfeld zu parsen und im weiteren Verlauf mit dem daraus resultierenden Handle
weiterzuarbeiten. I.d.R. wird dadurch die Codeausführung (teilweise extrem) beschleunigt.

Mit den nachfolgenden Codeschnippseln habe ich im Beispiel 3 eine Verbesserung von
knapp 2 Sekunden (ohne PrepareStatement) auf knapp 1.5 Sekunden
(mit PrepareStatement) erreichen können.

Im RechnenTestComate konnte ich den Code von knapp 44 Sekunden (ohne
PrepareStatement) auf unter 2 Sekunden (mit PrepareStatement) beschleunigen.

Beispiel 3

Code:

;Tabellenblattname 10000x auslesen (COMate_PrepareStatement()-Variante)

Define *hStatement

time = ElapsedMilliseconds()
*hStatement = COMate_PrepareStatement("Name")
If *hStatement
  For cnt = 1 To 10000
    oExcelSheet\GetStringProperty ("", *hStatement)
  Next
  COMate_FreeStatementHandle(*hStatement)
  MessageRequester ("Tabellenblattname 10.000x lesen (COMate_PrepareStatement())", "Zeit COMate: " + Str (ElapsedMilliseconds() - time ) + "ms")
EndIf

RechnenTestComate

Code:

;Zeittest (COMate_PrepareStatement()-Variante)

Define *hStatement

time = ElapsedMilliseconds()
*hStatement = COMate_PrepareStatement("RechnenPlus (5, 4)")
If *hStatement
  For cnt = 1 To 1000000
    oRechnen\GetRealProperty ("", *hStatement)
  Next
  COMate_FreeStatementHandle(*hStatement)
  MessageRequester ("Zeit EB (COMate_PrepareStatement()-Variante)", Str(ElapsedMilliseconds()-time))
EndIf

Grüße ... Kiffi

PureBoard

COM Objekte

Wer ist online?