Convirtiendo la interfaz de objeto COM de C a Delphi

Question

Estoy tratando de convertir las dos interfaces siguientes de un archivo de cabecera C a una unidad Delphi PAS, pero he tenido problemas extraños al usar las que yo mismo hice. Necesito ayuda para entender cómo implementar estos en Delphi.

interfaces de origen de archivo de cabecera C:

interface IParamConfig: IUnknown 
{   
    HRESULT SetValue([in] const VARIANT* pValue, [in] BOOL bSetAndCommit); 
    HRESULT GetValue([out] VARIANT* pValue, [in] BOOL bGetCommitted); 
    HRESULT SetVisible(BOOL bVisible); 
    HRESULT GetVisible(BOOL* bVisible); 
    HRESULT GetParamID(GUID* pParamID); 
    HRESULT GetName([out] BSTR* pName); 
    HRESULT GetReadOnly(BOOL* bReadOnly); 
    HRESULT GetFullInfo([out] VARIANT* pValue, [out] BSTR* pMeaning, [out] BSTR* pName, [out] BOOL* bReadOnly, [out] BOOL* pVisible); 
    HRESULT GetDefValue([out] VARIANT* pValue); 
    HRESULT GetValidRange([out] VARIANT* pMinValue, [out] VARIANT* pMaxValue, [out] VARIANT* pDelta); 
    HRESULT EnumValidValues([in][out] long* pNumValidValues, [in][out] VARIANT* pValidValues,[in][out] BSTR* pValueNames); 
    HRESULT ValueToMeaning([in] const VARIANT* pValue, [out] BSTR* pMeaning); 
    HRESULT MeaningToValue([in] const BSTR pMeaning, [out] VARIANT* pValue); 
} 

interface IModuleConfig: IPersistStream 
{ 
    HRESULT SetValue([in] const GUID* pParamID, [in] const VARIANT* pValue); 
    HRESULT GetValue([in] const GUID* pParamID, [out] VARIANT* pValue); 
    HRESULT GetParamConfig([in] const GUID* pParamID, [out] IParamConfig** pValue); 
    HRESULT IsSupported([in] const GUID* pParamID); 
    HRESULT SetDefState(); 
    HRESULT EnumParams([in][out] long* pNumParams, [in][out] GUID* pParamIDs); 
    HRESULT CommitChanges([out] VARIANT* pReason); 
    HRESULT DeclineChanges(); 
    HRESULT SaveToRegistry([in] HKEY hKeyRoot, [in] const BSTR pszKeyName, [in] const BOOL bPreferReadable); 
    HRESULT LoadFromRegistry([in] HKEY hKeyRoot, [in] const BSTR pszKeyName, [in] const BOOL bPreferReadable); 
    HRESULT RegisterForNotifies([in] IModuleCallback* pModuleCallback); 
    HRESULT UnregisterFromNotifies([in] IModuleCallback* pModuleCallback); 
} 

Ésta es mi "mejor esfuerzo" hasta el momento:

