You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2572 lines
106 KiB
2572 lines
106 KiB
6 years ago
|
CompilerIf Defined(INCLUDE_COMATE, #PB_Constant)=0
|
||
|
|
#INCLUDE_COMATE=1
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;***COMate*** COM automation through iDispatch.
|
||
|
|
;*===========
|
||
|
|
;*
|
||
|
|
;*COMatePLUS. Version 1.2 released 09th July 2010.
|
||
|
|
;*
|
||
|
|
;*©nxSoftWare (www.nxSoftware.com) 2009.
|
||
|
|
;*======================================
|
||
|
|
;* With thanks to ts-soft, kiffi, mk-soft.
|
||
|
|
;* The EventSink code is based on that produced by Freak : http://www.purebasic.fr/english/viewtopic.php?t=26744&postdays=0&postorder=asc&start=75
|
||
|
|
;* Created with Purebasic 4.3 for Windows.
|
||
|
|
;*
|
||
|
|
;* Platforms: Windows.
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;*NOTES.
|
||
|
|
; i) This code has arisen from my study of COM automation; the mechanism through which applications can
|
||
|
|
; connect to COM servers through what is termed 'late binding'.
|
||
|
|
;
|
||
|
|
; ii) At present this can only be used for servers on the local machine.
|
||
|
|
|
||
|
|
; iii) This code is based upon the DispHelper sourcecode : http://disphelper.sourceforge.net/.
|
||
|
|
;
|
||
|
|
; iv) Define the constant #COMATE_NOINCLUDEATL = 1 before including this source to remove all ActiveX code from this library.
|
||
|
|
; Useful for NT in which the ATL library may not be present.
|
||
|
|
;
|
||
|
|
; v) Define the constant #COMATE_NOERRORREPORTING = 1 before including this source to remove all error reporting. Might be useful if
|
||
|
|
; looking to squeeze a little more speed out of your code!
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
XIncludeFile "COMatePLUS_Residents.pbi"
|
||
|
|
|
||
|
|
;-IMPORTS.
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
Import "atl.lib"
|
||
|
|
AtlAxCreateControl(lpszName,hWnd.i,*pStream.IStream,*ppUnkContainer.IUnknown)
|
||
|
|
AtlAxGetControl(hWnd.i,*pp.IUnknown)
|
||
|
|
AtlAxGetHost(hWnd, *pp.IUnknown)
|
||
|
|
AtlAxWinInit()
|
||
|
|
EndImport
|
||
|
|
CompilerEndIf
|
||
|
|
|
||
|
|
;-PROTOTYPES.
|
||
|
|
;The following prototype caters for Ansi / Unicode when creating BSTR's.
|
||
|
|
Prototype.i COMate_ProtoMakeBSTR(value.p-unicode)
|
||
|
|
;The following is for any automation servers opting to defer filling in EXCEPINFO2 structures in the case of a dispinterface
|
||
|
|
;function yielding an error etc. In these cases a callback is provided by the server which we call manually.
|
||
|
|
Prototype.i COMate_ProtoDeferredFillIn(*EXCEPINFO2)
|
||
|
|
;The following prototypes allow for various return types from event handlers.
|
||
|
|
Prototype COMate_EventCallback_NORETURN(COMateObject.COMateObject, EventName$, ParameterCount)
|
||
|
|
Prototype.q COMate_EventCallback_INTEGERRETURN(COMateObject.COMateObject, EventName$, ParameterCount)
|
||
|
|
Prototype.d COMate_EventCallback_REALRETURN(COMateObject.COMateObject, EventName$, ParameterCount)
|
||
|
|
Prototype.s COMate_EventCallback_STRINGRETURN(COMateObject.COMateObject, EventName$, ParameterCount)
|
||
|
|
Prototype COMate_EventCallback_UNKNOWNRETURN(COMateObject.COMateObject, EventName$, ParameterCount, *returnValue.VARIANT)
|
||
|
|
|
||
|
|
;-CONSTANTS (private)
|
||
|
|
#COMate_MAXNUMSUBOBJECTS = 20 ;Used for nested object calls; e.g. "Cells(1, 2)\Value = 'COMate'"
|
||
|
|
#COMate_MAXNUMSYMBOLSINALINE = 200
|
||
|
|
#COMate_MAXNUMVARIANTARGS = 20 ;The max number of arguments which can be passed to a single COM method.
|
||
|
|
Enumeration
|
||
|
|
#CLSCTX_INPROC_SERVER = 1
|
||
|
|
#CLSCTX_INPROC_HANDLER = 2
|
||
|
|
#CLSCTX_LOCAL_SERVER = 4
|
||
|
|
#CLSCTX_REMOTE_SERVER = 16
|
||
|
|
#CLSCTX_FROM_DEFAULT_CONTEXT = $20000
|
||
|
|
#CLSCTX_SERVER = (#CLSCTX_INPROC_SERVER | #CLSCTX_LOCAL_SERVER | #CLSCTX_REMOTE_SERVER)
|
||
|
|
EndEnumeration
|
||
|
|
|
||
|
|
Enumeration ;Used when parsing command strings and setting up the variant array.
|
||
|
|
#COMate_Operator
|
||
|
|
#COMate_Operand
|
||
|
|
#COMate_OpenParanthesis
|
||
|
|
#COMate_CloseParanthesis
|
||
|
|
#COMate_Method
|
||
|
|
EndEnumeration
|
||
|
|
|
||
|
|
#DISPID_PROPERTYPUT = -3 ;The iDisp value for property put calls to iDispatch\Invoke() which require a single named parameter.
|
||
|
|
#DISPID_NEWENUM = -4 ;The iDisp value for propertyget calls in which a new enumeration is being requested.
|
||
|
|
|
||
|
|
#CONNECT_E_ADVISELIMIT = -2147220991
|
||
|
|
|
||
|
|
;-STRUCTURES.
|
||
|
|
|
||
|
|
;The following structure contains the class template and private properties for the main COMateObject.
|
||
|
|
Structure _membersCOMateClass
|
||
|
|
*vTable
|
||
|
|
iDisp.iDispatch
|
||
|
|
containerID.i
|
||
|
|
hWnd.i
|
||
|
|
*eventSink._COMateEventSink
|
||
|
|
EndStructure
|
||
|
|
|
||
|
|
;The following structure contains the class template and private properties for the COMateEnumObject.
|
||
|
|
Structure _membersCOMateEnumClass
|
||
|
|
*vTable
|
||
|
|
*parent._membersCOMateClass ;Points to the COMate Object which is hosting this enumeration. Used for error reporting.
|
||
|
|
iEV.IEnumVARIANT
|
||
|
|
EndStructure
|
||
|
|
|
||
|
|
;The following structure is used in thread local storage to store info on the latest error recorded by an object within the current thread.
|
||
|
|
Structure _COMateThreadErrors
|
||
|
|
lastErrorCode.i
|
||
|
|
lastError$
|
||
|
|
EndStructure
|
||
|
|
|
||
|
|
;The following structure holds a COMatePLUS 'statement' object representing a compiled command string.
|
||
|
|
;A statement handle is simply a pointer to one of these structures.
|
||
|
|
Structure _COMatePLUSStatement
|
||
|
|
numSubObjects.i
|
||
|
|
methodName.i[#COMate_MAXNUMSUBOBJECTS+1] ;1-based indexing. BSTRs.
|
||
|
|
numArgs.i[#COMate_MAXNUMSUBOBJECTS+1] ;1-based indexing.
|
||
|
|
ptrVarArgs.i[#COMate_MAXNUMSUBOBJECTS+1] ;1-based indexing.
|
||
|
|
EndStructure
|
||
|
|
|
||
|
|
;The following structure is used in an array when parsing method parameters etc.
|
||
|
|
Structure _COMateParse
|
||
|
|
numberOfTokens.i
|
||
|
|
numOpenBrackets.i
|
||
|
|
numCloseBrackets.i
|
||
|
|
tokens$[#COMate_MAXNUMSYMBOLSINALINE]
|
||
|
|
EndStructure
|
||
|
|
|
||
|
|
;The following structure is used in the iDispatch\Invoke() method call to receive detailed errors.
|
||
|
|
CompilerIf Defined(EXCEPINFO2, #PB_Structure) = 0
|
||
|
|
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
|
||
|
|
Structure EXCEPINFO2
|
||
|
|
wCode.w
|
||
|
|
wReserved.w
|
||
|
|
pad.b[4] ; Only on x64
|
||
|
|
bstrSource.i ;BSTR
|
||
|
|
bstrDescription.i
|
||
|
|
bstrHelpFile.i
|
||
|
|
dwHelpContext.l
|
||
|
|
pvReserved.i
|
||
|
|
pfnDeferredFillIn.COMate_ProtoDeferredFillIn
|
||
|
|
scode.l
|
||
|
|
pad2.b[4] ; Only on x64
|
||
|
|
EndStructure
|
||
|
|
CompilerElse
|
||
|
|
Structure EXCEPINFO2
|
||
|
|
wCode.w
|
||
|
|
wReserved.w
|
||
|
|
bstrSource.i ;BSTR
|
||
|
|
bstrDescription.i
|
||
|
|
bstrHelpFile.i
|
||
|
|
dwHelpContext.l
|
||
|
|
pvReserved.i
|
||
|
|
pfnDeferredFillIn.COMate_ProtoDeferredFillIn
|
||
|
|
scode.l
|
||
|
|
EndStructure
|
||
|
|
CompilerEndIf
|
||
|
|
CompilerEndIf
|
||
|
|
|
||
|
|
;The following structure is used when connecting an outgoing interface (sink) to a COM object's connection point.
|
||
|
|
Structure _COMateEventSink
|
||
|
|
*Vtbl
|
||
|
|
refCount.i
|
||
|
|
cookie.i
|
||
|
|
connIID.IID
|
||
|
|
typeInfo.ITypeInfo
|
||
|
|
Callback.COMate_EventCallback_NORETURN
|
||
|
|
returnType.i
|
||
|
|
*dispParams.DISPPARAMS
|
||
|
|
*parent._membersCOMateClass ;A pointer back to the parent COMate object so that we can pass this to the event procedure.
|
||
|
|
EndStructure
|
||
|
|
|
||
|
|
|
||
|
|
;-MACROS
|
||
|
|
|
||
|
|
;The following two macros are used to test for success or failure when calling com methods.
|
||
|
|
;They are pretty superfluous really but do aid readability.
|
||
|
|
Macro SUCCEEDED(HRESULT)
|
||
|
|
HRESULT & $80000000 = 0
|
||
|
|
EndMacro
|
||
|
|
Macro FAILED(HRESULT)
|
||
|
|
HRESULT & $80000000
|
||
|
|
EndMacro
|
||
|
|
|
||
|
|
|
||
|
|
;-DECLARES.
|
||
|
|
Declare.i COMate_INTERNAL_CheckNumeric(arg$, *var.VARIANT)
|
||
|
|
Declare COMate_INTERNAL_EscapeString(ptrText)
|
||
|
|
Declare.i COMateClass_INTERNAL_InvokePlus(*this._membersCOMateClass, invokeType, returnType, *ret.VARIANT, command$, *hStatement._COMatePLUSStatement)
|
||
|
|
Declare COMate_INTERNAL_FreeStatementHandle(*hStatement._COMatePLUSStatement)
|
||
|
|
Declare.i COMate_INTERNAL_PrepareStatement(command$, *ptrStatement.INTEGER)
|
||
|
|
Declare.i COMatePLUS_TokeniseCommand(command$, separator$, Array parse._COMateParse(1))
|
||
|
|
Declare.i COMatePLUS_CompileSubobjectInvokation(*hStatement._COMatePLUSStatement, subObjectIndex, Array parse._COMateParse(1))
|
||
|
|
|
||
|
|
Declare COMateClass_INTERNAL_SetError(*this._membersCOMateClass, result, blnAllowDispError = 0, dispError$="")
|
||
|
|
Declare.i COMateClass_UTILITY_MakeBSTR(value)
|
||
|
|
|
||
|
|
Declare.i COMateClass_GetObjectProperty(*this._membersCOMateClass, command$, *hStatement=0, objectType = #VT_DISPATCH)
|
||
|
|
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
Declare.i COMate_DelSinkPropsCallback(hWnd, lpszString, hData,dwData)
|
||
|
|
CompilerEndIf
|
||
|
|
|
||
|
|
;-GLOBALS.
|
||
|
|
Global COMate_MakeBSTR.COMate_ProtoMakeBSTR = @COMateClass_UTILITY_MakeBSTR() ;Prototype.
|
||
|
|
Global COMate_gErrorTLS.i ;A TLS index used to store per-thread error info.
|
||
|
|
Global COMate_gNumObjects.i ;Used to manage the error-TLS index.
|
||
|
|
Global COMate_gPtrThreadArray.i ;A pointer to an array of pointers to _COMateThreadErrors structures.
|
||
|
|
Global COMate_gNumThreadElements.i
|
||
|
|
Global COMate_gAtlAXIsInit.i
|
||
|
|
|
||
|
|
;-=======================
|
||
|
|
;-COMate OBJECT CODE.
|
||
|
|
;-=======================
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function creates a new instance of a COMate object which itself contains a COM object (iDispatch).
|
||
|
|
;Change the optional parameter blnInitCOM to #False if COM has already been initialised.
|
||
|
|
;Returns the new COMate object or zero if an error.
|
||
|
|
Procedure.i COMate_CreateObject(progID$, hWnd = 0, blnInitCOM = #True)
|
||
|
|
Protected *this._membersCOMateClass, clsid.CLSID, hResult, cf.IClassFactory, progID, container.iUnknown, iDisp
|
||
|
|
If blnInitCOM
|
||
|
|
CoInitialize_(0)
|
||
|
|
EndIf
|
||
|
|
If progID$
|
||
|
|
progID = COMate_MakeBSTR(progID$)
|
||
|
|
If progID
|
||
|
|
*this = AllocateMemory(SizeOf(_membersCOMateClass))
|
||
|
|
If *this
|
||
|
|
*this\vTable = ?VTable_COMateClass
|
||
|
|
If hWnd = 0 ;No ActiveX control to house.
|
||
|
|
;Get classID from the registry.
|
||
|
|
If Left(progID$, 1) = "{"
|
||
|
|
hResult = CLSIDFromString_(progID, @clsid)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = ProgIDFromCLSID_(clsid, @iDisp)
|
||
|
|
If SUCCEEDED(hResult) And iDIsp
|
||
|
|
SysFreeString_(iDisp)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
hResult = CLSIDFromProgID_(progID, @clsid);
|
||
|
|
EndIf
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = CoGetClassObject_(clsid, #CLSCTX_LOCAL_SERVER|#CLSCTX_INPROC_SERVER, 0, ?IID_IClassFactory, @cf)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = cf\CreateInstance(0, ?IID_IDispatch, @*this\iDisp)
|
||
|
|
If FAILED(hResult)
|
||
|
|
hResult = cf\CreateInstance(0, ?IID_IUnknown, @container)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = container\QueryInterface(?IID_IDispatch, @*this\iDisp)
|
||
|
|
container\Release()
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If FAILED(hResult)
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
Else; Success.
|
||
|
|
COMate_gNumObjects+1
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
EndIf
|
||
|
|
If cf
|
||
|
|
cf\Release()
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
Else ;An ActiveX control requires housing.
|
||
|
|
;Get classID from the registry. This is a simple check to ensure the control is registered. Otherwise ATL will embed a browser in our container.
|
||
|
|
If Left(progID$, 1) = "{"
|
||
|
|
hResult = CLSIDFromString_(progID, @clsid)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = ProgIDFromCLSID_(clsid, @iDisp)
|
||
|
|
If SUCCEEDED(hResult) And iDIsp
|
||
|
|
SysFreeString_(iDisp)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
hResult = CLSIDFromProgID_(progID, @clsid);
|
||
|
|
EndIf
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
If COMate_gAtlAXIsInit = #False
|
||
|
|
If AtlAxWinInit()
|
||
|
|
COMate_gAtlAXIsInit = #True
|
||
|
|
Else
|
||
|
|
hresult = #E_FAIL
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If COMate_gAtlAXIsInit
|
||
|
|
hResult = AtlAxCreateControl(ProgId, hWnd, 0, 0)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = AtlAxGetControl(hWnd, @*this\iDisp)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hresult = *this\iDisp\QueryInterface(?IID_IDispatch, @iDisp)
|
||
|
|
*this\iDisp\Release()
|
||
|
|
If SUCCEEDED(hresult)
|
||
|
|
*this\hWnd = hWnd
|
||
|
|
*this\iDisp = iDisp
|
||
|
|
COMate_gNumObjects+1
|
||
|
|
Else
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
EndIf
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
hresult = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
SysFreeString_(progID)
|
||
|
|
Else
|
||
|
|
hresult = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
hresult = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, hResult)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *this
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function is used either to load an instance of a com object from a file (or based upon the filename given), or to
|
||
|
|
;create a new instance of a currently active object.
|
||
|
|
;If file$ is empty, the function attempts to create a new COMate object containing a new instance of a currently active object
|
||
|
|
;(the existing COM object's reference count is increased).
|
||
|
|
;If file$ is not empty, progID$ is used to specify the class of the object in cases where the file contains multiple objects.
|
||
|
|
;(This mimicks VB's GetObject() function.)
|
||
|
|
;Returns the new COMate object or zero if an error.
|
||
|
|
Procedure.i COMate_GetObject(file$, progID$="", blnInitCOM = #True)
|
||
|
|
Protected *this._membersCOMateClass, hResult = #E_OUTOFMEMORY, iPersist.IPERSISTFILE, clsid.CLSID, cf.IClassFactory, iUnknown.IUNKNOWN
|
||
|
|
Protected bstr1, t1
|
||
|
|
If blnInitCOM
|
||
|
|
CoInitialize_(0)
|
||
|
|
EndIf
|
||
|
|
If file$ Or progID$
|
||
|
|
*this = AllocateMemory(SizeOf(_membersCOMateClass))
|
||
|
|
If *this
|
||
|
|
*this\vTable = ?VTable_COMateClass
|
||
|
|
If file$
|
||
|
|
If progID$ = ""
|
||
|
|
;Here we attempt to create an object based upon the filename only.
|
||
|
|
bstr1 = COMate_MakeBSTR(file$)
|
||
|
|
If bstr1 ;If an error then hResult already equals #E_OUTOFMEMORY!
|
||
|
|
hResult = CoGetObject_(bstr1, 0, ?IID_IDispatch, @*this\iDisp)
|
||
|
|
SysFreeString_(bstr1)
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
;Here we attempt to create an object based upon the filename and the progID.
|
||
|
|
bstr1 = COMate_MakeBSTR(progID$)
|
||
|
|
If bstr1
|
||
|
|
hResult = CLSIDFromProgID_(bstr1, @clsid)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = CoGetClassObject_(clsid, #CLSCTX_LOCAL_SERVER|#CLSCTX_INPROC_SERVER, 0, ?IID_IClassFactory, @cf)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = cf\CreateInstance(0, ?IID_IPersistFile, @iPersist)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = iPersist\Load(file$, 0)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = iPersist\QueryInterface(?IID_IDispatch, @*this\iDisp)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If iPersist
|
||
|
|
iPersist\Release()
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If cf
|
||
|
|
cf\Release()
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If bstr1
|
||
|
|
SysFreeString_(bstr1)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
;Here we attempt to create a new COMate object containing a new instance of a currently active object.
|
||
|
|
bstr1 = COMate_MakeBSTR(progID$)
|
||
|
|
If bstr1
|
||
|
|
If Left(progID$, 1) = "{"
|
||
|
|
hResult = CLSIDFromString_(bstr1, @clsid)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = ProgIDFromCLSID_(clsid, @t1)
|
||
|
|
If SUCCEEDED(hResult) And t1
|
||
|
|
SysFreeString_(t1)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
hResult = CLSIDFromProgID_(bstr1, @clsid);
|
||
|
|
EndIf
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = GetActiveObject_(clsid, 0, @iUnknown)
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
hResult = iUnknown\QueryInterface(?IID_IDispatch, @*this\iDisp)
|
||
|
|
EndIf
|
||
|
|
If iUnknown
|
||
|
|
iUnknown\Release()
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
SysFreeString_(bstr1)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
hResult = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
If SUCCEEDED(hResult)
|
||
|
|
COMate_gNumObjects+1
|
||
|
|
ElseIf *this
|
||
|
|
FreeMemory(*this)
|
||
|
|
*this = 0
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, hResult)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *this
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function creates a new instance of a COMate object from an object supplied directly from the user.
|
||
|
|
;This object is in the form of a iUnknown pointer to which we use QueryInterface() in an attempt to locate an iDispatch pointer.
|
||
|
|
;Useful for event procedures attached to ActiveX controls in which some parameters may be a 'raw' COM object. This function can be used to package that
|
||
|
|
;object up into the form of a COMate object.
|
||
|
|
;Returns the new COMate object or zero if an error.
|
||
|
|
Procedure.i COMate_WrapCOMObject(object.iUnknown)
|
||
|
|
Protected *this._membersCOMateClass, hResult, iDisp.iUnknown
|
||
|
|
If object
|
||
|
|
hresult = object\QueryInterface(?IID_IDispatch, @iDisp)
|
||
|
|
If SUCCEEDED(hresult)
|
||
|
|
*this = AllocateMemory(SizeOf(_membersCOMateClass))
|
||
|
|
If *this
|
||
|
|
*this\vTable = ?VTable_COMateClass
|
||
|
|
*this\iDisp = iDisp
|
||
|
|
COMate_gNumObjects+1
|
||
|
|
Else
|
||
|
|
hresult = #E_OUTOFMEMORY
|
||
|
|
iDisp\Release()
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
hresult = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, hResult)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *this
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function creates a new instance of a COMate object which itself contains a COM object (iDispatch) representing an
|
||
|
|
;ActiveX server. The underlying ActiveX control is placed within a container gadget.
|
||
|
|
;Change the optional parameter blnInitCOM to #False if COM has already been initialised.
|
||
|
|
;Returns the new COMate object or zero if an error.
|
||
|
|
Procedure.i COMate_CreateActiveXControl(x, y, width, height, progID$, blnInitCOM = #True)
|
||
|
|
Protected *this._membersCOMateClass, hResult, id, hWnd, iDisp
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
If progID$
|
||
|
|
id = ContainerGadget(#PB_Any, x, y, width, height)
|
||
|
|
CloseGadgetList()
|
||
|
|
If id
|
||
|
|
hWnd = GadgetID(id)
|
||
|
|
*this = COMate_CreateObject(progID$, hWnd, blnInitCOM) ;This procedure will set any HRESULT codes.
|
||
|
|
If *this
|
||
|
|
SetWindowLong_(hWnd, #GWL_STYLE, GetWindowLong_(hWnd, #GWL_STYLE)|#WS_CLIPCHILDREN)
|
||
|
|
*this\containerID = ID
|
||
|
|
*this\hWnd = hWnd
|
||
|
|
Else ;Cannot locate an iDispatch interface.
|
||
|
|
FreeGadget(id)
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn *this
|
||
|
|
Else
|
||
|
|
hResult = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
hresult = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, hResult)
|
||
|
|
CompilerEndIf
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn 0
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
;-COMate CLASS METHODS.
|
||
|
|
;----------------------------------------------
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method calls a dispinterface method where no return value is required.
|
||
|
|
;Returns a HRESULT value. #S_OK for no errors.
|
||
|
|
Procedure.i COMateClass_Invoke(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK
|
||
|
|
If command$ Or *hStatement
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_METHOD, #VT_EMPTY, 0, command$, *hStatement)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will already have been set.
|
||
|
|
If result = -1
|
||
|
|
result = #S_FALSE
|
||
|
|
Else
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method releases a com object created by any of the functions which return object pointers.
|
||
|
|
;Any sink interface connected to the underlying COM object will automatically be disconnected, resulting in the
|
||
|
|
;Release() method being called and able to tidy up.
|
||
|
|
Procedure COMateClass_Release(*this._membersCOMateClass)
|
||
|
|
Protected *error._COMateThreadErrors, i.i, sink.IDispatch
|
||
|
|
If *this\iDisp ;Just in case.
|
||
|
|
;Release underlying iDispatch object.
|
||
|
|
*this\iDisp\Release()
|
||
|
|
EndIf
|
||
|
|
If *this\containerID ;OCX controls.
|
||
|
|
FreeGadget(*this\containerID)
|
||
|
|
;We have to assume that the container will call the release() method on the connection point.
|
||
|
|
; ElseIf *this\eventSink
|
||
|
|
; sink = *this\eventSink
|
||
|
|
; sink\Release()
|
||
|
|
EndIf
|
||
|
|
COMate_gNumObjects-1
|
||
|
|
If COMate_gNumObjects = 0
|
||
|
|
;Here, in the anticipation that no more objects will be created, we release all memory associated with the TLS index.
|
||
|
|
;We recreate all this later on if required.
|
||
|
|
If COMate_gErrorTLS <> -1
|
||
|
|
For i = 0 To COMate_gNumThreadElements-1
|
||
|
|
*error = PeekI(COMate_gPtrThreadArray + i*SizeOf(i))
|
||
|
|
If *error ;Just in case!
|
||
|
|
ClearStructure(*error, _COMateThreadErrors)
|
||
|
|
FreeMemory(*error)
|
||
|
|
EndIf
|
||
|
|
Next
|
||
|
|
FreeMemory(COMate_gPtrThreadArray)
|
||
|
|
COMate_gPtrThreadArray = 0
|
||
|
|
COMate_gNumThreadElements = 0
|
||
|
|
TlsFree_(COMate_gErrorTLS)
|
||
|
|
COMate_gErrorTLS = -1
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
;Free object.
|
||
|
|
FreeMemory(*this)
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method creates a new instance of a COMateEnum object based upon an enumeration applied to the underlying COMate object.
|
||
|
|
;Returns the new COMateEnum object or zero if an error.
|
||
|
|
Procedure.i COMateClass_CreateEnumeration(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK, *object._membersCOMateEnumClass, *tempCOMateObject._membersCOMateClass, iDisp.IDISPATCH
|
||
|
|
Protected dp.DISPPARAMS, excep.EXCEPINFO2, var.VARIANT
|
||
|
|
*object = AllocateMemory(SizeOf(_membersCOMateEnumClass))
|
||
|
|
If *object
|
||
|
|
*object\vTable = ?VTable_COMateEnumClass
|
||
|
|
*object\parent = *this
|
||
|
|
If command$
|
||
|
|
*tempCOMateObject = COMateClass_GetObjectProperty(*this, command$, *hStatement, #VT_DISPATCH) ;This will set any error codes etc.
|
||
|
|
If *tempCOMateObject
|
||
|
|
iDisp = *tempCOMateObject\iDisp
|
||
|
|
Else
|
||
|
|
FreeMemory(*object)
|
||
|
|
ProcedureReturn 0 ;Error codes already set.
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
iDisp = *this\iDisp
|
||
|
|
EndIf
|
||
|
|
result = iDisp\Invoke(#DISPID_NEWENUM, ?IID_NULL, #LOCALE_USER_DEFAULT, #DISPATCH_METHOD | #DISPATCH_PROPERTYGET, dp, var, excep, 0)
|
||
|
|
If command$
|
||
|
|
COMateClass_Release(*tempCOMateObject)
|
||
|
|
EndIf
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
Select var\vt
|
||
|
|
Case #VT_DISPATCH
|
||
|
|
result = var\pdispVal\QueryInterface(?IID_IEnumVARIANT, @*object\iEV)
|
||
|
|
Case#VT_UNKNOWN
|
||
|
|
result = var\punkVal\QueryInterface(?IID_IEnumVARIANT, @*object\iEV)
|
||
|
|
Default
|
||
|
|
result = #E_NOINTERFACE;
|
||
|
|
EndSelect
|
||
|
|
If FAILED(result)
|
||
|
|
FreeMemory(*object)
|
||
|
|
*object = 0
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
If result = #DISP_E_EXCEPTION
|
||
|
|
;Has the automation server deferred from filling in the EXCEPINFO2 structure?
|
||
|
|
If excep\pfnDeferredFillIn
|
||
|
|
excep\pfnDeferredFillIn(excep)
|
||
|
|
EndIf
|
||
|
|
If excep\bstrSource
|
||
|
|
SysFreeString_(excep\bstrSource)
|
||
|
|
EndIf
|
||
|
|
If excep\bstrDescription
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result, #True, PeekS(excep\bstrDescription, -1, #PB_Unicode))
|
||
|
|
CompilerEndIf
|
||
|
|
SysFreeString_(excep\bstrDescription)
|
||
|
|
Else
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result, #True)
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
If excep\bstrHelpFile
|
||
|
|
SysFreeString_(excep\bstrHelpFile)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
FreeMemory(*object)
|
||
|
|
*object = 0
|
||
|
|
EndIf
|
||
|
|
VariantClear_(var)
|
||
|
|
Else
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
;Set any error code.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *object
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;Returns the COMate object's underlying iDispatch object pointer.
|
||
|
|
;AddRef() is called on this object and so the developer must call Release() at some point.
|
||
|
|
Procedure.i COMateClass_GetCOMObject(*this._membersCOMateClass)
|
||
|
|
Protected result.i = #S_OK, id.i
|
||
|
|
*this\iDisp\AddRef()
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, #S_OK)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *this\iDisp
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method returns, in the case of an ActiveX control, either the handle of the container used to house the control
|
||
|
|
;or the Purebasic gadget#. Returning the gadget# is only viable if using COMate as a source code include (or a Tailbitten library!)
|
||
|
|
Procedure.i COMateClass_GetContainerhWnd(*this._membersCOMateClass, returnCtrlID=0)
|
||
|
|
Protected result.i = #S_OK, id.i
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
If *this\hWnd
|
||
|
|
id = *this\containerID
|
||
|
|
If returnCtrlID = 0
|
||
|
|
id = *this\hWnd
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn id
|
||
|
|
CompilerEndIf
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method attempts to set (or clear) the design time mode of the container.
|
||
|
|
Procedure.i COMateClass_SetDesignTimeMode(*this._membersCOMateClass, state=#True)
|
||
|
|
Protected result.i = #S_OK, id, iUnk.IUnknown, iDisp.IDispatch, comate.COMateObject
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
If *this\containerID
|
||
|
|
id = *this\containerID
|
||
|
|
result = AtlAxGetHost(GadgetID(*this\containerID), @iUnk)
|
||
|
|
If iUnk
|
||
|
|
result = iUnk\QueryInterface(?IID_IAxWinAmbientDispatch, @iDisp)
|
||
|
|
If iDisp
|
||
|
|
comate = COMate_WrapCOMObject(iDisp)
|
||
|
|
If comate
|
||
|
|
If state
|
||
|
|
result = comate\SetProperty("UserMode = #False")
|
||
|
|
Else
|
||
|
|
result = comate\SetProperty("UserMode = #True")
|
||
|
|
EndIf
|
||
|
|
comate\Release()
|
||
|
|
Else
|
||
|
|
result = COMate_GetLastErrorCode()
|
||
|
|
EndIf
|
||
|
|
iDisp\Release()
|
||
|
|
iUnk\Release()
|
||
|
|
ProcedureReturn result
|
||
|
|
EndIf
|
||
|
|
iUnk\Release()
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method calls a dispinterface function and returns a PB (system) date value.
|
||
|
|
;Any HRESULT return value is accessible through the GetLastErrorCode() method.
|
||
|
|
Procedure.i COMateClass_GetDateProperty(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK, retVar.VARIANT, retValue
|
||
|
|
If command$ Or *hStatement
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYGET|#DISPATCH_METHOD, #VT_DATE, retVar, command$, *hStatement)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
retValue = (retVar\date - 25569) * 86400
|
||
|
|
EndIf
|
||
|
|
VariantClear_(retVar)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn retValue
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method calls a dispinterface function and returns an integer value.
|
||
|
|
;Any HRESULT return value is accessible through the GetLastErrorCode() method.
|
||
|
|
Procedure.q COMateClass_GetIntegerProperty(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK, retVar.VARIANT, retValue.q
|
||
|
|
If command$ Or *hStatement
|
||
|
|
If OSVersion() <= #PB_OS_Windows_2000
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYGET|#DISPATCH_METHOD, #VT_I4, retVar, command$, *hStatement)
|
||
|
|
Else
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYGET|#DISPATCH_METHOD, #VT_I8, retVar, command$, *hStatement)
|
||
|
|
EndIf
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
If OSVersion() <= #PB_OS_Windows_2000
|
||
|
|
retValue = retVar\lval
|
||
|
|
Else
|
||
|
|
retValue = retVar\llval
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
VariantClear_(retVar)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn retValue
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;Returns a COMate object or an iUnknown interface pointer depending on the value of the 'objectType' parameter.
|
||
|
|
;For 'regular' objects based upon iDispatch, leave the optional parameter 'objectType' as it is.
|
||
|
|
;Otherwise, for unknown object types set objectType to equal #COMate_UnknownObjectType. In these cases, this method will return the
|
||
|
|
;interface pointer directly (as opposed to a COMate object).
|
||
|
|
;In either case the object should be released as soon as it is no longer required.
|
||
|
|
;Any HRESULT return value is accessible through the GetLastErrorCode() method.
|
||
|
|
Procedure.i COMateClass_GetObjectProperty(*this._membersCOMateClass, command$, *hStatement=0, objectType = #VT_DISPATCH)
|
||
|
|
Protected result.i = #S_OK, retVar.VARIANT, *newObject._membersCOMateClass
|
||
|
|
If command$ Or *hStatement
|
||
|
|
If objectType <> #VT_DISPATCH
|
||
|
|
objectType = #VT_UNKNOWN
|
||
|
|
EndIf
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYGET|#DISPATCH_METHOD, objectType, retVar, command$, *hStatement)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
If objectType = #VT_DISPATCH
|
||
|
|
If retVar\pdispVal
|
||
|
|
;We now create a COMate object to house this instance variable.
|
||
|
|
*newObject = AllocateMemory(SizeOf(_membersCOMateClass))
|
||
|
|
If *newObject
|
||
|
|
*newObject\vTable = ?VTable_COMateClass
|
||
|
|
*newObject\iDisp = retVar\pdispVal
|
||
|
|
COMate_gNumObjects+1
|
||
|
|
Else
|
||
|
|
VariantClear_(retVar) ;This will call the Release() method of the COM object.
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
VariantClear_(retVar)
|
||
|
|
;In this case we set an error with extra info.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, #S_FALSE, 0, "The property returned a NULL object!")
|
||
|
|
CompilerEndIf
|
||
|
|
result = -1
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
*newObject = retVar\punkVal
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
VariantClear_(retVar)
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
If result <> -1
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn *newObject
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method calls a dispinterface function and returns a double value.
|
||
|
|
;Any HRESULT return value is accessible through the GetLastErrorCode() method.
|
||
|
|
Procedure.d COMateClass_GetRealProperty(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK, retVar.VARIANT, retValue.d
|
||
|
|
If command$ Or *hStatement
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYGET|#DISPATCH_METHOD, #VT_R8, retVar, command$, *hStatement)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
retValue = retVar\dblval
|
||
|
|
EndIf
|
||
|
|
VariantClear_(retVar)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn retValue
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method calls a dispinterface function and returns a string value.
|
||
|
|
;Any HRESULT return value is accessible through the GetLastErrorCode() method.
|
||
|
|
Procedure.s COMateClass_GetStringProperty(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK, retVar.VARIANT, result$
|
||
|
|
If command$ Or *hStatement
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYGET|#DISPATCH_METHOD, #VT_BSTR, retVar, command$, *hStatement)
|
||
|
|
If SUCCEEDED(result) And retVar\bstrVal
|
||
|
|
result$ = PeekS(retVar\bstrVal, -1, #PB_Unicode)
|
||
|
|
EndIf
|
||
|
|
VariantClear_(retVar)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result$
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method calls a dispinterface function and, if there are no errors, returns a pointer to a new variant which must be
|
||
|
|
;'freed' by the user with VariantClear_() etc.
|
||
|
|
;Any HRESULT return value is accessible through the GetLastErrorCode() method.
|
||
|
|
Procedure.i COMateClass_GetVariantProperty(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK, *retVar.VARIANT
|
||
|
|
If command$ Or *hStatement
|
||
|
|
;Allocate memory for a new variant.
|
||
|
|
*retVar = AllocateMemory(SizeOf(VARIANT))
|
||
|
|
If *retVar
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYGET|#DISPATCH_METHOD, #VT_EMPTY, *retVar, command$, *hStatement)
|
||
|
|
If FAILED(result)
|
||
|
|
FreeMemory(*retVar)
|
||
|
|
*retVar = 0
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *retVar
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method calls a dispinterface method where no return value is required.
|
||
|
|
;Returns a HRESULT value. #S_OK for no errors.
|
||
|
|
;Errors reported by the methods called by the user will be reported elsewhere (eventually!)
|
||
|
|
Procedure.i COMateClass_SetProperty(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK
|
||
|
|
If command$ Or *hStatement
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYPUT, #VT_EMPTY, 0, command$, *hStatement)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
If result = -1
|
||
|
|
result = #S_FALSE
|
||
|
|
Else
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function calls a dispinterface method where no return value is required.
|
||
|
|
;Returns a HRESULT value. #S_OK for no errors.
|
||
|
|
;Errors reported by the methods called by the user will be reported elsewhere (eventually!)
|
||
|
|
Procedure.i COMateClass_SetPropertyRef(*this._membersCOMateClass, command$, *hStatement=0)
|
||
|
|
Protected result.i = #S_OK
|
||
|
|
If command$ Or *hStatement
|
||
|
|
result = COMateClass_INTERNAL_InvokePlus(*this, #DISPATCH_PROPERTYPUTREF, #VT_EMPTY, 0, command$, *hStatement)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
If result = -1
|
||
|
|
result = #S_FALSE
|
||
|
|
Else
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
|
||
|
|
;-COMate CLASS - EVENT RELATED METHODS.
|
||
|
|
;---------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method attaches an event handler from the user's program to the underlying COM object. (Code based on that written by Freak.)
|
||
|
|
;Set callback to zero to remove any existing callback.
|
||
|
|
;Returns a HRESULT value. #S_OK for no errors.
|
||
|
|
Procedure.i COMateClass_SetEventHandler(*this._membersCOMateClass, eventName$, callback, returnType = #COMate_NORETURN, *riid.IID=0)
|
||
|
|
Protected result.i = #S_OK
|
||
|
|
Protected container.IConnectionPointContainer, enum.IEnumConnectionPoints, connection.IConnectionPoint, connIID.IID
|
||
|
|
Protected dispTypeInfo.ITypeInfo, typeLib.ITypeLib, typeInfo.ITypeInfo
|
||
|
|
Protected infoCount, index
|
||
|
|
Protected *sink._COMateEventSink, newSink.IDispatch
|
||
|
|
If eventName$ = #COMate_CatchAllEvents Or *this\hWnd
|
||
|
|
If returnType < #COMate_NoReturn Or returnType > #COMate_OtherReturn
|
||
|
|
returnType = #COMate_NoReturn
|
||
|
|
EndIf
|
||
|
|
If eventName$ = #COMate_CatchAllEvents
|
||
|
|
If returnType <> #COMate_NORETURN
|
||
|
|
returnType = #COMate_OtherReturn ;No sense in an explicit return value when dealing with any event!
|
||
|
|
EndIf
|
||
|
|
;If their already exists a sink for this object then we just switch the main callback.
|
||
|
|
If *this\eventSink And callback
|
||
|
|
*this\eventSink\callback = callback
|
||
|
|
*this\eventSink\returnType = returnType
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result ;No error.
|
||
|
|
ElseIf *this\eventSink = 0 And callback = 0 ;No point proceeding with this.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result ;No error reported.
|
||
|
|
EndIf
|
||
|
|
ElseIf *this\eventSink
|
||
|
|
If callback And *this\hWnd
|
||
|
|
SetProp_(*this\hWnd, eventName$+"_COMate", callback)
|
||
|
|
SetProp_(*this\hWnd, eventName$+"_RETURN_COMate", returnType)
|
||
|
|
ElseIf *this\hWnd
|
||
|
|
RemoveProp_(*this\hWnd, eventName$+"_COMate")
|
||
|
|
RemoveProp_(*this\hWnd, eventName$+"_RETURN_COMate")
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
ElseIf callback = 0 ;*this\eventSink will equal 0 as well.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndIf
|
||
|
|
;Only remaining options are for wishing to remove a previously installed sink (requires #COMate_CatchAllEvents) or a completely new sink is to be installed.
|
||
|
|
result = *this\iDisp\GetTypeInfoCount(@infoCount)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
If InfoCount = 1
|
||
|
|
result = *this\iDisp\GetTypeInfo(0, 0, @dispTypeInfo)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
result = dispTypeInfo\GetContainingTypeLib(@typeLib, @index)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
result = *this\iDisp\QueryInterface(?IID_IConnectionPointContainer, @container)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
If *riid.IID = 0
|
||
|
|
result = container\EnumConnectionPoints(@enum.IEnumConnectionPoints)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
enum\Reset()
|
||
|
|
result = enum\Next(1, @connection, #Null)
|
||
|
|
While result = #S_OK
|
||
|
|
result = Connection\GetConnectionInterface(@connIID)
|
||
|
|
If SUCCEEDED(result) ;We have a valid IID for the outgoing interface managed by this connection point.
|
||
|
|
result = typeLib\GetTypeInfoOfGuid(connIID, @typeInfo)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
enum\Release()
|
||
|
|
Goto COMateClass_SetEventHandler_L1
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
connection\Release()
|
||
|
|
result = enum\Next(1, @connection, #Null)
|
||
|
|
Wend
|
||
|
|
enum\Release()
|
||
|
|
EndIf
|
||
|
|
Else ;The user has specified a connection point interface.
|
||
|
|
result = container\FindConnectionPoint(*riid, @connection)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
result = Connection\GetConnectionInterface(@connIID) ;May or may not equal the IID pointed to by *riid.
|
||
|
|
If SUCCEEDED(result) ;We have a valid IID for the outgoing interface managed by this connection point.
|
||
|
|
result = typeLib\GetTypeInfoOfGuid(*riid, @typeInfo)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
COMateClass_SetEventHandler_L1:
|
||
|
|
If eventName$ = #COMate_CatchAllEvents And callback = 0 ;Remove existing sink.
|
||
|
|
;The Unadvise() method will call Release() on our sink and so we leave all tidying up to this method.
|
||
|
|
connection\Unadvise(*this\eventSink\cookie)
|
||
|
|
TypeInfo\Release()
|
||
|
|
Else ;New sink needs creating.
|
||
|
|
*sink = AllocateMemory(SizeOf(_COMateEventSink))
|
||
|
|
If *sink
|
||
|
|
*this\eventSink = *sink
|
||
|
|
With *this\eventSink
|
||
|
|
\Vtbl = ?VTable_COMateEventSink
|
||
|
|
\refCount = 1
|
||
|
|
\typeInfo = typeInfo
|
||
|
|
If eventName$ = #COMate_CatchAllEvents
|
||
|
|
\callback = Callback
|
||
|
|
\returnType = returnType
|
||
|
|
ElseIf *this\hWnd
|
||
|
|
SetProp_(*this\hWnd, eventName$+"_COMate", callback)
|
||
|
|
SetProp_(*this\hWnd, eventName$+"_RETURN_COMate", returnType)
|
||
|
|
EndIf
|
||
|
|
CopyMemory(connIID, @\connIID, SizeOf(IID))
|
||
|
|
\parent = *this
|
||
|
|
EndWith
|
||
|
|
newSink = *sink
|
||
|
|
result = connection\Advise(newSink, @*this\eventSink\cookie) ;Calls QueryInterface() on NewSink hence the subsequent Release().
|
||
|
|
;In the case of an error this release will decrement the ref counter to zero and then tidy up!
|
||
|
|
NewSink\Release()
|
||
|
|
Else
|
||
|
|
TypeInfo\Release()
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
connection\Release()
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
container\Release()
|
||
|
|
EndIf
|
||
|
|
typeLib\Release()
|
||
|
|
EndIf
|
||
|
|
dispTypeInfo\Release()
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method, valid only when called from a user's event procedure, retrieves the specified parameter in the form
|
||
|
|
;of a quad.
|
||
|
|
Procedure.q COMateClass_GetIntegerEventParam(*this._membersCOMateClass, index)
|
||
|
|
Protected result.i = #S_OK, var.VARIANT, puArgErr
|
||
|
|
If *this\eventSink And *this\eventSink\dispParams
|
||
|
|
If index > 0 And index <= *this\eventSink\dispParams\cArgs+*this\eventSink\dispParams\cNamedArgs
|
||
|
|
result = DispGetParam_(*this\eventSink\dispParams, index-1, #VT_I8, var, @puArgErr)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn var\llval
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method, valid only when called from a user's event procedure, retrieves the specified parameter in the form
|
||
|
|
;of a COM interface. It does not wrap any returned object into a COMate object. Returns zero if an error.
|
||
|
|
;The user MUST call Release() on any object returned.
|
||
|
|
;Leave objectType = #VT_DISPATCH to have an iDispatch interface returned. Any other value will result in an iUnknown interface.
|
||
|
|
Procedure.i COMateClass_GetObjectEventParam(*this._membersCOMateClass, index, objectType = #VT_DISPATCH)
|
||
|
|
Protected result.i = #S_OK, var.VARIANT, puArgErr
|
||
|
|
If *this\eventSink And *this\eventSink\dispParams
|
||
|
|
If index > 0 And index <= *this\eventSink\dispParams\cArgs+*this\eventSink\dispParams\cNamedArgs
|
||
|
|
If objectType <> #VT_DISPATCH
|
||
|
|
objectType = #VT_UNKNOWN
|
||
|
|
EndIf
|
||
|
|
result = DispGetParam_(*this\eventSink\dispParams, index-1, objectType, @var, @puArgErr)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn var\pDispVal
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method, valid only when called from a user's event procedure, retrieves the specified parameter in the form
|
||
|
|
;of a double.
|
||
|
|
Procedure.d COMateClass_GetRealEventParam(*this._membersCOMateClass, index)
|
||
|
|
Protected result.i = #S_OK, var.VARIANT, puArgErr
|
||
|
|
If *this\eventSink And *this\eventSink\dispParams
|
||
|
|
If index > 0 And index <= *this\eventSink\dispParams\cArgs+*this\eventSink\dispParams\cNamedArgs
|
||
|
|
result = DispGetParam_(*this\eventSink\dispParams, index-1, #VT_R8, var, @puArgErr)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn var\dblVal
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method, valid only when called from a user's event procedure, retrieves the specified parameter in the form
|
||
|
|
;of a string.
|
||
|
|
Procedure.s COMateClass_GetStringEventParam(*this._membersCOMateClass, index)
|
||
|
|
Protected result.i = #S_OK, var.VARIANT, puArgErr, text$
|
||
|
|
If *this\eventSink And *this\eventSink\dispParams
|
||
|
|
If index > 0 And index <= *this\eventSink\dispParams\cArgs+*this\eventSink\dispParams\cNamedArgs
|
||
|
|
result = DispGetParam_(*this\eventSink\dispParams, index-1, #VT_BSTR, var, @puArgErr)
|
||
|
|
If var\bstrVal
|
||
|
|
text$ = PeekS(var\bstrVal, -1, #PB_Unicode)
|
||
|
|
SysFreeString_(var\bstrVal)
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn text$
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method, valid only when called from a user's event procedure, returns 0 if the specified parameter was
|
||
|
|
;not passed by reference.
|
||
|
|
;Otherwise, it returns the variant #VT_... type of the underlying parameter and it places the address of the underlying
|
||
|
|
;parameter into the *ptrParameter parameter (if non-zero). This allows the client application to alter the value of the parameter
|
||
|
|
;as appropriate.
|
||
|
|
;For even more flexibility, you can obtain a pointer to the actual variant containing the parameter as supplied by the ActiveX control.
|
||
|
|
Procedure.i COMateClass_IsEventParamPassedByRef(*this._membersCOMateClass, index, *ptrParameter.INTEGER=0, *ptrVariant.INTEGER=0)
|
||
|
|
Protected result.i = #S_OK, *var.VARIANT, *ptr.INTEGER, numArgs
|
||
|
|
If *this\eventSink And *this\eventSink\dispParams
|
||
|
|
numArgs = *this\eventSink\dispParams\cArgs+*this\eventSink\dispParams\cNamedArgs
|
||
|
|
If index > 0 And index <= numArgs
|
||
|
|
*var = *this\eventSink\dispParams\rgvarg + (numArgs-index)*SizeOf(VARIANT)
|
||
|
|
If *var\vt&#VT_BYREF
|
||
|
|
result = *var\vt&~#VT_BYREF
|
||
|
|
If *ptrParameter
|
||
|
|
*ptrParameter\i = *var\pllval
|
||
|
|
EndIf
|
||
|
|
If *ptrVariant
|
||
|
|
*ptrVariant\i = *var
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, #E_INVALIDARG)
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, #E_FAIL)
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
CompilerEndIf
|
||
|
|
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function is called by the COMatePLUS_CompileSubobjectInvokation() function when extracting method arguments and only when the final
|
||
|
|
;option is a numeric argument.
|
||
|
|
;Returns #True if a valid variant numeric type is found and also places the relevant value within the given variant.
|
||
|
|
Procedure.i COMate_INTERNAL_CheckNumeric(arg$, *var.VARIANT)
|
||
|
|
Protected result.i = #True, i, blnPoint, length, *ptr.CHARACTER
|
||
|
|
Protected val.q, byte.b, word.w, long.l
|
||
|
|
length = Len(arg$)
|
||
|
|
*ptr = @arg$
|
||
|
|
For i = 1 To length
|
||
|
|
If *ptr\c = '-' Or *ptr\c = '+'
|
||
|
|
If i > 1
|
||
|
|
result = 0
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
ElseIf *ptr\c = '.' And blnPoint = #False
|
||
|
|
blnPoint = #True
|
||
|
|
ElseIf *ptr\c < '0' Or *ptr\c > '9'
|
||
|
|
result = 0
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
*ptr+SizeOf(CHARACTER)
|
||
|
|
Next
|
||
|
|
If result
|
||
|
|
If blnPoint ;Decimal.
|
||
|
|
*var\vt = #VT_R8
|
||
|
|
*var\dblVal = ValD(arg$)
|
||
|
|
Else ;Some kind of integer.
|
||
|
|
val = Val(arg$)
|
||
|
|
If val = 0 ;Shove this into a signed 'long'.
|
||
|
|
*var\vt = #VT_I4
|
||
|
|
*var\lVal = 0
|
||
|
|
Else
|
||
|
|
;Check if the value will fit into a signed-byte or a signed-word or a signed-long or a signed-quad.
|
||
|
|
byte = val
|
||
|
|
If byte = val ;Signed byte.
|
||
|
|
*var\vt = #VT_I1
|
||
|
|
*var\cVal = val
|
||
|
|
Else
|
||
|
|
word = val
|
||
|
|
If word = val ;Signed word.
|
||
|
|
*var\vt = #VT_I2
|
||
|
|
*var\iVal = val
|
||
|
|
Else
|
||
|
|
long = val
|
||
|
|
If long = val ;Signed long.
|
||
|
|
*var\vt = #VT_I4
|
||
|
|
*var\lVal = val
|
||
|
|
Else ;Quad.
|
||
|
|
*var\vt = #VT_I8
|
||
|
|
*var\llVal = val
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function is called by the COMatePLUS_CompileSubobjectInvokation() function when extracting method arguments and only for non-empty strings.
|
||
|
|
;Quoted strings (beginning with ') can contain escaped sequences of the form $xxxx where xxxx represent a hex number.
|
||
|
|
;Together $xxxx represents a single character code; e.g. an Ascii code. E.g. $0024 would be replaced by a $ character and
|
||
|
|
;$0027 would be replaced by a ' character.
|
||
|
|
;Adjusts the string in-place.
|
||
|
|
Procedure COMate_INTERNAL_EscapeString(ptrText)
|
||
|
|
Protected *source.CHARACTER, *destination.CHARACTER, blnEscape, value, t1, pow, i
|
||
|
|
*source.CHARACTER = ptrText
|
||
|
|
*destination = *source
|
||
|
|
While *source\c
|
||
|
|
If *source\c = 36
|
||
|
|
;Is this the beginning of an escape sequence?
|
||
|
|
blnEscape = #True
|
||
|
|
t1 = *source
|
||
|
|
value = 0
|
||
|
|
pow = 4096 ;16^3.
|
||
|
|
For i = 1 To 4
|
||
|
|
*source + SizeOf(CHARACTER)
|
||
|
|
If *source\c = 0 ;Null terminator.
|
||
|
|
Break 2
|
||
|
|
ElseIf *source\c >= '0' And *source\c <= '9'
|
||
|
|
value + (*source\c-'0')*pow
|
||
|
|
ElseIf *source\c >= 'A' And *source\c <= 'F'
|
||
|
|
value + (*source\c-'A'+10)*pow
|
||
|
|
ElseIf *source\c >= 'a' And *source\c <= 'f'
|
||
|
|
value + (*source\c-'a'+10)*pow
|
||
|
|
Else
|
||
|
|
blnEscape = #False
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
pow>>4
|
||
|
|
Next
|
||
|
|
If blnEscape ;We have an escape sequence.
|
||
|
|
*destination\c = value&$ff : *destination + SizeOf(CHARACTER)
|
||
|
|
*source + SizeOf(CHARACTER)
|
||
|
|
Else
|
||
|
|
*source = t1
|
||
|
|
Goto COMate_labelEscape1
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
COMate_labelEscape1:
|
||
|
|
*destination\c = *source\c
|
||
|
|
*destination + SizeOf(CHARACTER)
|
||
|
|
*source + SizeOf(CHARACTER)
|
||
|
|
EndIf
|
||
|
|
Wend
|
||
|
|
*destination\c = 0 ;Null termminator.
|
||
|
|
EndProcedure
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function is called (possibly more than once) by the COMateClass_INTERNAL_InvokePlus as we drill down through
|
||
|
|
;subobject method calls etc. This performs the task of calling the dispinterface methods.
|
||
|
|
;Returns a HRESULT value; #S_OK for no errors.
|
||
|
|
Procedure.i COMateClass_INTERNAL_InvokeiDispatch(*this._membersCOMateClass, invokeType, returnType, *ret.VARIANT, iDisp.iDispatch, subObjectIndex, *statement._COMatePLUSStatement)
|
||
|
|
Protected result.i = #S_OK
|
||
|
|
Protected dispID, dp.DISPPARAMS, dispIDNamed, excep.EXCEPINFO2, uiArgErr
|
||
|
|
;First task is to retrieve the dispID corresponding to the method/property.
|
||
|
|
result = iDisp\GetIDsOfNames(?IID_NULL, @*statement\methodName[subObjectIndex], 1, #LOCALE_USER_DEFAULT, @dispID)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
;Now prepare to call the method/property.
|
||
|
|
dispidNamed = #DISPID_PROPERTYPUT
|
||
|
|
If *statement\numArgs[subObjectIndex]
|
||
|
|
dp\rgvarg = *statement\ptrVarArgs[subObjectIndex] + (#COMate_MAXNUMVARIANTARGS - *statement\numArgs[subObjectIndex])*SizeOf(VARIANT)
|
||
|
|
EndIf
|
||
|
|
dp\cargs = *statement\numArgs[subObjectIndex]
|
||
|
|
If invokeType & (#DISPATCH_PROPERTYPUT | #DISPATCH_PROPERTYPUTREF)
|
||
|
|
dp\cNamedArgs = 1
|
||
|
|
dp\rgdispidNamedArgs = @dispidNamed
|
||
|
|
EndIf
|
||
|
|
;Call the method/property.
|
||
|
|
result = iDisp\Invoke(dispID, ?IID_NULL, #LOCALE_USER_DEFAULT, invokeType, dp, *ret, excep, @uiArgErr)
|
||
|
|
If result = #DISP_E_EXCEPTION
|
||
|
|
;Has the automation server deferred from filling in the EXCEPINFO2 structure?
|
||
|
|
If excep\pfnDeferredFillIn
|
||
|
|
excep\pfnDeferredFillIn(excep)
|
||
|
|
EndIf
|
||
|
|
If excep\bstrSource
|
||
|
|
SysFreeString_(excep\bstrSource)
|
||
|
|
EndIf
|
||
|
|
If excep\bstrDescription
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result, #True, PeekS(excep\bstrDescription, -1, #PB_Unicode))
|
||
|
|
CompilerEndIf
|
||
|
|
SysFreeString_(excep\bstrDescription)
|
||
|
|
Else
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, result, #True)
|
||
|
|
CompilerEndIf
|
||
|
|
EndIf
|
||
|
|
If excep\bstrHelpFile
|
||
|
|
SysFreeString_(excep\bstrHelpFile)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function is called by all methods which need to invoke a COM method through iDispatch etc.
|
||
|
|
;It drills down through all the sub-objects of a method call as appropriate.
|
||
|
|
;Returns a HRESULT value; #S_OK for no errors.
|
||
|
|
Procedure.i COMateClass_INTERNAL_InvokePlus(*this._membersCOMateClass, invokeType, returnType, *ret.VARIANT, command$, *hStatement._COMatePLUSStatement)
|
||
|
|
Protected result.i = #S_OK, *statement._COMatePLUSStatement, subObjectIndex
|
||
|
|
Protected iDisp.iDispatch, var.VARIANT
|
||
|
|
;First job is to prepare a statement if one has not been provided by the developer.
|
||
|
|
If *hStatement
|
||
|
|
*statement = *hStatement
|
||
|
|
Else
|
||
|
|
result = COMate_INTERNAL_PrepareStatement(command$, @*statement)
|
||
|
|
EndIf
|
||
|
|
If *statement
|
||
|
|
VariantInit_(var)
|
||
|
|
iDisp = *this\iDisp
|
||
|
|
iDisp\AddRef() ;This seemingly extraneous AddRef() will be balanced (released) in the following loop or the code following the loop.
|
||
|
|
For subObjectIndex = 1 To *statement\numSubObjects-1
|
||
|
|
result = COMateClass_INTERNAL_InvokeiDispatch(*this, #DISPATCH_METHOD|#DISPATCH_PROPERTYGET, #VT_DISPATCH, var, iDisp, subObjectIndex, *statement)
|
||
|
|
iDisp\Release()
|
||
|
|
iDisp = var\pdispVal
|
||
|
|
If FAILED(result) Or iDisp = 0
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
VariantInit_(var)
|
||
|
|
Next
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
If iDisp
|
||
|
|
result = COMateClass_INTERNAL_InvokeiDispatch(*this, invokeType, returnType, *ret, iDisp, *statement\numSubObjects, *statement)
|
||
|
|
iDisp\Release()
|
||
|
|
Else
|
||
|
|
;In this case we set an error with extra info.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this, #S_FALSE, 0, "The '" + PeekS(*statement\methodName[subObjectIndex], -1, #PB_Unicode) + "' property returned a NULL object!")
|
||
|
|
CompilerEndIf
|
||
|
|
result = -1 ;This will ensure that the COMateClass_INTERNAL_SetError() does not reset the error.
|
||
|
|
EndIf
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
;Sort out any return.
|
||
|
|
If *ret And *ret\vt <> returnType And returnType <> #VT_EMPTY
|
||
|
|
result = VariantChangeType_(*ret, *ret, 16, returnType)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
;Tidy up.
|
||
|
|
If *hStatement = 0
|
||
|
|
COMate_INTERNAL_FreeStatementHandle(*statement)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
|
||
|
|
;///////////////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;iDispatch errors will already have been processed.
|
||
|
|
Procedure COMateClass_INTERNAL_SetError(*this._membersCOMateClass, result, blnAllowDispError = 0, dispError$="")
|
||
|
|
Protected *error._COMateThreadErrors, Array.i, winError, len, *buffer
|
||
|
|
If COMate_gErrorTLS = 0 Or COMate_gErrorTLS = -1
|
||
|
|
;Create a new TLS index to hold error information.
|
||
|
|
COMate_gErrorTLS = TlsAlloc_()
|
||
|
|
EndIf
|
||
|
|
If COMate_gErrorTLS = -1 Or result = -1 Or (result = #DISP_E_EXCEPTION And blnAllowDispError = 0)
|
||
|
|
ProcedureReturn
|
||
|
|
EndIf
|
||
|
|
;Is there a TLS entry for this thread.
|
||
|
|
*error = TlsGetValue_(COMate_gErrorTLS)
|
||
|
|
If *error = 0 ;No existing entry.
|
||
|
|
;Attempt to allocate memory for a TLS entry for this thread.
|
||
|
|
*error = AllocateMemory(SizeOf(_COMateThreadErrors))
|
||
|
|
If *error
|
||
|
|
If TlsSetValue_(COMate_gErrorTLS, *error)
|
||
|
|
;Need to extend the memory if already allocated for the *COMate_gPtrThreadArray array so that the error memory can be freed later on.
|
||
|
|
Array = ReAllocateMemory(COMate_gPtrThreadArray, (COMate_gNumThreadElements+1)*SizeOf(Array))
|
||
|
|
If Array
|
||
|
|
COMate_gPtrThreadArray = Array
|
||
|
|
PokeI(COMate_gPtrThreadArray + COMate_gNumThreadElements*SizeOf(Array), *error)
|
||
|
|
COMate_gNumThreadElements+1
|
||
|
|
Else
|
||
|
|
TlsSetValue_(COMate_gErrorTLS, 0)
|
||
|
|
FreeMemory(*error)
|
||
|
|
*error = 0
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
FreeMemory(*error)
|
||
|
|
*error = 0
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If *error
|
||
|
|
*error\lastErrorCode = result
|
||
|
|
Select result
|
||
|
|
Case #S_OK
|
||
|
|
*error\lastError$ = "Okay."
|
||
|
|
Case #S_FALSE
|
||
|
|
If dispError$
|
||
|
|
*error\lastError$ = "The operation completed, but was only partially successful. (" + dispError$ + ")"
|
||
|
|
Else
|
||
|
|
*error\lastError$ = "The operation completed, but was only partially successful."
|
||
|
|
EndIf
|
||
|
|
Case #E_FAIL
|
||
|
|
*error\lastError$ = "Unspecified error."
|
||
|
|
Case #E_INVALIDARG
|
||
|
|
*error\lastError$ = "One or more arguments are invalid. Possibly a numerical overflow or too many nested objects, -if so, try splitting your method call into two or more subcalls."
|
||
|
|
Case #E_NOINTERFACE
|
||
|
|
*error\lastError$ = "Method is not implemented."
|
||
|
|
Case #E_OUTOFMEMORY
|
||
|
|
*error\lastError$ = "Problem allocating memory." + #CRLF$ + #CRLF$ + "(Possibly too many method arguments. Each method/property is limited by COMatePLUS to a maximum of " + Str(#COMate_MAXNUMVARIANTARGS) + " arguments.)"
|
||
|
|
Case #E_UNEXPECTED
|
||
|
|
*error\lastError$ = "An unexpected error."
|
||
|
|
Case #E_POINTER
|
||
|
|
*error\lastError$ = "An invalid pointer was supplied."
|
||
|
|
Case #E_NOTIMPL
|
||
|
|
*error\lastError$ = "Not implemented. In the case of attaching an event handler to a COM object, this could signify that the object does not provide any type information."
|
||
|
|
Case #CO_E_CLASSSTRING, #REGDB_E_CLASSNOTREG
|
||
|
|
*error\lastError$ = "Invalid progID/CLSID. Check your spelling of the programmatic identifier. Also check that the component / ActiveX control has been registered."
|
||
|
|
Case #CO_E_SERVER_EXEC_FAILURE
|
||
|
|
*error\lastError$ = "Server execution failed. Usually caused by an 'out of process server' timing out when asked to create an instance of a 'class factory'."
|
||
|
|
Case #DISP_E_TYPEMISMATCH
|
||
|
|
*error\lastError$ = "Type mismatch in the method parameters."
|
||
|
|
Case #TYPE_E_ELEMENTNOTFOUND
|
||
|
|
*error\lastError$ = "No type description was found in the library with the specified GUID whilst trying to create an event handler."
|
||
|
|
Case #CONNECT_E_ADVISELIMIT
|
||
|
|
*error\lastError$ = "Unable to set event handler because the connection point has already reached its limit of connections."
|
||
|
|
Case #CLASS_E_NOAGGREGATION
|
||
|
|
*error\lastError$ = "Class does not support aggregation (or class object is remote)."
|
||
|
|
Case #DISP_E_OVERFLOW
|
||
|
|
*error\lastError$ = "Overflow error whilst converting between types."
|
||
|
|
Case #DISP_E_UNKNOWNNAME
|
||
|
|
*error\lastError$ = "Method/property not supported by this object."
|
||
|
|
Case #DISP_E_BADPARAMCOUNT
|
||
|
|
*error\lastError$ = "Invalid number of method/property parameters."
|
||
|
|
Case #DISP_E_BADVARTYPE
|
||
|
|
*error\lastError$ = "A method/property parameter is not a valid (variant) type."
|
||
|
|
Case #DISP_E_MEMBERNOTFOUND
|
||
|
|
*error\lastError$ = "Member not found. (Check that you have not omitted any optional parameters and are not trying to set a read-only property etc.)"
|
||
|
|
Case #DISP_E_NOTACOLLECTION
|
||
|
|
*error\lastError$ = "Does not support a collection."
|
||
|
|
Case #E_ACCESSDENIED
|
||
|
|
*error\lastError$ = "A 'general' access denied error."
|
||
|
|
Case #RPC_E_WRONG_THREAD
|
||
|
|
*error\lastError$ = "The application called upon an interface that was marshalled for a different thread."
|
||
|
|
Case #DISP_E_EXCEPTION
|
||
|
|
*error\lastError$ = dispError$
|
||
|
|
If *error\lastError$ = ""
|
||
|
|
*error\lastError$ = "An exception occurred during the execution of this method/property."
|
||
|
|
EndIf
|
||
|
|
Default
|
||
|
|
;Check for a WIN32 facility code.
|
||
|
|
If *error\lastErrorCode & $7FFF0000 = $70000
|
||
|
|
winError = *error\lastErrorCode&$FFFF
|
||
|
|
len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM, 0, winError, 0, @*Buffer, 0, 0)
|
||
|
|
If len
|
||
|
|
*error\lastError$ = "(FACILITY_WIN32 error " + Str(winError) + ") " + PeekS(*Buffer, len)
|
||
|
|
LocalFree_(*Buffer)
|
||
|
|
Else
|
||
|
|
*error\lastError$ = "(FACILITY_WIN32 error " + Str(winError) + ") Unable to retrieve error description from system!"
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
*error\lastError$ = "Unknown error. (Code : Hex " + Hex(*error\lastErrorCode, #PB_Long) + "). Please report this error code to the author at 'enquiries@nxsoftware.com'"
|
||
|
|
EndIf
|
||
|
|
EndSelect
|
||
|
|
EndIf
|
||
|
|
EndProcedure
|
||
|
|
;///////////////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
;-OUTGOING 'SINK' INTERFACE METHODS.
|
||
|
|
;------------------------------------------------------------------------
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The QueryInterface() method of our COMate sink objects.
|
||
|
|
Procedure.i COMateSinkClass_QueryInterface(*this._COMateEventSink, *IID.IID, *Object.INTEGER)
|
||
|
|
If CompareMemory(*IID, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*IID, ?IID_IDispatch, SizeOf(IID)) Or CompareMemory(*IID, @*this\connIID, SizeOf(IID))
|
||
|
|
*Object\i = *this
|
||
|
|
*this\refCount + 1
|
||
|
|
ProcedureReturn #S_OK
|
||
|
|
Else
|
||
|
|
*Object\i = 0
|
||
|
|
ProcedureReturn #E_NOINTERFACE
|
||
|
|
EndIf
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The AddRef() method of our COMate sink objects.
|
||
|
|
Procedure.i COMateSinkClass_AddRef(*this._COMateEventSink)
|
||
|
|
*this\refCount + 1
|
||
|
|
ProcedureReturn *this\refCount
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The Release() method of our COMate sink objects.
|
||
|
|
Procedure.i COMateSinkClass_Release(*this._COMateEventSink)
|
||
|
|
*this\refCount - 1
|
||
|
|
If *this\refCount = 0
|
||
|
|
If *this\parent
|
||
|
|
;Release all event related window properties added to the ActiveX container.
|
||
|
|
If IsWindow_(*this\parent\hWnd)
|
||
|
|
EnumPropsEx_(*this\parent\hWnd, @COMate_DelSinkPropsCallback(),#Null)
|
||
|
|
EndIf
|
||
|
|
*this\parent\eventSink = 0
|
||
|
|
EndIf
|
||
|
|
*this\typeInfo\Release()
|
||
|
|
FreeMemory(*this)
|
||
|
|
ProcedureReturn 0
|
||
|
|
Else
|
||
|
|
ProcedureReturn *this\refCount
|
||
|
|
EndIf
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The next 3 methods of the COMate sink interface are possibly not required, but ...
|
||
|
|
Procedure.i COMateSinkClass_GetTypeInfoCount(*this._COMateEventSink, *pctinfo.INTEGER)
|
||
|
|
*pctinfo\i = 1
|
||
|
|
ProcedureReturn #S_OK
|
||
|
|
EndProcedure
|
||
|
|
|
||
|
|
Procedure.i COMateSinkClass_GetTypeInfo(*this._COMateEventSink, iTInfo, lcid, *ppTInfo.INTEGER)
|
||
|
|
*ppTInfo\i = *this\typeInfo
|
||
|
|
*this\typeInfo\AddRef()
|
||
|
|
ProcedureReturn #S_OK
|
||
|
|
EndProcedure
|
||
|
|
|
||
|
|
Procedure.i COMateSinkClass_GetIDsOfNames(*this._COMateEventSink, *riid, *rgszNames, *cNames, lcid, *DispID)
|
||
|
|
ProcedureReturn DispGetIDsOfNames_(*this\typeInfo, *rgszNames, *cNames, *DispID)
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The Invoke() method of our COMate sink objects.
|
||
|
|
;This is where we call the user's event procedure.
|
||
|
|
Procedure.i COMateSinkClass_Invoke(*this._COMateEventSink, dispid, *riid, lcid, wflags.w, *Params.DISPPARAMS, *Result.VARIANT, *pExept, *ArgErr)
|
||
|
|
Protected result.i = #S_OK, bstrName.i, nameCount, tempParams, eventName$, returnType, address
|
||
|
|
Protected callbackNoReturn.COMate_EventCallback_NORETURN, callbackIntegerReturn.COMate_EventCallback_INTEGERRETURN, callbackRealReturn.COMate_EventCallback_REALRETURN, callbackStringReturn.COMate_EventCallback_STRINGRETURN, callbackUnknownReturn.COMate_EventCallback_UNKNOWNRETURN
|
||
|
|
Protected intRet.q, realRet.d, stringRet$
|
||
|
|
result = *this\TypeInfo\GetNames(dispid, @bstrName, 1, @nameCount)
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
If bstrName
|
||
|
|
tempParams = *this\dispParams
|
||
|
|
*this\dispParams = *Params
|
||
|
|
eventName$ = PeekS(bstrName, -1, #PB_Unicode)
|
||
|
|
SysFreeString_(bstrName)
|
||
|
|
;Call the 'global' #COMate_CatchAllEvents handler if defined.
|
||
|
|
If *this\callback
|
||
|
|
If *this\returnType = #COMate_OtherReturn
|
||
|
|
callbackUnknownReturn = *this\callback
|
||
|
|
callbackUnknownReturn(*this\parent, eventName$, *Params\cArgs + *Params\cNamedArgs, *Result)
|
||
|
|
Else
|
||
|
|
*this\callback(*this\parent, eventName$, *Params\cArgs + *Params\cNamedArgs)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
;Call any individual handler attached to this event. We need to take into account the return type.
|
||
|
|
If *this\parent\hWnd
|
||
|
|
address = GetProp_(*this\parent\hWnd, eventName$ + "_COMate")
|
||
|
|
If address
|
||
|
|
returnType = GetProp_(*this\parent\hWnd, eventName$ + "_RETURN_COMate")
|
||
|
|
Select returnType
|
||
|
|
Case #COMate_NoReturn
|
||
|
|
callbackNoReturn = address
|
||
|
|
callbackNoReturn(*this\parent, eventName$, *Params\cArgs + *Params\cNamedArgs)
|
||
|
|
Case #COMate_IntegerReturn
|
||
|
|
callbackIntegerReturn = address
|
||
|
|
intRet = callbackIntegerReturn(*this\parent, eventName$, *Params\cArgs + *Params\cNamedArgs)
|
||
|
|
If *Result
|
||
|
|
*Result\vt = #VT_I8
|
||
|
|
*Result\llVal = intRet
|
||
|
|
EndIf
|
||
|
|
Case #COMate_RealReturn
|
||
|
|
callbackRealReturn = address
|
||
|
|
realRet = callbackRealReturn(*this\parent, eventName$, *Params\cArgs + *Params\cNamedArgs)
|
||
|
|
If *Result
|
||
|
|
*Result\vt = #VT_R8
|
||
|
|
*Result\dblVal = realRet
|
||
|
|
EndIf
|
||
|
|
Case #COMate_StringReturn
|
||
|
|
callbackStringReturn = address
|
||
|
|
stringRet$ = callbackStringReturn(*this\parent, eventName$, *Params\cArgs + *Params\cNamedArgs)
|
||
|
|
If *Result
|
||
|
|
*Result\vt = #VT_BSTR
|
||
|
|
*Result\bstrVal = COMate_MakeBSTR(stringRet$)
|
||
|
|
EndIf
|
||
|
|
Case #COMate_OtherReturn
|
||
|
|
callbackUnknownReturn = address
|
||
|
|
callbackUnknownReturn(*this\parent, eventName$, *Params\cArgs + *Params\cNamedArgs, *Result)
|
||
|
|
EndSelect
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
*this\dispParams = tempParams
|
||
|
|
Else
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following callback function is called by windows as a result of the EnumPropsEx_() function
|
||
|
|
;issued when an outgoing sink object is destroyed.
|
||
|
|
;We use this to delete the properties we have created.
|
||
|
|
Procedure.i COMate_DelSinkPropsCallback(hWnd, lpszString, hData,dwData)
|
||
|
|
Protected text$
|
||
|
|
If lpszString>>16<>0 ;Confirms that this parameter points to a string and is not merely an atom.
|
||
|
|
text$ = PeekS(lpszString)
|
||
|
|
If Right(PeekS(lpszString),7)="_COMate"
|
||
|
|
RemoveProp_(hWnd, lpszString)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn 1
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
CompilerEndIf
|
||
|
|
|
||
|
|
|
||
|
|
;-STATEMENT FUNCTIONS.
|
||
|
|
;----------------------------------------------
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function compiles the given command string and if successful, returns a statement handle.
|
||
|
|
;Returns zero otherwise.
|
||
|
|
Procedure.i COMate_PrepareStatement(command$)
|
||
|
|
Protected errorCode = #S_OK, *hStatement._COMatePLUSStatement
|
||
|
|
errorCode = COMate_INTERNAL_PrepareStatement(command$, @*hStatement)
|
||
|
|
;Set any error code.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(0, errorCode)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *hStatement
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;Returns, if successful, a direct pointer to the appropriate variant structure. This address will not change for the life of the statement
|
||
|
|
;and thus need only be retrieved once.
|
||
|
|
;Index is 1-based.
|
||
|
|
Procedure.i COMate_GetStatementParameter(*hStatement._COMatePLUSStatement, index)
|
||
|
|
Protected errorCode = #E_INVALIDARG, result, i, total
|
||
|
|
If index > 0
|
||
|
|
;Track down which sub-object
|
||
|
|
For i = 1 To *hStatement\numSubObjects
|
||
|
|
total + *hStatement\numArgs[i]
|
||
|
|
If index <= total
|
||
|
|
;Adjust the index to reflect the underlying sub-object's number of parameters.
|
||
|
|
index = *hStatement\numArgs[i] - total + index
|
||
|
|
;Locate the relevant variant argument.
|
||
|
|
result= *hStatement\ptrVarArgs[i] + (#COMate_MAXNUMVARIANTARGS - index)*SizeOf(VARIANT)
|
||
|
|
errorCode = #S_OK
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
Next
|
||
|
|
EndIf
|
||
|
|
;Set any error code.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(0, errorCode)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function frees the specified statement.
|
||
|
|
Procedure COMate_FreeStatementHandle(*hStatement._COMatePLUSStatement)
|
||
|
|
COMate_INTERNAL_FreeStatementHandle(*hStatement)
|
||
|
|
;Set any error code.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(0, #S_OK)
|
||
|
|
CompilerEndIf
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;-INTERNAL FUNCTIONS.
|
||
|
|
;------------------------------------------
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function frees the specified statement but does not set any error.
|
||
|
|
Procedure COMate_INTERNAL_FreeStatementHandle(*hStatement._COMatePLUSStatement)
|
||
|
|
Protected i, j, *varArg.VARIANT
|
||
|
|
For i = 1 To *hStatement\numSubObjects
|
||
|
|
;First free any method BSTR.
|
||
|
|
If *hStatement\methodName[i]
|
||
|
|
SysFreeString_(*hStatement\methodName[i])
|
||
|
|
EndIf
|
||
|
|
;Now the variant array.
|
||
|
|
If *hStatement\ptrVarArgs[i]
|
||
|
|
*varArg = *hStatement\ptrVarArgs[i] + (#COMate_MAXNUMVARIANTARGS - 1) * SizeOf(VARIANT)
|
||
|
|
For j = 1 To *hStatement\numArgs[i]
|
||
|
|
VariantClear_(*varArg)
|
||
|
|
*varArg - SizeOf(VARIANT)
|
||
|
|
Next
|
||
|
|
FreeMemory(*hStatement\ptrVarArgs[i])
|
||
|
|
EndIf
|
||
|
|
Next
|
||
|
|
FreeMemory(*hStatement)
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following internal function compiles the given command string and if successful, places a statement handle into the buffer
|
||
|
|
;pointed to by *ptrStatement.
|
||
|
|
;Returns a HRESULT but does NOT set any error.
|
||
|
|
Procedure.i COMate_INTERNAL_PrepareStatement(command$, *ptrStatement.INTEGER)
|
||
|
|
Protected errorCode = #S_OK, *hStatement._COMatePLUSStatement
|
||
|
|
Protected Dim parse._COMateParse(#COMate_MAXNUMSUBOBJECTS), i, subObject
|
||
|
|
If command$
|
||
|
|
;Allocate memory for a statement handle.
|
||
|
|
*hStatement = AllocateMemory(SizeOf(_COMatePLUSStatement))
|
||
|
|
If *hStatement
|
||
|
|
;Tokenise the command string.
|
||
|
|
*hStatement\numSubObjects = COMatePLUS_TokeniseCommand(command$, "(),\'= ", parse())
|
||
|
|
If *hStatement\numSubObjects
|
||
|
|
For subObject = 1 To *hStatement\numSubObjects
|
||
|
|
;We need to parse/compile the tokenised command corresponding to each individual sub-object.
|
||
|
|
errorCode = COMatePLUS_CompileSubobjectInvokation(*hStatement, subObject, parse())
|
||
|
|
If errorCode <> #S_OK
|
||
|
|
COMate_FreeStatementHandle(*hStatement)
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
Next
|
||
|
|
If errorCode = #S_OK
|
||
|
|
*ptrStatement\i = *hStatement
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
FreeMemory(*hStatement)
|
||
|
|
errorCode = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
errorCode = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
errorCode = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn errorCode
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;///////////////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function tokenises the given command string.
|
||
|
|
;Submethod calls (+ associated parameters) are placed into the parse array; 1 element per subobject.
|
||
|
|
;This is very optimised by avoiding string functions as far as is possible; instead using multiple pointers etc.
|
||
|
|
;Returns zero if the line cannot be parsed else a count of the number of method calls.
|
||
|
|
;Error checking is included but is supplemented later on.
|
||
|
|
Procedure.i COMatePLUS_TokeniseCommand(command$, separator$, Array parse._COMateParse(1))
|
||
|
|
Protected length, methodCount=1, numEquals, t1, i, lenSeparator
|
||
|
|
Protected *command.CHARACTER, *buffer.CHARACTER, buffer, *ptrString.STRING, *ptrSeparator.CHARACTER, charPos = 1
|
||
|
|
length=Len(command$)
|
||
|
|
If length
|
||
|
|
buffer = AllocateMemory((length+1)*SizeOf(CHARACTER))
|
||
|
|
If buffer
|
||
|
|
lenSeparator = Len(separator$)
|
||
|
|
*ptrString = @buffer ;Speedy (pointer) access to the contents in the form of a string.
|
||
|
|
*buffer = buffer
|
||
|
|
parse(methodCount)\numberoftokens=0
|
||
|
|
*command = @command$
|
||
|
|
Repeat
|
||
|
|
;Search the separator string looking for this character.
|
||
|
|
*ptrSeparator = @separator$
|
||
|
|
t1 = #False
|
||
|
|
For i = 0 To lenSeparator-1
|
||
|
|
If *ptrSeparator\c = *command\c
|
||
|
|
t1 = #True
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
*ptrSeparator + SizeOf(CHARACTER)
|
||
|
|
Next
|
||
|
|
If t1
|
||
|
|
If *buffer <> buffer
|
||
|
|
parse(methodCount)\tokens$[parse(methodCount)\numberoftokens]=*ptrString\s
|
||
|
|
parse(methodCount)\numberoftokens+1
|
||
|
|
*buffer = buffer : *buffer\c = 0
|
||
|
|
ElseIf *command\c = 39 ;Open quote, buffer empty.
|
||
|
|
*buffer\c = *command\c : *buffer + SizeOf(CHARACTER)
|
||
|
|
;Find closing quote.
|
||
|
|
t1 = #False ;Boolean flag to indicate a closing quote.
|
||
|
|
While charPos < length
|
||
|
|
charPos + 1
|
||
|
|
*command + SizeOf(character)
|
||
|
|
*buffer\c = *command\c : *buffer + SizeOf(CHARACTER)
|
||
|
|
If *command\c = 39
|
||
|
|
t1 = #True
|
||
|
|
*buffer\c = 0 ;Null.
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
Wend
|
||
|
|
If t1 = #False ;No closing quote.
|
||
|
|
methodCount = 0
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
parse(methodCount)\tokens$[parse(methodCount)\numberoftokens]=*ptrString\s
|
||
|
|
parse(methodCount)\numberoftokens+1
|
||
|
|
charPos+1 : *command + SizeOf(CHARACTER)
|
||
|
|
*buffer = buffer : *buffer\c = 0
|
||
|
|
ElseIf *command\c <> 32 ;Buffer empty.
|
||
|
|
If *command\c = 40 ;"(".
|
||
|
|
parse(methodCount)\numOpenBrackets + 1
|
||
|
|
ElseIf *command\c = 41 ;")".
|
||
|
|
If parse(methodCount)\numOpenBrackets
|
||
|
|
parse(methodCount)\numCloseBrackets + 1
|
||
|
|
Else
|
||
|
|
methodCount = 0
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
ElseIf *command\c = 61 ;"=", buffer empty.
|
||
|
|
numEquals+1 ;Only allow 1 equals and then only for setting properties.
|
||
|
|
If numEquals > 1
|
||
|
|
methodCount = 0
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If *command\c = 92 ;"\".
|
||
|
|
If methodCount < #COMate_MAXNUMSUBOBJECTS And parse(methodCount)\numOpenBrackets = parse(methodCount)\numCloseBrackets And parse(methodCount)\numOpenBrackets <=1 And parse(methodCount)\numberoftokens And numEquals = 0
|
||
|
|
methodCount+1
|
||
|
|
parse(methodCount)\numberoftokens=0
|
||
|
|
parse(methodCount)\numOpenBrackets = 0
|
||
|
|
parse(methodCount)\numCloseBrackets = 0
|
||
|
|
charPos+1
|
||
|
|
*command + SizeOf(CHARACTER)
|
||
|
|
*buffer = buffer : *buffer\c = 0 ;Null.
|
||
|
|
Else
|
||
|
|
methodCount = 0
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
*buffer\c = *command\c : *buffer + SizeOf(CHARACTER) : *buffer\c = 0
|
||
|
|
parse(methodCount)\tokens$[parse(methodCount)\numberoftokens]=*ptrString\s
|
||
|
|
parse(methodCount)\numberoftokens+1
|
||
|
|
charPos+1
|
||
|
|
*command + SizeOf(CHARACTER)
|
||
|
|
*buffer = buffer : *buffer\c = 0 ;Null.
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
charPos+1
|
||
|
|
*command + SizeOf(CHARACTER)
|
||
|
|
*buffer = buffer : *buffer\c = 0 ;Null.
|
||
|
|
EndIf
|
||
|
|
ElseIf charPos = length
|
||
|
|
*buffer\c = *command\c : *buffer + SizeOf(CHARACTER)
|
||
|
|
*buffer\c = 0 ;Null.
|
||
|
|
parse(methodCount)\tokens$[parse(methodCount)\numberoftokens]=*ptrString\s
|
||
|
|
parse(methodCount)\numberoftokens+1
|
||
|
|
charPos + 1
|
||
|
|
Else
|
||
|
|
*buffer\c = *command\c : *buffer + SizeOf(CHARACTER) : *buffer\c = 0 ;Null.
|
||
|
|
*command+SizeOf(character)
|
||
|
|
charPos + 1
|
||
|
|
EndIf
|
||
|
|
Until charPos > length Or parse(methodCount)\numberOfTokens = #COMate_MAXNUMSYMBOLSINALINE
|
||
|
|
FreeMemory(buffer)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If methodCount And (parse(methodCount)\numOpenBrackets <> parse(methodCount)\numCloseBrackets Or parse(methodCount)\numOpenBrackets > 1 Or parse(methodCount)\numberoftokens=0)
|
||
|
|
methodCount = 0 ;Error.
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn methodCount
|
||
|
|
EndProcedure
|
||
|
|
;///////////////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
|
||
|
|
;///////////////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function compiles the tokenised command corresponding to a sub-object invokation within a command string.
|
||
|
|
;Returns a HRESULT.
|
||
|
|
Procedure.i COMatePLUS_CompileSubobjectInvokation(*hStatement._COMatePLUSStatement, subObjectIndex, Array parse._COMateParse(1))
|
||
|
|
Protected result = #S_OK, i, *varArg.VARIANT
|
||
|
|
Protected parseIndex, currentArg$, blnInsideParanthesis, lastArgType, blnByRef, t1$, vt, *cObject._membersCOMateClass, iDispatch.IDISPATCH
|
||
|
|
;Allocate memory for a variant array to hold the arguments.
|
||
|
|
*hStatement\ptrVarArgs[subObjectIndex] = AllocateMemory(#COMate_MAXNUMVARIANTARGS*SizeOf(VARIANT))
|
||
|
|
If *hStatement\ptrVarArgs[subObjectIndex]
|
||
|
|
;Set *varArg to point at the last variant in the variant array which is to hold the first parameter,
|
||
|
|
*varArg = *hStatement\ptrVarArgs[subObjectIndex] + (#COMate_MAXNUMVARIANTARGS - 1) * SizeOf(VARIANT)
|
||
|
|
While parseIndex < parse(subObjectIndex)\numberOfTokens
|
||
|
|
currentArg$ = parse(subObjectIndex)\tokens$[parseIndex]
|
||
|
|
Select currentArg$
|
||
|
|
Case "("
|
||
|
|
If parseIndex<>1
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
blnInsideParanthesis = #True
|
||
|
|
lastArgType = #COMate_OpenParanthesis
|
||
|
|
Case ")"
|
||
|
|
If lastArgType = #COMate_OpenParanthesis Or lastArgType = #COMate_Operand
|
||
|
|
lastArgType = #COMate_CloseParanthesis
|
||
|
|
blnInsideParanthesis = #False
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
Case "="
|
||
|
|
If (lastArgType = #COMate_CloseParanthesis Or lastArgType = #COMate_Method)
|
||
|
|
lastArgType = #COMate_Operator
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
Case ","
|
||
|
|
If blnInsideParanthesis And lastArgType = #COMate_Operand
|
||
|
|
lastArgType = #COMate_Operator
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
Default ;Method or the beginning of an operand.
|
||
|
|
If parseIndex = 0
|
||
|
|
lastArgType = #COMate_Method
|
||
|
|
*hStatement\methodName[subObjectIndex] = COMate_MakeBSTR(currentArg$)
|
||
|
|
If *hStatement\methodName[subObjectIndex] = 0
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
ElseIf (lastArgType = #COMate_OpenParanthesis) Or (lastArgType = #COMate_Operator);Cannot have 2 operands together.
|
||
|
|
If *varArg < *hStatement\ptrVarArgs[subObjectIndex]
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
blnByRef = #False
|
||
|
|
lastArgType = #COMate_Operand
|
||
|
|
;We must add the operand to the variant array.
|
||
|
|
;First task is to determine the parameter type. We first examine the operand and decide on the most likely variant format, creating
|
||
|
|
;a variant argument as appropriate. We then see if the user has supplied a 'type modifier', in which case we use VariantChangeType_() etc.
|
||
|
|
*varArg\vt = #VT_BSTR ;Default.
|
||
|
|
t1$ = LCase(currentArg$)
|
||
|
|
If t1$ = "#nullstring"
|
||
|
|
currentArg$ = ""
|
||
|
|
EndIf
|
||
|
|
If Left(currentArg$,1) = "'" Or currentArg$ = "";BSTR
|
||
|
|
currentArg$ = Mid(currentArg$, 2, Len(currentArg$)-2)
|
||
|
|
;We parse the string looking for 'escape' sequences.
|
||
|
|
If currentArg$
|
||
|
|
COMate_INTERNAL_EscapeString(@currentArg$)
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
Select t1$
|
||
|
|
Case "#false"
|
||
|
|
*varArg\vt = #VT_BOOL
|
||
|
|
*varArg\boolVal = #VARIANT_FALSE
|
||
|
|
Case "#true"
|
||
|
|
*varArg\vt = #VT_BOOL
|
||
|
|
*varArg\boolVal = #VARIANT_TRUE
|
||
|
|
Case "#empty", "#optional", "#opt" ;Used for optional parameters.
|
||
|
|
*varArg\vt = #VT_ERROR
|
||
|
|
*varArg\scode = #DISP_E_PARAMNOTFOUND
|
||
|
|
Case "#void"
|
||
|
|
If SizeOf(result) = 4
|
||
|
|
*varArg\vt = #VT_I4
|
||
|
|
*varArg\lval = 0
|
||
|
|
Else
|
||
|
|
*varArg\vt = #VT_I8
|
||
|
|
*varArg\llval = 0
|
||
|
|
EndIf
|
||
|
|
Default ;Here we check for numeric types.
|
||
|
|
If COMate_INTERNAL_CheckNumeric(currentArg$, *varArg) = 0
|
||
|
|
result = #E_INVALIDARG ;No other type of valid operand.
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
EndSelect
|
||
|
|
EndIf
|
||
|
|
If result = #S_OK And *varArg\vt = #VT_BSTR
|
||
|
|
*varArg\bstrVal = COMate_MakeBSTR(currentArg$)
|
||
|
|
If *varArg\bstrVal = 0
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
If parseIndex < parse(subObjectIndex)\numberOfTokens-1 And LCase(parse(subObjectIndex)\tokens$[parseIndex+1]) = "byref"
|
||
|
|
blnByRef = #True
|
||
|
|
parseIndex+1
|
||
|
|
EndIf
|
||
|
|
;Now check for a 'type modifier' which is signified by the presence of a 'AS <operand type>' etc.
|
||
|
|
vt = *varArg\vt
|
||
|
|
If parseIndex < parse(subObjectIndex)\numberOfTokens-2 And LCase(parse(subObjectIndex)\tokens$[parseIndex+1]) = "as"
|
||
|
|
t1$ = LCase(parse(subObjectIndex)\tokens$[parseIndex+2])
|
||
|
|
parseIndex + 2
|
||
|
|
Select t1$
|
||
|
|
Case "boolean" : vt = #VT_BOOL
|
||
|
|
Case "string", "bstr" : vt = #VT_BSTR
|
||
|
|
Case "byte" : vt = #VT_I1
|
||
|
|
Case "ubyte" : vt = #VT_UI1
|
||
|
|
Case "word" : vt = #VT_I2
|
||
|
|
Case "uword" : vt = #VT_UI2
|
||
|
|
Case "long", "dword" : vt = #VT_I4
|
||
|
|
Case "ulong", "udword" : vt = #VT_UI4
|
||
|
|
Case "quad", "qword" : vt = #VT_I8
|
||
|
|
Case "uquad", "uqword" : vt = #VT_UI8
|
||
|
|
Case "integer", "int" : vt = #VT_INT
|
||
|
|
Case "uinteger", "uint" : vt = #VT_UINT
|
||
|
|
Case "date" : vt = #VT_DATE
|
||
|
|
Case "object", "idispatch", "comateobject" : vt = #VT_DISPATCH
|
||
|
|
Case "iunknown" : vt = #VT_UNKNOWN
|
||
|
|
Case "float", "single" : vt = #VT_R4
|
||
|
|
Case "double" : vt = #VT_R8
|
||
|
|
Case "variant" : vt = #VT_VARIANT
|
||
|
|
Default
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndSelect
|
||
|
|
EndIf
|
||
|
|
If parseIndex < parse(subObjectIndex)\numberOfTokens-1 And LCase(parse(subObjectIndex)\tokens$[parseIndex+1]) = "byref"
|
||
|
|
blnByRef = #True
|
||
|
|
parseIndex+1
|
||
|
|
EndIf
|
||
|
|
;Now modify the underlying parameter depending on it's type and whether it is being passed by reference etc.
|
||
|
|
;Note that objects being passed by reference will NOT have their reference counts increased.
|
||
|
|
If blnByRef
|
||
|
|
Select *varArg\vt
|
||
|
|
Case #VT_I1, #VT_I2, #VT_I4, #VT_I8 ;Only these types (which have already been processed) can hold an address.
|
||
|
|
*varArg\vt = vt | #VT_BYREF
|
||
|
|
Default
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndSelect
|
||
|
|
;BYVAL.
|
||
|
|
ElseIf vt = #VT_DISPATCH
|
||
|
|
Select *varArg\vt
|
||
|
|
Case #VT_I1, #VT_I2, #VT_I4, #VT_I8 ;Only these types (which have already been processed) can hold an address.
|
||
|
|
;Call the AddRef method manually. A corresponding Release() will ensue when we use VariantClear_() when the underlying statement is freed.
|
||
|
|
If t1$ = "comateobject"
|
||
|
|
*cObject = *varArg\pdispVal
|
||
|
|
*varArg\pdispVal = *cObject\iDisp
|
||
|
|
*cObject\iDisp\AddRef()
|
||
|
|
Else
|
||
|
|
iDispatch = *varArg\pdispVal
|
||
|
|
iDispatch\AddRef()
|
||
|
|
EndIf
|
||
|
|
*varArg\vt = #VT_DISPATCH
|
||
|
|
Default
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndSelect
|
||
|
|
ElseIf vt = #VT_UNKNOWN
|
||
|
|
Select *varArg\vt
|
||
|
|
Case #VT_I1, #VT_I2, #VT_I4, #VT_I8 ;Only these types (which have already been processed) can hold an address.
|
||
|
|
;Call the AddRef method manually. A corresponding Release() will ensue when we use VariantClear_() when the underlying statement is freed.
|
||
|
|
iDispatch = *varArg\punkVal
|
||
|
|
iDispatch\AddRef()
|
||
|
|
*varArg\vt = #VT_UNKNOWN
|
||
|
|
Default
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndSelect
|
||
|
|
ElseIf vt = #VT_VARIANT ;We physically copy the variant into the VarArray().
|
||
|
|
Select *varArg\vt
|
||
|
|
Case #VT_I1, #VT_I2, #VT_I4, #VT_I8 ;Only these types (which have already been processed) can hold an address.
|
||
|
|
If *varArg\llVal
|
||
|
|
result = VariantCopy_(*varArg, *varArg\llVal)
|
||
|
|
If FAILED(result)
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
Default
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndSelect
|
||
|
|
ElseIf *varArg\vt <> vt
|
||
|
|
result = VariantChangeType_(*varArg, *varArg, 16, vt)
|
||
|
|
If FAILED(result)
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
*hStatement\numArgs[subObjectIndex] + 1
|
||
|
|
*varArg - SizeOf(VARIANT)
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
EndSelect
|
||
|
|
parseIndex+1
|
||
|
|
Wend
|
||
|
|
Else
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;///////////////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
|
||
|
|
;-=======================
|
||
|
|
;-COMateEnum OBJECT CODE.
|
||
|
|
;-=======================
|
||
|
|
|
||
|
|
;-COMateEnum CLASS METHODS.
|
||
|
|
;----------------------------------------------
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;Returns the next object in the underlying enumeration in the form of a COMate object (zero if an error).
|
||
|
|
;The object should be released as soon as it is no longer required.
|
||
|
|
;Any HRESULT return value is accessible through the GetLastErrorCode() method of the parent COMate object.
|
||
|
|
Procedure.i COMateEnumClass_GetNextObject(*this._membersCOMateEnumClass)
|
||
|
|
Protected result.i = #S_OK, retVar.VARIANT, *newObject._membersCOMateClass
|
||
|
|
result = *this\iEV\Next(1, retVar, 0)
|
||
|
|
If result = #S_OK ;Alternative is #S_FALSE.
|
||
|
|
If retVar\vt <> #VT_DISPATCH
|
||
|
|
result = VariantChangeType_(retVar, retVar, 0, #VT_DISPATCH)
|
||
|
|
EndIf
|
||
|
|
If SUCCEEDED(result)
|
||
|
|
;We create a new COMate object to house the new object.
|
||
|
|
*newObject = AllocateMemory(SizeOf(_membersCOMateClass))
|
||
|
|
If *newObject
|
||
|
|
*newObject\vTable = ?VTable_COMateClass
|
||
|
|
*newObject\iDisp = retVar\pdispVal
|
||
|
|
COMate_gNumObjects+1
|
||
|
|
Else
|
||
|
|
VariantClear_(retVar)
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
VariantClear_(retVar)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this\parent, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *newObject
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;Returns a pointer to a new variant which represents the next variant in the underlying enumeration (zero if an error).
|
||
|
|
;The variant should be 'freed' by the user with VariantClear_() etc.
|
||
|
|
;Any HRESULT return value is accessible through the GetLastErrorCode() method of the parent COMate object.
|
||
|
|
Procedure.i COMateEnumClass_GetNextVariant(*this._membersCOMateEnumClass)
|
||
|
|
Protected result.i = #S_OK, *retVar.VARIANT
|
||
|
|
;Allocate memory for a new variant.
|
||
|
|
*retVar = AllocateMemory(SizeOf(VARIANT))
|
||
|
|
If *retVar
|
||
|
|
result = *this\iEV\Next(1, *retVar, 0)
|
||
|
|
If result <> #S_OK ;Alternative is #S_FALSE.
|
||
|
|
FreeMemory(*retVar)
|
||
|
|
*retVar = 0
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
;Set any error code. iDispatch errors will alreay have been set.
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this\parent, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn *retVar
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method Resets the enumeration back to the beginning.
|
||
|
|
;Returns a HRESULT value. #S_OK for no errors.
|
||
|
|
Procedure.i COMateEnumClass_Reset(*this._membersCOMateEnumClass)
|
||
|
|
Protected result.i
|
||
|
|
If *this\iEV ;Just in case.
|
||
|
|
;Reset underlying IEnumVARIANT object.
|
||
|
|
result = *this\iEV\Reset()
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(*this\parent, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following method releases a com object created by any of the functions which return object pointers.
|
||
|
|
Procedure COMateEnumClass_Release(*this._membersCOMateEnumClass)
|
||
|
|
If *this\iEV ;Just in case.
|
||
|
|
;Release underlying IEnumVARIANT object.
|
||
|
|
*this\iEV\Release()
|
||
|
|
EndIf
|
||
|
|
;Free object.
|
||
|
|
FreeMemory(*this)
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;-=======================
|
||
|
|
;-COM (ActiveX) REGISTRATION FUNCTIONS.
|
||
|
|
;-=======================
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function allows the user to register a COM server for the duration of an application's run etc.
|
||
|
|
;Returns a HRESULT value. #S_OK for no errors.
|
||
|
|
Procedure.i COMate_RegisterCOMServer(dllName$, blnInitCOM = #True)
|
||
|
|
Protected result.i = #S_OK, lib.i, fn.i
|
||
|
|
If blnInitCOM
|
||
|
|
CoInitialize_(0)
|
||
|
|
EndIf
|
||
|
|
If FileSize(dllName$) > 0
|
||
|
|
lib = OpenLibrary(#PB_Any, dllName$)
|
||
|
|
If lib
|
||
|
|
fn = GetFunction(lib, "DllRegisterServer")
|
||
|
|
If fn
|
||
|
|
result = CallFunctionFast(fn)
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CloseLibrary(lib)
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(0, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function allows the user to unregister a COM server after registering it with COMate_RegisterActiveXServer().
|
||
|
|
;Returns a HRESULT value. #S_OK for no errors.
|
||
|
|
Procedure.i COMate_UnRegisterCOMServer(dllName$, blnInitCOM = #True)
|
||
|
|
Protected result.i = #S_OK, lib.i, fn.i
|
||
|
|
If blnInitCOM
|
||
|
|
CoInitialize_(0)
|
||
|
|
EndIf
|
||
|
|
If FileSize(dllName$) > 0
|
||
|
|
lib = OpenLibrary(#PB_Any, dllName$)
|
||
|
|
If lib
|
||
|
|
fn = GetFunction(lib, "DllUnregisterServer")
|
||
|
|
If fn
|
||
|
|
result = CallFunctionFast(fn)
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
CloseLibrary(lib)
|
||
|
|
Else
|
||
|
|
result = #E_FAIL
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(0, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;-=======================
|
||
|
|
;-MISCELLANEOUS FUNCTIONS.
|
||
|
|
;-=======================
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function searches the registry for the given textual representation of an interface IID and, if successful, copies the
|
||
|
|
;actual IID to the specified buffer.
|
||
|
|
;Returns a HRESULT.
|
||
|
|
Procedure.i COMate_GetIIDFromName(name$, *iid.IID)
|
||
|
|
Protected result = #E_FAIL, error, hKey1, hKey2, enumIndex, subKey, lpcbName = 256, cbData = 256, buffer
|
||
|
|
Protected bstr
|
||
|
|
If name$ And *iid
|
||
|
|
subKey = AllocateMemory(lpcbName)
|
||
|
|
If subKey
|
||
|
|
buffer = AllocateMemory(cbData)
|
||
|
|
If buffer
|
||
|
|
If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "Interface", 0, #KEY_READ, @hKey1) = #ERROR_SUCCESS And hKey1
|
||
|
|
enumIndex = 0
|
||
|
|
error = RegEnumKeyEx_(hKey1, enumIndex, subKey, @lpcbName, 0, 0, 0, 0)
|
||
|
|
While error = #ERROR_SUCCESS
|
||
|
|
If RegOpenKeyEx_(hKey1, subKey, 0, #KEY_READ, @hKey2) = #ERROR_SUCCESS And hKey2
|
||
|
|
cbData = 256
|
||
|
|
If RegQueryValueEx_(hKey2, "", 0, 0, buffer, @cbData) = #ERROR_SUCCESS
|
||
|
|
If PeekS(buffer) = name$ ;We have the correct entry.
|
||
|
|
;Attempt to create an IID from the string representation of the IID.
|
||
|
|
bstr = COMate_MakeBSTR(PeekS(subKey))
|
||
|
|
If bstr
|
||
|
|
result = CLSIDFromString_(bstr, *iid)
|
||
|
|
SysFreeString_(bstr)
|
||
|
|
Else
|
||
|
|
result = #E_OUTOFMEMORY
|
||
|
|
EndIf
|
||
|
|
Break
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
RegCloseKey_(hKey2)
|
||
|
|
EndIf
|
||
|
|
lpcbName = 256
|
||
|
|
enumIndex + 1
|
||
|
|
error = RegEnumKeyEx_(hKey1, enumIndex, subKey, @lpcbName, 0, 0, 0, 0)
|
||
|
|
Wend
|
||
|
|
RegCloseKey_(hKey1)
|
||
|
|
EndIf
|
||
|
|
FreeMemory(buffer)
|
||
|
|
EndIf
|
||
|
|
FreeMemory(subKey)
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
result = #E_INVALIDARG
|
||
|
|
EndIf
|
||
|
|
CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
|
||
|
|
COMateClass_INTERNAL_SetError(0, result)
|
||
|
|
CompilerEndIf
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;-=======================
|
||
|
|
;-ERROR RETRIEVAL FUNCTIONS.
|
||
|
|
;-=======================
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function returns the last error HRESULT code recorded by COMate against the underlying thread.
|
||
|
|
;This is completely threadsafe in that 2 threads using the same COMate object will not overwrite each other's errors.
|
||
|
|
Procedure.i COMate_GetLastErrorCode()
|
||
|
|
Protected *error._COMateThreadErrors
|
||
|
|
If COMate_gErrorTLS And COMate_gErrorTLS <> -1
|
||
|
|
*error = TlsGetValue_(COMate_gErrorTLS)
|
||
|
|
If *error
|
||
|
|
ProcedureReturn *error\lastErrorCode
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
;=================================================================================
|
||
|
|
;The following function returns a description of the last error recorded by COMate against the underlying thread.
|
||
|
|
;This is completely threadsafe in that 2 threads using the same COMate object will not overwrite each other's errors.
|
||
|
|
Procedure.s COMate_GetLastErrorDescription()
|
||
|
|
Protected *error._COMateThreadErrors
|
||
|
|
If COMate_gErrorTLS And COMate_gErrorTLS <> -1
|
||
|
|
*error = TlsGetValue_(COMate_gErrorTLS)
|
||
|
|
If *error
|
||
|
|
ProcedureReturn *error\lastError$
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
EndProcedure
|
||
|
|
;=================================================================================
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
;-=======================
|
||
|
|
;-UTILITY FUNCTIONS.
|
||
|
|
;-=======================
|
||
|
|
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
;The following function converts a string (Ascii or Unicode) to an OLE string.
|
||
|
|
;We access this through a prototype.
|
||
|
|
Procedure.i COMateClass_UTILITY_MakeBSTR(value)
|
||
|
|
Protected result.i
|
||
|
|
result = SysAllocString_(value)
|
||
|
|
ProcedureReturn result
|
||
|
|
EndProcedure
|
||
|
|
;/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
|
||
|
|
DataSection
|
||
|
|
|
||
|
|
VTable_COMateClass:
|
||
|
|
Data.i @COMateClass_Invoke()
|
||
|
|
Data.i @COMateClass_Release()
|
||
|
|
Data.i @COMateClass_CreateEnumeration()
|
||
|
|
Data.i @COMateClass_GetCOMObject()
|
||
|
|
Data.i @COMateClass_GetContainerhWnd()
|
||
|
|
Data.i @COMateClass_SetDesignTimeMode()
|
||
|
|
Data.i @COMateClass_GetDateProperty()
|
||
|
|
Data.i @COMateClass_GetIntegerProperty()
|
||
|
|
Data.i @COMateClass_GetObjectProperty()
|
||
|
|
Data.i @COMateClass_GetRealProperty()
|
||
|
|
Data.i @COMateClass_GetStringProperty()
|
||
|
|
Data.i @COMateClass_GetVariantProperty()
|
||
|
|
Data.i @COMateClass_SetProperty()
|
||
|
|
Data.i @COMateClass_SetPropertyRef()
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
Data.i @COMateClass_SetEventHandler()
|
||
|
|
Data.i @COMateClass_GetIntegerEventParam()
|
||
|
|
Data.i @COMateClass_GetObjectEventParam()
|
||
|
|
Data.i @COMateClass_GetRealEventParam()
|
||
|
|
Data.i @COMateClass_GetStringEventParam()
|
||
|
|
Data.i @COMateClass_IsEventParamPassedByRef()
|
||
|
|
CompilerEndIf
|
||
|
|
VTable_COMateEnumClass:
|
||
|
|
Data.i @COMateEnumClass_GetNextObject()
|
||
|
|
Data.i @COMateEnumClass_GetNextVariant()
|
||
|
|
Data.i @COMateEnumClass_Reset()
|
||
|
|
Data.i @COMateEnumClass_Release()
|
||
|
|
|
||
|
|
CompilerIf Defined(COMATE_NOINCLUDEATL, #PB_Constant)=0
|
||
|
|
VTable_COMateEventSink:
|
||
|
|
Data.i @COMateSinkClass_QueryInterface()
|
||
|
|
Data.i @COMateSinkClass_AddRef()
|
||
|
|
Data.i @COMateSinkClass_Release()
|
||
|
|
Data.i @COMateSinkClass_GetTypeInfoCount()
|
||
|
|
Data.i @COMateSinkClass_GetTypeInfo()
|
||
|
|
Data.i @COMateSinkClass_GetIDsOfNames()
|
||
|
|
Data.i @COMateSinkClass_Invoke()
|
||
|
|
CompilerEndIf
|
||
|
|
|
||
|
|
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_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_IClassFactory: ; {00000001-0000-0000-C000-000000000046}
|
||
|
|
Data.l $00000001
|
||
|
|
Data.w $0000, $0000
|
||
|
|
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
|
||
|
|
|
||
|
|
IID_IPersistFile: ; {0000010B-0000-0000-C000-000000000046}
|
||
|
|
Data.l $0000010B
|
||
|
|
Data.w $0000, $0000
|
||
|
|
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
|
||
|
|
|
||
|
|
IID_IEnumVARIANT: ; {00020404-0000-0000-C000-000000000046}
|
||
|
|
Data.l $00020404
|
||
|
|
Data.w $0000, $0000
|
||
|
|
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
|
||
|
|
|
||
|
|
IID_IConnectionPointContainer: ; {B196B284-BAB4-101A-B69C-00AA00341D07}
|
||
|
|
Data.l $B196B284
|
||
|
|
Data.w $BAB4, $101A
|
||
|
|
Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07
|
||
|
|
|
||
|
|
IID_IAxWinAmbientDispatch: ; {B6EA2051-048A-11D1-82B9-00C04FB9942E}
|
||
|
|
Data.l $B6EA2051
|
||
|
|
Data.w $048A, $11D1
|
||
|
|
Data.b $82, $B9, $00, $C0, $4F, $B9, $94, $2E
|
||
|
|
|
||
|
|
EndDataSection
|
||
|
|
|
||
|
|
CompilerEndIf
|
||
|
|
|
||
|
|
; IDE Options = PureBasic 5.70 LTS (Windows - x86)
|
||
|
|
; ExecutableFormat = Shared dll
|
||
|
|
; CursorPosition = 70
|
||
|
|
; FirstLine = 25
|
||
|
|
; Folding = ---------------------
|
||
|
|
; EnableThread
|
||
|
|
; Executable = nxReportU.dll
|
||
|
|
; CompileSourceDirectory
|
||
|
|
; EnableCompileCount = 0
|
||
|
|
; EnableBuildCount = 0
|
||
|
|
; EnableExeConstant
|
||
|
|
; EnableUnicode
|