Llamar a idispatch directamente

Llamar a idispatch directamente

Llamar a idispatch directamente : Multi-millones de consejos para hacer su vida mas facil.

Como incorporar una simple capacidad de programacion en Delphi. Podria resultar util para llamar a un metodo, descrito como una cadena, en una interfaz, que se define por una cadena que contiene algo asi como 'MyLib.MyObject1'.
Esta unidad expone un par de funcion que puede llamada para acceder a la interfaz IDispatch mas facilmente.
& & & & & & & & & & & & & & & -
{////////////////////////////////////////////////////////////////
Nombre de la unidad: DispatchLib
Proposito de la unidad:
& nbsp & nbsp & nbsp & nbsp Expone la funcion de manipular los objetos COM que implementan
& nbsp & nbsp & nbsp & nbsp interfaz IDispatch.
& nbsp & nbsp & nbsp & nbsp puede llamar a los metodos o propiedades directamente o puede
& nbsp & nbsp & nbsp & nbsp lista de todas las funciones a un TStringList objeto.
& nbsp & nbsp & nbsp & nbsp Un ejemplo:
& nbsp & nbsp & nbsp & nbsp procedimiento fa(sl: TStringList)
& nbsp & nbsp & nbsp & nbsp var
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp: variante
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp s: cadena
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp r := CreateOLEObject('microsoft.msxml')
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp DocumentIDispatch(a, sl)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp ExecuteOnDispatchMultiParam(un, 'loadxml', ['b'])
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp s := ExecuteOnDispatchMultiParam(un, 'xml', [])
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp MessageDlg(s, mtInformation, [mbOk], 0)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp Codigo esta basado en una unidad que encontre en internet, pero contenia
& nbsp & nbsp & nbsp & nbsp algunos errores graves y no se admiten mas de un parametro.
Cualquier cosa inusual:
Codificado por: VJ
Fecha: 17.07.2001
historial de revisiones:
////////////////////////////////////////////////////////////////}

unidad de DispatchLib
interfaz
usos
& nbsp & nbsp ActiveX,
& nbsp & nbsp sysutils,
& nbsp & nbsp clases
tipo
& nbsp & nbsp exMethodNotSupported = clase(Excepcion)
& nbsp & nbsp exIDispatchCallError = clase(Excepcion)
funcion ExecuteOnDispatchMultiParam(TargetObj: IDispatch MethodName: string ParamValues: matriz de const): OleVariant
procedimiento DocumentIDispatch(ID: IDispatch var SL: TStringList)
procedimiento DocumentIDispatch2(ID: IDispatch var SLNames: TStringList)
funcion ElementDescriptionToString(a: TElemDesc): string
aplicacion

funcion ElementDescriptionToString(a: TElemDesc): string
begin
& nbsp & nbsp caso.tdesc.vt
& nbsp & nbsp & nbsp & nbsp VT_I4: Resultado: = int
& nbsp & nbsp & nbsp & nbsp VT_R8: Resultado := 'doble'
& nbsp & nbsp & nbsp & nbsp VT_BSTR: Resultado := 'cadena'
& nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp Resultado := '
& nbsp & nbsp final
fin
procedimiento DocumentIDispatch(ID: IDispatch var SL: TStringList)
var
& nbsp & nbsp res: HResult
& nbsp & nbsp Contar, bucle, loop2, loop3: integer
& nbsp & nbsp TI: ITypeinfo
& nbsp & nbsp pTA: PTypeAttr
& nbsp & nbsp pFD: PFuncDesc
& nbsp & nbsp varDesc: pVarDesc
& nbsp & nbsp numFunctions: integer
& nbsp & nbsp numParams: integer
& nbsp & nbsp funcDispID: integer
& nbsp & nbsp nombres: TBStrList
& nbsp & nbsp numReturned: integer
& nbsp & nbsp functionstr: widestring
& nbsp & nbsp ocultar: boolean
begin
& nbsp & nbsp assert(SL <> nil, 'SL no puede ser nulo')
& nbsp & nbsp SL.Claro
& nbsp & nbsp res := ID.GetTypeInfoCount(Recuento)
& nbsp & nbsp, si se tiene exito(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp bucle for := 0 to Count - 1 do begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp res := ID.GetTypeInfo(loop, 0, TI)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp, si se tiene exito(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp res := TI.GetTypeAttr(pTA)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp, si se tiene exito(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si la pTA^.typekind = TKIND_DISPATCH, a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp numFunctions := pTA^.cFuncs
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp para loop2 := 0 a numFunctions - 1 do begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp res := TI.GetFuncDesc(loop2, pFD)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp, si se tiene exito(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp funcDispID := pFD^.memid
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp numParams := pFD^.cParams
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp res := TI.GetNames(funcDispID, @nombres, numParams 1, numReturned)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp, si se tiene exito(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := '
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si numReturned > 0, entonces
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := functionstr nombres[0]
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si numReturned > 1, a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := functionStr '('
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp para loop3 := 1 a numReturned - 1 do begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si loop3 > 1 y
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := functionstr ', '
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr :=
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp nombres[loop3] ':'
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & n sp & nbsp ElementDescriptionToString(pFD^.lprgelemdescParam^[loop3 - 1])
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp //functionstr := functionstr nombres[numReturned - 1] ')'
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := functionstr ')'
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp ocultar := False
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp // Oculta el no envio de las funciones
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si (pFD^.wFuncFlags y FUNCFLAG_FRESTRICTED) = FUNCFLAG_FRESTRICTED, a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp ocultar := True
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp // Oculta las funciones que no tiene la intencion de secuencias de comandos: basicamente redundancia de funciones
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si (pFD^.wFuncFlags y FUNCFLAG_FHIDDEN) = FUNCFLAG_FHIDDEN, a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp ocultar := True
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si no ocultar, a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp SL.agregar(functionstr)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp TI.ReleaseFuncDesc(pFD)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp TI.ReleaseTypeAttr(pTA)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp final
& nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp elevar la Excepcion.Create('GetTypeInfoCount Error')
fin
procedimiento DocumentIDispatch2(ID: IDispatch var SLNames: TStringList)
var
& nbsp & nbsp res: HResult
& nbsp & nbsp Contar, bucle, loop2, loop3: integer
& nbsp & nbsp TI: ITypeinfo
& nbsp & nbsp pTA: PTypeAttr

& nbsp & nbsp pFD: PFuncDesc
& nbsp & nbsp varDesc: pVarDesc
& nbsp & nbsp numFunctions: integer
& nbsp & nbsp numParams: integer
& nbsp & nbsp funcDispID: integer
& nbsp & nbsp nombres: TBStrList
& nbsp & nbsp numReturned: integer
& nbsp & nbsp functionstr: widestring
& nbsp & nbsp ocultar: boolean
begin
& nbsp & nbsp SLNames.Claro
& nbsp & nbsp res := ID.GetTypeInfoCount(Recuento)
& nbsp & nbsp, si se tiene exito(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp bucle for := 0 to Count - 1 do begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp res := ID.GetTypeInfo(loop, 0, TI)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp, si se tiene exito(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp res := TI.GetTypeAttr(pTA)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp, si se tiene exito(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si la pTA^.typekind = TKIND_DISPATCH, a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp numFunctions := pTA^.cFuncs
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp para loop2 := 0 a numFunctions - 1 do begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp res := TI.GetFuncDesc(loop2, pFD)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si no logrado(res) a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp Continuar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp funcDispID := pFD^.memid
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp numParams := pFD^.cParams
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp res := TI.GetNames(funcDispID, @nombres, numParams 1, numReturned)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si no logrado(res), a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp TI.ReleaseFuncDesc(pFD)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp Continuar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp // Oculta el no envio de las funciones
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si (pFD^.wFuncFlags y FUNCFLAG_FRESTRICTED) = FUNCFLAG_FRESTRICTED, a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp Continuar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp // Oculta las funciones que no tiene la intencion de secuencias de comandos: basicamente redundancia de funciones
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si (pFD^.wFuncFlags y FUNCFLAG_FHIDDEN) = FUNCFLAG_FHIDDEN, a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp Continuar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := '
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si numReturned > 0 then begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := functionstr nombres[0]
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := functionstr '('
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si numReturned > 1, a continuacion, empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp para loop3 := 1 a numReturned - 1 do begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si loop3 > 1 y
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr := functionstr ','
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr :=
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp functionstr
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp ElementDescriptionToString(pFD^.lprgelemdescParam^[loop3 - 1])
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp SLNames.Agregar(functionstr ')')
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp TI.ReleaseFuncDesc(pFD)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp TI.ReleaseTypeAttr(pTA)
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp final
& nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp elevar la Excepcion.Create('GetTypeInfoCount Error')
fin
{////////////////////////////////////////////////////////////////
Nombre: ExecuteOnDispatchMultiParam
Proposito:
& nbsp & nbsp & nbsp & nbsp ejecutar metodo arbitrario sobre determinado objeto COM.
Autor: VJ
Fecha: 07.07.2001
Historia:
////////////////////////////////////////////////////////////////}
funcion ExecuteOnDispatchMultiParam(
& nbsp & nbsp TargetObj: IDispatch
& nbsp & nbsp MethodName: string
& nbsp & nbsp ParamValues: matriz de const): OleVariant
var
& nbsp & nbsp amplia: widestring
& nbsp & nbsp disps: TDispIDList
& nbsp & nbsp panswer: ^olevariant
& nbsp & nbsp respuesta: olevariant
& nbsp & nbsp dispParams: TDispParams
& nbsp & nbsp aexception: TExcepInfo
& nbsp & nbsp pVarArg: PVariantArgList
& nbsp & nbsp res: HResult
& nbsp & nbsp ParamCount, i: integer
begin
& nbsp & nbsp Resultado := false
& nbsp & nbsp // preparar para la llamada de funcion
& nbsp & nbsp ParamCount := Alto(ParamValues) 1
& nbsp & nbsp amplia := MethodName
& nbsp & nbsp pVarArg := nil
& nbsp & nbsp si ParamCount > 0, entonces
& nbsp & nbsp & nbsp & nbsp GetMem(pVarArg, ParamCount * sizeof(TVariantArg))
& nbsp & nbsp probar
& nbsp & nbsp & nbsp & nbsp // obtener dispid de solicitud del metodo
& nbsp & nbsp & nbsp & nbsp si no logrado(TargetObj.GetIDsOfNames(GUID_NULL, @amplia, 1, 0, @disps)) entonces
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp elevar exMethodNotSupported.Create('Este objeto no admite este metodo')
& nbsp & nbsp & nbsp & nbsp pAnswer := @respuesta
& nbsp & nbsp & nbsp & nbsp // preparar parametros
& nbsp & nbsp & nbsp & nbsp for i := 0 a ParamCount - 1 do begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp caso ParamValues[ParamCount - 1 - i].VType de
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp vtInteger: begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pVarArg^[i].vt := VT_I4
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pVarArg^[i].lVal := ParamValues[ParamCount - 1 - i].VInteger
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp vtExtended: begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pVarArg^[i].vt := VT_R8
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pVarArg^[i].dblVal := ParamValues[ParamCount - 1 - i].VExtended^
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp vtString, vtAnsiString, vtChar: begin
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pVarArg^[i].vt := VT_BSTR
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pVarArg^[i].bstrVal := PWideChar(WideString(PChar(ParamValues[ParamCount - 1 - i].VString)))
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp elevar la Excepcion.CreateFmt('Unsuported tipo de parametro con indice %d', [i])
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp & nbsp // preparar el despacho de los parametros
& nbsp & nbsp & nbsp & nbsp dispparams.rgvarg := pVarArg
& nbsp & nbsp & nbsp & nbsp dispparams.rgdispidNamedArgs := nil
& nbsp & nbsp & nbsp & nbsp dispparams.cArgs := ParamCount
& nbsp & nbsp & nbsp & nbsp dispparams.cNamedArgs := 0
& nbsp & nbsp & nbsp & nbsp // hacer llamada de IDispatch
& nbsp & nbsp & nbsp & nbsp res := TargetObj.Invoke(disps[0],
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp GUID_NULL, 0, DISPATCH_METHOD o DISPATCH_PROPERTYGET,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp dispParams, pAnswer, @aexception, nil)
& nbsp & nbsp & nbsp & nbsp // comprobar el resultado
& nbsp & nbsp & nbsp & nbsp si res <> 0 then
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp elevar exIDispatchCallError.CreateFmt(
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp 'llamada al Metodo fallado. %s (%s).',
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp [string(aexception.bstrdescription tal y), cadena(aexception.bstrSource)])
& nbsp & nbsp & nbsp & nbsp // devolver el resultado
& nbsp & nbsp & nbsp & nbsp Resultado := respuesta
& nbsp & nbsp finalmente
& nbsp & nbsp & nbsp & nbsp si ParamCount > 0, entonces
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp FreeMem(pVarArg, ParamCount * sizeof(TVariantArg))
& nbsp & nbsp final
fin

final.