Конвертиране на COM Object интерфейс от 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, така и за стойността, но когато се опитам да включа код, за да ги съхраня в списъка с низове (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