Conversión de la interfaz de objeto COM de C a Delphi

header translation

Question

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

Interfaces de origen desde el 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);
}

Este es mi "mejor esfuerzo" hasta ahora:

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 algunos ejemplos de código que usan el filtro DirectShow e intentan usar las interfaces IModuleConfig e IParamConfig en 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;

Usando el depurador puedo ver que el código de muestra recupera datos tanto para ParamName como para las variables de valor, 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 el registro, esta es la interfaz completa:

  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 (aún no he probado todas las funciones), coméntelo en esta publicación.

Answer 2

Para responder a esta pregunta definitivamente, uno necesitaría 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.

Centrémonos primero en EnumParams

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

Tenga en cuenta que el parámetro pNumParams está marcado como ambos [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 pNumParams un valor para pNumParams que es insuficiente para toda la matriz, la función lo indicará en el valor de retorno. Cuando la función retorna, establecerá que pNumParams sea ​​la longitud real de la matriz. Lo más probable es que pueda llamarlo pasando 0 para pNumParams , NULL para pParamIDs y usarlo 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 NumParams antes de llamar a 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 esta hipótesis.

Con su implementación, y suponiendo que mi suposición es correcta, debe establecer NumParams en 1025 antes de llamar a EnumParams . Sin embargo, probablemente evitaría usar matrices de tamaño fijo y asignar matrices dinámicas. EnumParams 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, noté 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 escrito de esta manera:

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