@Kiffi
das hat mit dem Unicode-Zeugs zu tun.
Ich habe die Compileroption Unicode-exe wieder abgeschaltet.
Das war mir zu diffus. Kann´s nicht wirklich nachvollziehen
wann ein String ein Unicode und wann ein ANSI ist. Und wenn
ich´s nicht schnalle lasse ich das erst mal.
schaut dann mit mk-soft´s ReleaseObject (Dank für die Hilfe) so aus:
Code: Alles auswählen
;- Constants
#CLSCTX_INPROC_SERVER = $1
#CLSCTX_INPROC_HANDLER = $2
#CLSCTX_LOCAL_SERVER = $4
#CLSCTX_REMOTE_SERVER = $10
#CLSCTX_ALL = (#CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER)
#DISPID_PROPERTYPUT = -3
#DISPATCH_METHOD = 1
#DISPATCH_PROPERTYGET = 2
#DISPATCH_PROPERTYPUT = 4
#DISPATCH_PROPERTYPUTREF = 8
;}
Structure EXCEPINFO
wCode.w;
wReserved.w;
bstrSource.s;
bstrDescription.s;
bstrHelpFile.s;
dwHelpContext.l;
pvReserved.l ;
pfnDeferredFillIn.l
scode.l ;
EndStructure
Structure SAFEARRAYBOUND
cElements.l ;ULONG
lLbound.l ;LONG
EndStructure
Structure ObjType
lpObj.l
strObjNam.s
EndStructure
;- Globals
;Global pApp.IDispatch
Global pvResult.Variant
Global IID_NULL.GUID
Global LastError.l
Global LastMessage.s
;}
;- Arrays Linked Lists
Global Dim varArr.Variant(0)
Global NewList ObjectList.ObjType()
;}
Procedure.l Ansi2Uni(ansistr.s) ; Converts normal (Ansi) string to Unicode
lenA.l = Len(ansistr)
lenW = MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, 0, 0)
If (lenW > 0) ; Check whether conversion was successful
unicodestr = SysAllocStringLen_(0, lenW)
MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, unicodestr, lenW)
result = unicodestr
ProcedureReturn result
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.s Uni2Ansi(unicodestr.l) ; Converts Unicode to normal (Ansi) string
lenA = WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, 0, 0, 0, 0);
ansistr.s = Space(lenA)
If (lenA > 0)
WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, @ansistr, lenA, 0, 0);
EndIf
ProcedureReturn ansistr
EndProcedure
Procedure.l AutoWrap(autoTyp.l, *pDisp.IDispatch, name.s, nArgs.l)
dispID.l
exception.EXCEPINFO
dp.DISPPARAMS
dispidNamed = #DISPID_PROPERTYPUT
;Convert to Uni
ptUniName = Ansi2Uni(name)
Debug "getting IDs of " + name
;Get DISPID for name passed...
hr = *pDisp\GetIDsOfNames(IID_NULL, @ptUniName, 1, #LOCALE_USER_DEFAULT, @dispID)
Debug "hr GetIDsOfNames: " + Str(hr)
Debug "dispID from " + name + " = " + Str(dispID)
;Build DISPPARAMS
dp\cArgs = nArgs
dp\rgvarg = @varArr(0) ;ArgsArr;pArgs;*var;
;Handle special-case for property-puts!
If autoTyp & #DISPATCH_PROPERTYPUT
dp\cNamedArgs = 1
dp\rgdispidNamedArgs = @dispidNamed
EndIf
;Make the call!
hr = *pDisp\Invoke(dispID, IID_NULL, #LOCALE_SYSTEM_DEFAULT, autoTyp, @dp, @pvResult, @exception, #Null)
Debug "hr Invoke: " + Str(hr)
Debug "##########"
Select hr
Case #DISP_E_EXCEPTION
Debug "exception\scode: " + Str(exception\scode) + " -> " + exception\bstrDescription
EndSelect
; Invoke return values:
; #S_OK = 0 ; Success.
; #DISP_E_BADPARAMCOUNT = -21473525 62 ; The number of elements provided to DISPPARAMS is different from the number of arguments accepted by the method or property.
; #DISP_E_BADVARTYPE = -21473525 68 ; One of the arguments in rgvarg is not a valid variant type.
; #DISP_E_EXCEPTION = -21473525 67 ; The application needs to raise an exception. In this case, the structure passed in pExcepInfo should be filled in.
; #DISP_E_MEMBERNOTFOUND = -21473525 73 ; The requested member does not exist, or the call to Invoke tried to set the value of a read-only property.
; #DISP_E_NONAMEDARGS = -21473525 69 ; This implementation of IDispatch does not support named arguments.
; #DISP_E_OVERFLOW = -21473525 66 ; One of the arguments in rgvarg could not be coerced to the specified type.
; #DISP_E_PARAMNOTFOUND = -21473525 72 ; One of the parameter DISPIDs does not correspond to a parameter on the method. In this case, puArgErr should be set to the first argument that contains the error.
; #DISP_E_TYPEMISMATCH = -21473525 71 ; One or more of the arguments could not be coerced. The index within rgvarg of the first parameter with the incorrect type is returned in the puArgErr parameter.
; #DISP_E_UNKNOWNINTERFACE = -21473525 75 ; The interface identifier passed in riid is not IID_NULL.
; #DISP_E_UNKNOWNLCID = -21473525 64 ; The member being invoked interprets string arguments according to the LCID, and the LCID is not recognized. If the LCID is not needed to interpret arguments, this error should not be returned.
; #DISP_E_PARAMNOTOPTIONAL = -21473525 61 ; A required parameter was omitted.
; -2147024809 ; The parameter is incorrect (80070057)
FreeMemory(ArgsArr)
ProcedureReturn hr
EndProcedure
Procedure.l CreateObject(app.s)
LastError = 0
LastMessage = ""
hr = CoInitialize_(0)
If hr <> #S_OK And hr <> #S_FALSE
LastError = hr
LastMessage = "Error CoInitialize: ErrorCode " + Hex(hr)
End
EndIf
CLSID.GUID
hr = CLSIDFromProgID_(Ansi2Uni(app), @CLSID)
If hr <> #S_OK
LastError = hr
LastMessage = "Error CLSIDFromProgID: ErrorCode " + Hex(hr)
ProcedureReturn 0
EndIf
pCf.IClassFactory
IID_IClassFactory.GUID
IID_IClassFactory\data1 = $1
IID_IClassFactory\data4[0] = $C0
IID_IClassFactory\data4[7] = $46
hr = CoGetClassObject_(@CLSID, #CLSCTX_LOCAL_SERVER | #CLSCTX_INPROC_SERVER, #Null, @IID_IClassFactory, @pCf)
If hr <> #S_OK
LastError = hr
LastMessage = "Error CoGetClassObject: ErrorCode " + Hex(hr)
; REGDB_E_KEYMISSING 0x80040152 Could not find the key in the registry
; REGDB_E_INVALIDVALUE 0x80040153 Invalid value For registry
; REGDB_E_CLASSNOTREG 0x80040154 Class not registered
; REGDB_E_IIDNOTREG 0x80040155 Interface not registered
; REGDB_E_BADTHREADINGMODEL 0x80040156 Threading model Entry is not valid
; CO_E_NOTINITIALIZED 0x800401F0
ProcedureReturn 0
EndIf
riid.GUID
riid\data1 = $20400
riid\data4[0] = $C0
riid\data4[7] = $46
hr = pCf\CreateInstance(#Null, @riid, @*pApp.IDispatch)
pCf\Release()
If hr <> #S_OK
LastError = hr
LastMessage = "Error CreateInstance: ErrorCode " + Hex(hr)
; S_OK 00000000 0
; S_FALSE 00000001 1
; E_PENDING 8000000A 2147483658
; E_NOTIMPL 80004001 2147500033
; E_NOINTERFACE 80004002 2147500034 The object that ppvObject points to does not support the interface identified by riid.
; E_POINTER 80004003 2147500035
; E_ABORT 80004004 2147500036
; E_FAIL 80004005 2147500037
; E_UNEXPECTED 8000FFFF 2147549183
; CLASS_E_NOAGGREGATION 80040110 2147746064 The pUnkOuter parameter was non-NULL and the object does not support aggregation
; CLASS_E_CLASSNOTAVAILABLE 80040111 2147746065
; CLASS_E_NOTLICENSED 80040112 2147746066
; E_ACCESSDENIED 80070005 2147942405
; E_HANDLE 80070006 2147942406
; E_OUTOFMEMORY 8007000E 2147942414
; E_INVALIDARG 80070057 2147942487
ProcedureReturn 0
Else
AddElement(ObjectList())
ObjectList()\lpObj = *pApp
ObjectList()\strObjNam = app
ProcedureReturn *pApp
EndIf
EndProcedure
Procedure ReleaseObject(*Object.IDispatch)
If *Object
*Object\Release()
EndIf
EndProcedure
; VBS: Set myXML = CreateObject("Microsoft.XMLDOM")
; PB:
myXML.IDispatch = CreateObject("Microsoft.XMLDOM")
; VBS: strXML="<hallo>123</hallo>"
;PB:
Dim varArr.Variant(1)
varArr(0)\vt = #VT_BSTR
varArr(0)\bstrVal = Ansi2Uni("<hallo>123</hallo>")
; VBS: myXML.LoadXml strXML
; PB
AutoWrap(#DISPATCH_METHOD, myXML, "LoadXml", 1)
; VBS: pvResult = myXML.XML
; PB:
VariantInit_(pvResult)
AutoWrap(#DISPATCH_PROPERTYGET, myXML, "XML", 0)
; ...
Debug pvResult\vt
Debug "XML = " + uni2ansi(pvResult\bstrVal)
ReleaseObject(myXML)
Mit den CLSCTX-Dingens funktioniert
#CLSCTX_LOCAL_SERVER | #CLSCTX_INPROC_SERVER bei allen Objekten die ich bisher
getestet habe. Andere Kombinationen dagegen nicht immer.
Bei mir liefert das:
getting IDs of LoadXml
hr GetIDsOfNames: 0
dispID from LoadXml = 63
hr Invoke: 0
##########
getting IDs of XML
hr GetIDsOfNames: 0
dispID from XML = 27
hr Invoke: 0
##########
8
XML = <hallo>123</hallo>
Gruß schic
