Convert COM object interface from C to Delphi

I am trying to convert the following two interfaces from a C header file to a Delphi PAS block, but run into strange problems when using the ones I made myself. I need to help understand how to implement them in Delphi.

Source interfaces from header file 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); } 

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 sample code using the DirectShow filter and trying to use the IModuleConfig and IParamConfig interfaces for this 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 see that the sample code retrieves the data for both ParamName variables and Value, however, when I try to include the code for storing them in a string list (SL), calling EnumParams will always return S_FALSE (1) and not S_OK (0). If I comment on the line SL.Add (...) and RECOMPILE, it will work again. If I turn it on again, but RECOMPILE does not. This makes me think that at some point something messed up the memory due to the incorrect implementation of these interfaces, and the inclusion of additional code does this.

I am sure that the types that I assigned to the variables are somehow to blame for this, especially the second parameter EnumParams, which should return an array of GUID *. I also very much doubt calling IParamConfig.EnumValidValues, which also returns arrays of values.

I am using Delphi XE2.

Any help on this issue is greatly facilitated.

+6
source share
2 answers

To finally answer this question, you must have documentation of the interfaces. Just knowing their signatures is not enough information. Without this documentation, we must make reasonable guesses, and so here it goes.

EnumParams on EnumParams

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

Note that the pNumParams parameter pNumParams marked as [in] and [out] . Another parameter is a GUID array. Most likely, you have to pass the length of your array as an input signal by using the pNumParams . This indicates how many elements it is safe to copy. If you pass in a value for pNumParams , which is not enough for the entire array, then the function will indicate that in the return value. When the function returns, pNumParams will be set pNumParams actual length of the array. Most likely, you can call it passing 0 for pNumParams , NULL for pParamIDs and use this to determine the size of the required array. This is a very common model, but you should definitely read the documentation.

Now, since you are not assigning NumParams before calling EnumParams , you are passing a random value from the stack. The fact that changes in the code further affects the way EnumParams calls EnumParams strongly supports this hypothesis.

With your implementation and assuming that my assumption 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 will need to change the definition of EnumParams to make a pointer to the first element. I would do this for all arrays in the interface.

In addition, I noticed that you had several errors in IParamConfig . The GetVisible function should be like this:

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

And you will find GetParamID more convenient to write as follows:

 function GetParamID(var pParamID: TGUID): HRESULT; stdcall; 
+2
source

For recording, this is a complete 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 someone sees any errors (I have not tried all the functions yet), comment on this post.

0
source

Source: https://habr.com/ru/post/911025/


All Articles