Преобразование интерфейса COM-объекта из C в Delphi

Я пытаюсь преобразовать следующие два интерфейса из заголовочного файла C в модуль Delphi PAS, но столкнулся со странными проблемами при использовании тех, которые я сделал сам. Мне нужна помощь в понимании того, как реализовать это в Delphi.

Исходные интерфейсы из заголовочного файла 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);
}

Это мое "лучшее усилие" до сих пор:

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;

Вот пример кода, использующего фильтр DirectShow и пытающегося использовать интерфейсы IModuleConfig и IParamConfig для этого объекта:

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;

Используя отладчик, я вижу, что пример кода извлекает данные как в переменные ParamName, так и в переменные Value, однако, когда я пытаюсь включить код для их сохранения в список строк (SL), вызов EnumParams всегда будет возвращать S_FALSE (1), а не S_OK (0). Если я закомментирую строку SL.Add(...) и RECOMPILE, она снова заработает. Если я снова включу его и перекомпилирую, этого не произойдет. Это наводит меня на мысль, что в какой-то момент что-то портит память из-за моей неправильной реализации этих интерфейсов, и включение дополнительного кода делает это возможным.

Я почти уверен, что типы, которые я присвоил переменным, в некотором роде виноваты в этом, особенно второй параметр EnumParams, который должен возвращать массив GUID*. Я также очень не уверен в вызове IParamConfig.EnumValidValues, который также возвращает массивы значений.

Я использую Delphi XE2.

Любая помощь по этому вопросу очень приветствуется.


person TomRay74    schedule 18.03.2012    source источник


Ответы (2)


Чтобы окончательно ответить на этот вопрос, необходимо иметь документацию по интерфейсам. Одного знания их подписей никогда не бывает достаточно. Без этой документации нам приходится делать обоснованные предположения, и так далее.

Сначала сосредоточимся на EnumParams

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

Обратите внимание, что параметр pNumParams помечен как [in], так и [out]. Другой параметр — это массив идентификаторов GUID. Скорее всего, вы должны передать длину вашего массива в качестве входных данных через параметр pNumParams. Это сообщает функции, сколько элементов безопасно копировать. Если вы передадите значение для pNumParams, которого недостаточно для всего массива, функция укажет это в возвращаемом значении. Когда функция вернется, она установит pNumParams фактическую длину массива. Скорее всего, вы можете назвать это передачей 0 для pNumParams, NULL для pParamIDs и использовать это для определения действительно необходимого размера массива. Это очень распространенный шаблон, но вам нужно прочитать документацию, чтобы быть уверенным.

Теперь, поскольку вы не присваиваете NumParams перед вызовом EnumParams, вы передаете случайное значение из стека. Тот факт, что изменения в коде ниже влияют на то, как ведет себя вызов EnumParams, убедительно подтверждает эту гипотезу.

С вашей реализацией и при условии, что мое предположение верно, вы должны установить NumParams в 1025 перед вызовом EnumParams. Однако я бы, вероятно, избегал использования массивов фиксированного размера и выделял бы динамические массивы. Вам нужно будет изменить определение EnumParams, чтобы взять указатель на первый элемент. Я бы сделал это для всех массивов в интерфейсе.

Кроме этого, я заметил, что у вас есть пара ошибок в IParamConfig. Функция GetVisible должна быть такой:

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

И вам будет удобнее писать GetParamID так:

function GetParamID(var pParamID: TGUID): HRESULT; stdcall;
person David Heffernan    schedule 18.03.2012
comment
Спасибо, Дэвид! Используя информацию из вашего сообщения, мне удалось правильно реализовать интерфейс. У меня есть документация по этому объекту, но, к сожалению, она защищена авторским правом, поэтому я не могу разместить ее здесь. - person TomRay74; 18.03.2012

Для справки, это готовый интерфейс:

  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;

В следующем коде показано, как вызывать и использовать интерфейс и вызывать 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;

Если кто-то заметит какие-либо ошибки (я еще не пробовал все функции), пожалуйста, прокомментируйте этот пост.

person TomRay74    schedule 18.03.2012
comment
Это все еще страдает от фундаментальной ошибки, которую я описал в своем ответе. Вам нужно инициализировать NumParams, прежде чем передавать его. И вы не исправили GetVisible. Кроме того, параметр var лучше использовать для параметра NumOfParams, чем для передачи указателя. - person David Heffernan; 18.03.2012
comment
Привет Дэвид, спасибо за комментарий еще раз. Я обновил свой пост, чтобы включить ваши комментарии. Теперь я понимаю, почему лучше использовать var вместо передачи указателя. Благодарю вас! - person TomRay74; 19.03.2012