type 
    TWideStringArray = array[0..1024] of WideString; 
    TOleVariantArray = array[0..1024] of OleVariant; 
    TGUIDArray = array[0..1024] of TGUID; 

    IParamConfig = interface(IUnknown) 
    ['{486F726E-5043-49B9-8A0C-C22A2B0524E8}'] 
    function SetValue(const pValue: OleVariant; bSetAndCommit: BOOL): HRESULT; stdcall; 
    function GetValue(out pValue: OleVariant; bGetCommitted: BOOL): HRESULT; stdcall; 
    function SetVisible(bVisible: BOOL): HRESULT; stdcall; 
    function GetVisible(bVisible: BOOL): HRESULT; stdcall; 
    function GetParamID(pParamID: PGUID): HRESULT; stdcall; 
    function GetName(out pName: WideString): HRESULT; stdcall; 
    function GetReadOnly(bReadOnly: BOOL): HRESULT; stdcall; 
    function GetFullInfo(out pValue: OleVariant; out pMeaning: WideString; out pName: WideString; out pReadOnly: BOOL; out pVisible: BOOL): HRESULT; stdcall; 
    function GetDefValue(out pValue: OleVariant): HRESULT; stdcall; 
    function GetValidRange(out pMinValue: OleVariant; out pMaxValue: OleVariant; out pDelta: OleVariant): HRESULT; stdcall; 
    function EnumValidValues(var pNumValidValues: Integer; var pValidValues: TOleVariantArray; var pValueNames: TWideStringArray): HRESULT; stdcall; 
    function ValueToMeading(const pValue: OleVariant; out pMeaning: WideString): HRESULT; stdcall; 
    function MeaningToValue(const pMeaning: WideString; out pValue: OleVariant): HRESULT; stdcall; 
    end; 

    IModuleConfig = interface(IPersistStream) 
    ['{486F726E-4D43-49B9-8A0C-C22A2B0524E8}'] 
    function SetValue(const pParamID: TGUID; const pValue: OleVariant): HRESULT; stdcall; 
    function GetValue(const pParamID: TGUID; out pValue: OleVariant): HRESULT; stdcall; 
    function GetParamConfig(const ParamID: TGUID; out pValue: IParamConfig): HRESULT; stdcall; 
    function IsSupported(const pParamID: TGUID): HRESULT; stdcall; 
    function SetDefState: HRESULT; stdcall; 
    function EnumParams(var pNumParams: Integer; var pParamIDs: TGUIDArray): HRESULT; stdcall; 
    function CommitChanges(out pReason: OleVariant): HRESULT; stdcall; 
    function DeclineChanges: HRESULT; stdcall; 
    function SaveToRegistry(hKeyRoot: HKEY; const pszKeyName: WideString; const bPreferReadable: BOOL): HRESULT; stdcall; 
    function LoadFromRegistry(hKeyRoot: HKEY; const pszKeyName: WideString; const bPreferReadable: BOOL): HRESULT; stdcall; 
    function RegisterForNotifies(pModuleCallback: IModuleCallback): HRESULT; stdcall; 
    function UnregisterFromNotifies(pModuleCallback: IModuleCallback): HRESULT; stdcall; 
    end; 

Aquí hay un código de ejemplo utilizando el filtro DirectShow y tratando de utilizar tanto el interfaces de IModuleConfig y IParamConfig sobre ese objeto:

procedure TForm10.Button1Click(Sender: TObject); 
const 
    CLSID_VideoDecoder: TGUID = '{C274FA78-1F05-4EBB-85A7-F89363B9B3EA}'; 
var 
    HR: HRESULT; 
    Intf: IUnknown; 
    NumParams: Long; 
    I: Integer; 
    ParamConfig: IParamConfig; 
    ParamName: WideString; 
    Value: OleVariant; 
    ValAsString: String; 
    Params: TGUIDArray; 
begin 
    CoInitializeEx(nil, COINIT_MULTITHREADED); 
    try 
    HR := CoCreateInstance(CLSID_VideoDecoder, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IUnknown, Intf); 
    if Succeeded(HR) then 
    begin 
     FVideoDecoder := Intf as IBaseFilter; 

     if Supports(FVideoDecoder, IID_IModuleConfig) then 
     begin 
     HR := (FVideoDecoder as IModuleConfig).EnumParams(NumParams, Params); 
     if HR = S_OK then 
     begin 
      for I := 0 to NumParams - 1 do 
      begin 
      HR := (FVideoDecoder as IModuleConfig).GetParamConfig(Params[I], ParamConfig); 
      if HR = S_OK then 
      begin 
       try 
       ParamConfig.GetName(ParamName); 
       ParamConfig.GetValue(Value, True); 
       try 
        ValAsString := VarToStrDef(Value, 'Error'); 
        SL.Add(String(ParamName) + '=' + String(ValAsString)); // <-- ADDING THIS LINE WILL ALWAYS MAKE EnumParams call return S_FALSE = 1 
       except 
       end; 
       finally 
       ParamConfig := nil; 
       end; 
      end; 
      end; 
     end; 
     end; 
    end; 
    finally 
    CoUninitialize; 
    end; 
