Converting COM Object interface from C to Delphi

Question

I am trying to convert the following two interfaces from a C header file to a Delphi PAS unit but have run into strange problems when using the ones I did myself. I need help understanding how to implement these in Delphi.

Source interfaces from c header file:

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);
}

This is my "best effort" so far:

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;

Here is some sample code using the DirectShow filter and trying to use both the IModuleConfig and IParamConfig interfaces on that object:

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;

Using the debugger I can see that the sample code retrieves data both to the ParamName and Value variables, however, when I try include code to store them to the stringlist (SL) the call to EnumParams will always return S_FALSE (1) and not S_OK (0). If I comment out the line SL.Add(...) and RECOMPILE it will work again. If I include it again and RECOMPILE it won't. This leads me to believe that something is messing up the memory at some point due to my incorrect implementation of these interfaces, and the inclusion of the extra code makes it happen.

I am pretty sure that the types I have assigned to the variables are in some way the culprit of this, especially the second parameter to EnumParams which is supposed to return an array of GUID*. I am also very uncertain about the IParamConfig.EnumValidValues call which is also returning arrays of values.

I am using Delphi XE2.

Any help on this issue is greatly appreaciated.

Leaven

Answer 1

In order to answer this question definitively one would need to have the documentation of the interfaces. Just knowing their signatures is never enough information. Without that documentation we have to make educated guesses, and so here goes.

Let's focus first on EnumParams

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

Note that the pNumParams parameter is marked as being both [in] and [out]. The other parameter is an array of GUIDs. Most likely you are meant to pass the length of your array as input via the pNumParams parameter. This tells the function how many items it is safe for it to copy. If you pass in a value for pNumParams that is insufficient for the entire array then the function will indicate that in the return value. When the function returns it will set pNumParams to be the actual length of the array. Most likely you can call it passing 0 for pNumParams, NULL for pParamIDs and use that to determine the size of array actually needed. This is a very common pattern, but you will need to read the documentation to be sure.

Now, since you are not assigning to NumParams before calling EnumParams, you are passing a random value from the stack. The fact that changes to the code further down affect the way the call to EnumParams behaves strongly supports this hypothesis.

With your implementation, and assuming my guess is correct, you should set NumParams to 1025 before calling EnumParams. However, I would probably avoid using fixed size arrays and allocate dynamic arrays. You would need to change the definition of EnumParams to take a pointer to the first item. I'd do this for all the arrays in the interface.

Other than that I did notice that you had a couple of errors in IParamConfig. The GetVisible function should be like this:

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

And you will find GetParamID more convenient written this way:

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

Salisbarry

Thank you David! Using information from your post I did manage to correctly implement the interface. I do have the documentation for this object, but unfortunately it is copyrighted so I cannot post it here. – Leaven

Answer 2

For the record, this is the completed interface:

  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;

The following code shows how to call and use the interface and call 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;

If anyone spots any errors (I haven't tried all the functions yet), please comment on this post.

Leaven

This still suffers from the fundamental mistake I described in my answer. You need to initialize NumParams before you pass it in. And you didn't correct GetVisible. Also, var parameter is better for NumOfParams parameter than passing the pointer. – Salisbarry

Hi David, thanks for commenting again. I've updated my post to include your comments. I understand now why using var instead of passing the pointer is better. Thank you! – Leaven