Преобразование интерфейса COM-объекта из C в Delphi - PullRequest
6 голосов
/ 18 марта 2012

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

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

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

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

Ответы [ 2 ]

2 голосов
/ 18 марта 2012

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

Давайте сначала сосредоточимся на 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;
0 голосов
/ 18 марта 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;

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

...