end; 

utilizando el depurador I puede ver que el código de muestra recupera datos de las variables ParamName y Value, sin embargo, cuando intento incluir código para almacenarlos en la lista de cadenas (SL), la llamada a EnumParams siempre devolverá S_FALSE (1) y no S_OK (0). Si comento la línea SL.Add (...) y RECOMPILE, funcionará nuevamente. Si lo vuelvo a incluir y RECOMPLE no lo hará. Esto me lleva a creer que algo está estropeando la memoria en algún momento debido a mi implementación incorrecta de estas interfaces, y la inclusión del código adicional lo hace posible.

Estoy bastante seguro de que los tipos que he asignado a las variables son de alguna manera el culpable de esto, especialmente el segundo parámetro para EnumParams que se supone que devuelve una matriz de GUID *. También estoy muy inseguro sobre la llamada IParamConfig.EnumValidValues, que también devuelve matrices de valores.

Estoy usando Delphi XE2.

Cualquier ayuda sobre este tema es muy apreciada.

Answer 1

Para poder responder a esta pregunta definitivamente, es necesario tener la documentación de las interfaces. Simplemente conocer sus firmas nunca es suficiente información. Sin esa documentación tenemos que hacer suposiciones educadas, y así sucesivamente. enfoque

Vamos primero en EnumParams

HRESULT EnumParams([in][out] long* pNumParams, [in][out] GUID* pParamIDs); 

Tenga en cuenta que el parámetro pNumParams se marca como siendo a la vez [in] y [out]. El otro parámetro es una matriz de GUID. Lo más probable es que esté destinado a pasar la longitud de su matriz como entrada a través del parámetro pNumParams. Esto le dice a la función cuántos elementos es seguro para copiar. Si transfiere un valor para pNumParams que no es suficiente para toda la matriz, la función lo indicará en el valor de retorno. Cuando la función retorna establecerá pNumParams para que sea la longitud real de la matriz. Lo más probable es que pueda llamarlo pasando 0 por pNumParams, NULL por pParamIDs y use eso para determinar el tamaño de la matriz realmente necesaria. Este es un patrón muy común, pero deberá leer la documentación para estar seguro.

Ahora, dado que no está asignando a NumParams antes de llamar al EnumParams, está pasando un valor aleatorio de la pila. El hecho de que los cambios en el código afecten aún más la forma en que se comporta la llamada a EnumParams respalda firmemente esta hipótesis.

Con su implementación, y suponiendo que mi suposición es correcta, debe establecer NumParams en 1025 antes de llamar al EnumParams. Sin embargo, probablemente evitaría usar matrices de tamaño fijo y asignar matrices dinámicas. Debería cambiar la definición de EnumParams para tomar un puntero al primer elemento. Haría esto para todas las matrices en la interfaz.

Aparte de eso me di cuenta de que tenía un par de errores en IParamConfig. La función GetVisible debería ser así:

function GetVisible(var bVisible: BOOL): HRESULT; stdcall; 

Y encontrará GetParamID más conveniente por escrito de esta manera:

function GetParamID(var pParamID: TGUID): HRESULT; stdcall; 

Answer 2

Para el registro, esta es la interfaz completado:

IParamConfig = interface(IUnknown) 
    ['{486F726E-5043-49B9-8A0C-C22A2B0524E8}'] 
    function SetValue(const pValue: OleVariant; bSetAndCommit: BOOL): HRESULT; stdcall; 
    function GetValue(out pValue: OleVariant; bGetCommitted: BOOL): HRESULT; stdcall; 
    function SetVisible(bVisible: BOOL): HRESULT; stdcall; 
    function GetVisible(var bVisible: BOOL): HRESULT; stdcall; 
    function GetParamID(out pParamID: TGUID): HRESULT; stdcall; 
    function GetName(out pName: WideString): HRESULT; stdcall; 
    function GetReadOnly(bReadOnly: BOOL): HRESULT; stdcall; 
    function GetFullInfo(out pValue: OleVariant; out pMeaning: WideString; out pName: WideString; out pReadOnly: BOOL; out pVisible: BOOL): HRESULT; stdcall; 
    function GetDefValue(out pValue: OleVariant): HRESULT; stdcall; 
    function GetValidRange(out pMinValue: OleVariant; out pMaxValue: OleVariant; out pDelta: OleVariant): HRESULT; stdcall; 
    function EnumValidValues(pNumValidValues: PInteger; pValidValues: POleVariant; pValueNames: PWideString): HRESULT; stdcall; 
    function ValueToMeaning(const pValue: OleVariant; out pMeaning: WideString): HRESULT; stdcall; 
    function MeaningToValue(const pMeaning: WideString; out pValue: OleVariant): HRESULT; stdcall; 
    end; 

    IModuleConfig = interface(IPersistStream) 
    ['{486F726E-4D43-49B9-8A0C-C22A2B0524E8}'] 
    function SetValue(const pParamID: TGUID; const pValue: OleVariant): HRESULT; stdcall; 
    function GetValue(const pParamID: TGUID; out pValue: OleVariant): HRESULT; stdcall; 
    function GetParamConfig(const ParamID: TGUID; out pValue: IParamConfig): HRESULT; stdcall; 
    function IsSupported(const pParamID: TGUID): HRESULT; stdcall; 
    function SetDefState: HRESULT; stdcall; 
    function EnumParams(var pNumParams: Integer; pParamIDs: PGUID): HRESULT; stdcall; 
    function CommitChanges(out pReason: OleVariant): HRESULT; stdcall; 
    function DeclineChanges: HRESULT; stdcall; 
    function SaveToRegistry(hKeyRoot: HKEY; const pszKeyName: WideString; const bPreferReadable: BOOL): HRESULT; stdcall; 
    function LoadFromRegistry(hKeyRoot: HKEY; const pszKeyName: WideString; const bPreferReadable: BOOL): HRESULT; stdcall; 
    function RegisterForNotifies(pModuleCallback: IModuleCallback): HRESULT; stdcall; 
    function UnregisterFromNotifies(pModuleCallback: IModuleCallback): HRESULT; stdcall; 
    end; 

El siguiente código muestra cómo llamar y usar la interfaz y llamar a EnumParams:

procedure TForm10.ListAllParameters(Sender: TObject); 
const 
    CLSID_VideoDecoder: TGUID = '{C274FA78-1F05-4EBB-85A7-F89363B9B3EA}'; 
var 
    HR: HRESULT; 
    Intf: IUnknown; 
    ModuleConfig: IModuleConfig; 
    ParamConfig: IParamConfig; 
    NumParams: Integer; 
    ParamGUIDS: array of TGUID; 
    GUID: TGUID; 
begin 
    HR := CoCreateInstance(CLSID_VideoDecoder, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IUnknown, Intf); 
    try 
    if not Succeeded(HR) then Exit; 

    if Supports(Intf, IID_IModuleConfig) then ModuleConfig := (Intf as IModuleConfig) else Exit; 

    // Get number of parameters 
    NumParams := 0; 
    HR := ModuleConfig.EnumParams(NumParams, nil); 
    if HR = S_FALSE then 
    begin 
     // Set the lenght of the array of TGUIDS to match the number of parameters 
     SetLength(ParamGUIDS, NumParams); 
     // Use a pointer to the first TGUID of the array as the parameter to EnumParams 
     HR := ModuleConfig.EnumParams(NumParams, @ParamGUIDS[0]); 
     if HR = S_OK then 
     begin 
     for GUID in ParamGUIDS do Memo1.Lines.Add(GUIDToString(GUID)); 
     end else Exit; 
    end else Exit; 
    finally 
    ModuleConfig := nil; 
    Intf := nil; 
    end; 
end; 

Si alguien detecta algún error (todavía no he probado todas las funciones), coméntelo en esta publicación.