How to return WideString from COM server? - delphi

This Interface at _TLB.pas file
// *********************************************************************//
// Interface: ITMyCOM
// Flags: (256) OleAutomation
// GUID: {D94769D0-F4AF-41E9-9111-4D8BC2F42D69}
// *********************************************************************//
ITMyCOM = interface(IUnknown)
['{D94769D0-F4AF-41E9-9111-4D8BC2F42D69}']
function MyDrawWS(a: Integer; b: Integer): WideString; stdcall;
end;
This looks at OS Windows
[
odl,
uuid(D94769D0-F4AF-41E9-9111-4D8BC2F42D69),
version(1.0),
helpstring("Interface for TMyCOM Object"),
oleautomation
]
interface ITMyCOM : IUnknown {
BSTR _stdcall MyDrawWS(
[in] long a,
[in] long b);
};
Function in COM server looks as
function TTMyCOM.MyDrawWS(a, b: Integer): WideString;
begin
Result := WideString(IntToStr(a+b));
end;
In COM Client i`m calling this function like
Edit1.Text := String(MyCOM.MyDrawWS(1,1));
and get error First chance exception at $75A9FBAE. Exception class EAccessViolation with message 'Access violation at address 75A409A4 in module 'RPCRT4.dll'. Read of address FFFFFFF8'. Process Project1.exe (2296)
If i want returning Integer, it`s works. How to return WideString?

The correct way to handle this is as follows:
[
odl,
uuid(D94769D0-F4AF-41E9-9111-4D8BC2F42D69),
version(1.0),
helpstring("Interface for TMyCOM Object"),
oleautomation
]
interface ITMyCOM : IUnknown {
HRESULT _stdcall MyDrawWS(
[in] long a,
[in] long b,
[out, retval] BSTR* ret);
};
ITMyCOM = interface(IUnknown)
['{D94769D0-F4AF-41E9-9111-4D8BC2F42D69}']
function MyDrawWS(a: Integer; b: Integer; out ret: WideString): HResult; stdcall;
end;
function TTMyCOM.MyDrawWS(a, b: Integer; out ret: WideString): HRESULT;
begin
ret := IntToStr(a+b);
Result := S_OK;
end;
var
W: WideString;
begin
OleCheck(MyCOM.MyDrawWS(1, 1, W));
Edit1.Text := W;
end;
Which can then be simplified a little by using Delphi's safecall calling convention in the Delphi declaration (not in the TypeLibrary itself) of the interface:
ITMyCOM = interface(IUnknown)
['{D94769D0-F4AF-41E9-9111-4D8BC2F42D69}']
function MyDrawWS(a: Integer; b: Integer): WideString; safecall;
end;
function TTMyCOM.MyDrawWS(a, b: Integer): WideString;
begin
Result := IntToStr(a+b);
end;
Edit1.Text := MyCOM.MyDrawWS(1, 1);

Let Delphi perform the conversions automatically. Don't cast. You can cast a (ansi)string to a PChar, because their memory layout are compatible, but you can't cast a string to a widestring or viceversa. Delphi will perfrom conversion when you assign one to the other.
In Delphi < 2009
var
S: string;
W: WideString;
...
S := W; // Conversion, WideString -> AnsiString;
W := S; // Conversion, AnsiString -> WideString

Don't use return values other than HRESULT. Instead put your return value into parameter list as output parameter.
function MyDrawWS(a: Integer; b: Integer; out str : WideString): HRESULT; stdcall;
In this way, you are also forced to use COM memory manager IMalloc (CoTaskMemAlloc for pur COM, SysAllocString for Automation).

You need to use SysAllocString() or SysAllocStringLen() to allocate the BSTR.

First chance exception at $75A9FBAE. Exception class EAccessViolation with message 'Access violation at address 75A409A4 in module 'RPCRT4.dll'
the error is coming from RPCRT4.dll
EAccessViolation is mostly caused by accessing a null object, step through your code make sure all objects are valid objects.

Related

Creating and connecting DirectShow filter: how to implement CreateInstance()?

I want to write my own DirectShow filter to pull out packets of information for my own purposes. To do this, I used the guide to creating filters.
I did steps 1 to 5, and am stuck at step 6: failed to implement CreateInstance(). Can't instantiate the class because the MSDN example doesn't pass parameters, but code in Pascal requires (ObjectName: string; unk: IUnKnown; const clsid: TGUID). I used regsvr32, unfortunately I don’t know how to connect my DLL and I can’t think of it. The DSFMgr program also does not see my filter.
I read how filters are connected, tried to implement various searches, it's useless. Tried to connect manually via CLSID. Everything is useless. I know the answer is somewhere on the surface, but I don't see it. I can't figure out how DirectShow should see my library if it didn't exist in the first place. It's not logical. I've been trying to implement this for a very long time, but it doesn't work, I'm stuck.
Please don't recommend FFmpeg and the like. I don't want to use third party libraries. In DirectX, as far as I know it's built-in.
Step 6 example:
CUnknown * WINAPI CRleFilter::CreateInstance(LPUNKNOWN pUnk, HRESULT *pHr)
{
CRleFilter *pFilter = new CRleFilter();
if (pFilter== NULL)
{
*pHr = E_OUTOFMEMORY;
}
return pFilter;
}
I Implemented/converted it like this, but it doesn't work. Errors:
no variables sent
function TCRleFilter.CreateInstance(pUnk: PPUnknown; pHr: HRESULT): PUnknown;
var
pFilter: TCRleFilter;
begin
pFilter:= TCRleFilter.Create();
if pFilter = nil then pHr:= E_OUTOFMEMORY;
Result:= pFilter;
end;
I think at least a logical explanation should suffice.
The whole class:
unit Unit1;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, ActiveX, Classes, ComObj, DirectShow9, BaseClass, Dialogs;
type
TCRleFilter = class(TBCTransformFilter)
public
function CheckInputType(mtIn: PAMMediaType): HRESULT;
function GetMediaType (IPosition: Integer; pMediaType: PAMMediaType): HRESULT;
function CheckTransform(mtln: PAMMediaType; mt0ut: PAMMediaType): HRESULT;
function DecideBufferSize(pAlloc: IMemAllocator; pProp: PAllocatorProperties): HRESULT;
function Transform(pSource, pDest: IMediaSample): HRESULT;
function CreateInstance(pUnk: PPUnknown; pHr: HRESULT): PUnknown;
end;
const
CLSID_CRleFilter: TGUID = '{FBA9B97F-505B-49C7-A6C2-D1EFC34B2C0D}';
implementation
uses ComServ;
{ TCRleFilter }
function TCRleFilter.CheckInputType(mtIn: PAMMediaType): HRESULT;
begin
Result := S_OK;
ShowMessage('CheckInputType: âåðíóë "S_OK"');
end;
function TCRleFilter.CheckTransform(mtln, mt0ut: PAMMediaType): HRESULT;
begin
Result := S_OK;
ShowMessage('CheckTransform: âåðíóë "S_OK"');
end;
function TCRleFilter.CreateInstance(pUnk: PPUnknown;
pHr: HRESULT): PUnknown;
var
pFilter: TCRleFilter;
begin
try
pFilter:= TCRleFilter.Create('');
Result := pFilter;
except
pHr:= E_OUTOFMEMORY;
Result:= nil;
end;
end;
function TCRleFilter.DecideBufferSize(pAlloc: IMemAllocator; pProp: PAllocatorProperties): HRESULT;
begin
Result := S_OK;
ShowMessage('DecideBufferSize: âåðíóë "S_OK"');
end;
function TCRleFilter.GetMediaType(IPosition: Integer; pMediaType: PAMMediaType): HRESULT;
begin
Result := S_OK;
ShowMessage('GetMediaType: âåðíóë "S_OK"');
end;
function TCRleFilter.Transform(pSource, pDest: IMediaSample): HRESULT;
begin
Result := S_OK;
ShowMessage('Transform: âåðíóë "S_OK"');
end;
initialization
{.Create(ComServer, TCRleFilter, Class_CRleFilter, 'CRleFilter', 'CRle_Filter', ciMultiInstance, tmApartment); }
TBCClassFactory.CreateFilter(TCRleFilter,'CRle_Filter', CLSID_CRleFilter, CLSID_LegacyAmFilterCategory, MERIT_DO_NOT_USE, 0, nil );
end.
Your class inherites from TBCTransformFilter and the needed parameters are defined as:
constructor TBCTransformFilter.Create(ObjectName: string; unk: IUnKnown; const clsid: TGUID);
Untested, but it should be much more correct than your attempt:
function TCRleFilter.CreateInstance
( pUnk: IUnknown // LPUNKNOWN
; var pHr: HRESULT // Pointer to variable = VAR
): PUnknown; // Pointer
var
oFilter: TCRleFilter; // Object, not pointer
begin
try // Failing constructors throw exceptions
oFilter:= TCRleFilter.Create( 'my RLE encoder', pUnk, CLSID_CRleFilter );
result:= oFilter; // In doubt cast via "PUnknown(oFilter)"
except // Constructor failed, oFilter is undefined
pHr:= E_OUTOFMEMORY;
result:= nil;
end;
end;
The var parameter ensures that assigned values inside the function also live on outside the function - otherwise you'd only have a local variable. Which is also the point (haha) of pointers in C++ parameters.

Using interfaces to pass data from exe to dll in Delphi

I'm trying to pass an array of strings from host EXE to DLL in a loop. The host EXE is an external app which supports scripts (compiled and executed by a delphi-like compiler with certain limitations). The DLL is written by me in Delphi 2010.
So the problem is - I can't get rid of access violations when I pass a Widestring array to DLL. Whatever I tried - I got AVs sooner or later. And even if not, my statically loaded DLL was locked by host app, I can't rename or delete the DLL, so something is wrong.
There's an example of code which describes how to do it using interfaces (new for me which I liked a lot). Works like a charm and the DLL file is not locked.
General definitions (DLL + EXE)
type
// Your "structure"
TSomething = record
A: Integer;
S: WideString;
end;
// Your "structure list"
TSomethingArray = array of TSomething;
// The DLL and the EXE exchange data via Interface
IArray = interface
['{EE7F1553-D21F-4E0E-A9DA-C08B01011DBE}'] // press Ctrl+Shift+G to generate id
// protected
function GetCount: Integer; safecall;
function GetItem(const AIndex: Integer): TSomething; safecall;
// public
property Count: Integer read GetCount;
property Items[const AIndex: Integer]: TSomething read GetItem; default;
end;
DLL
// DLL, auxilary code:
type
// IArray implementation, which will be passed from DLL to EXE
TBaseArray = class(TInterfacedObject, IArray)
protected
FArray: TSomethingArray;
function GetCount: Integer; safecall;
function GetItem(const AIndex: Integer): TSomething; safecall;
end;
// Copying an array - for static and open arrays
TArray = class(TBaseArray)
public
constructor Create(const AArray: array of TSomething);
end;
// We don't have to copy an array for dynamic arrays
TArrayRef = class(TBaseArray)
public
constructor Create(const AArray: TSomethingArray);
end;
// We could create 1 class instead of 3 (TArray),
// but with 2 constructors (CreateByArr, CreateByDynArr).
// Or even with 1 constructor, if you work with 1 type of array.
// But it doesn't really matter, it's a matter of convenience.
// What really matters is a class which implements an interface.
{ TBaseArray }
function TBaseArray.GetCount: Integer;
begin
Result := Length(FArray);
end;
function TBaseArray.GetItem(const AIndex: Integer): TSomething;
begin
Result := FArray[AIndex];
end;
{ TArray }
constructor TArray.Create(const AArray: array of TSomething);
var
ArrIndex: Integer;
begin
inherited Create;
SetLength(FArray, Length(AArray));
for ArrIndex := 0 to High(AArray) do
FArray[ArrIndex] := AArray[ArrIndex];
end;
{ TArrayRef }
constructor TArrayRef.Create(const AArray: TSomethingArray);
begin
inherited Create;
FArray := AArray;
end;
// DLL, applied code:
function DoSomething1: IArray; stdcall;
var
A: array[0..2] of TSomething;
begin
// Some operations with array...
A[0].A := 1;
A[0].S := 'S1';
A[1].A := 2;
A[1].S := 'S2';
A[2].A := 3;
A[2].S := 'S3';
// Returning result
Result := TArray.Create(A); // <- An array is copied here
end;
function DoSomething2: IArray; stdcall;
var
A: TSomethingArray;
begin
// Some operations with array...
SetLength(A, 3);
A[0].A := 1;
A[0].S := 'S1';
A[1].A := 2;
A[1].S := 'S2';
A[2].A := 3;
A[2].S := 'S3';
// Returning result
Result := TArrayRef.Create(A); // An array isn't copied here, only reference counting
// We could also write:
// Result := TArray.Create(A);
// but the array would be copied in this case
end;
exports
DoSomething1, DoSomething2;
EXE
function DoSomething1: IArray; stdcall; external 'Project2.dll';
function DoSomething2: IArray; stdcall; external 'Project2.dll';
procedure TForm1.Button1Click(Sender: TObject);
var
A: IArray;
X: Integer;
begin
A := DoSomething1; // or DoSomething2
for X := 0 to A.Count - 1 do
OutputDebugString(PChar(IntToStr(A[X].A) + ' ' + A[X].S));
end;
This code works fine with my host app (when all OOP logic is in DLL). But I need the data to be passed from EXE to DLL.
So I swapped the code and the EXE became the 'heavier' part, everything was fine too, but only if both DLL and EXE are written in Delphi 2010.
If I use my host app and a static array, the compiler in my host app reports 'incompatible types' error at string in DoSomething1:
Result := TArray.Create(A);
When I write
Result := TArray.Create(A) as IArray;
it compiles but the app crashes.
If I use dynamic array, the compiler reports "Access violation at address 0D92062B. Read of address FFFFFFF8" here:
function TBaseArray.GetItem(const AIndex: Integer): TSomething;
begin
Result := FArray[AIndex];
end;
The author of this code said that if we want to pass data from EXE to DLL we need to use callbacks. And I just swapped the code. Maybe this is the problem? If so, how should I use callbacks here?

Casting in generic class to interface delphi

I'm getting a IEnumVariant from a .NET class library and I am trying to use a generic class to convert this to a IEnumerator
There is a compiler error, "Operator not applicable to this operand type" when attempting to cast an IInterface to the generic type T
I've seen workarounds when attempting to type cast to a class, but these don't work for an interface.
Using Supports as suggested by Rob seems to have problems as well as TypeInfo returns nil for the parameterized type.
uses WinApi.ActiveX, Generics.Collections;
type
TDotNetEnum<T: IInterface> = class(TInterfacedObject, IEnumerator<T>)
strict private
FDotNetEnum: IEnumVariant;
FCurrent: T;
function MoveNext: Boolean;
procedure Reset;
function GetCurrent: TObject;
function IEnumerator<T>.GetCurrent = GenericGetCurrent;
function GenericGetCurrent: T;
public
constructor Create(const ADotNetObject: OleVariant);
//// I can get it to work using this constructor
// constructor Create(const ADotNetObject: OleVariant; const AGUID: TGUID);
end;
implementation
uses System.Rtti, SysUtils, mscorlib_TLB, ComObj;
constructor TDotNetEnum<T>.Create(const ADotNetObject: OleVariant);
var
netEnum: IEnumerable;
begin
netEnum := IUnknown(ADotNetObject) as mscorlib_TLB.IEnumerable;
FDotNetEnum := netEnum.GetEnumerator();
end;
function TDotNetEnum<T>.GenericGetCurrent: T;
begin
result := FCurrent;
end;
function TDotNetEnum<T>.GetCurrent: TObject;
begin
result := nil;
end;
function TDotNetEnum<T>.MoveNext: Boolean;
var
rgvar: OleVariant;
fetched: Cardinal;
ti: TypeInfo;
guid: TGUID;
begin
OleCheck(FDotNetEnum.Next(1, rgvar, fetched));
result := fetched = 1;
if not result then
FCurrent := nil
else
begin
FCurrent := IUnknown(rgvar) as T; // <-- Compiler error here
//// Doesn't work using Supports either
// ti := TypeInfo(T); // <-- returns nil
// guid := GetTypeData(#ti)^.Guid;
// Supports(IUnknown(rgvar), guid, FCurrent);
end;
end;
procedure TDotNetEnum<T>.Reset;
begin
OleCheck(FDotNetEnum.Reset);
end;
Am I missing something in order to get that case to the generic interface type to work ?
I do have the alternative constructor which I CAN get the guid from so that
TDotNetEnum<IContact>.Create(vContactList, IContact);
works but the ideal
TDotNetEnum<IContact>.Create(vContactList);
doesn't
Using as to cast interfaces is only valid for interfaces that have GUIDs. The compiler cannot assume that T has a GUID when it's compiling your generic class, so it cannot accept an expression of the form val as T.
This has been covered before, but in reference to the Supports function, which has the same limitation as the as operator.
The solution is to use RTTI to fetch the interface's GUID, and then use that to type-cast the interface value. You could use Supports:
guid := GetTypeData(TypeInfo(T))^.Guid;
success := Supports(IUnknown(rgvar), guid, FCurrent);
Assert(success);
You could also call QueryInterface directly:
guid := GetTypeData(TypeInfo(T))^.Guid;
OleCheck(IUnknown(rgvar).QueryInterface(guid, FCurrent));

Passing String array Values from Java native interface to Delphi wrapper class

I am trying to pass the String array values from Java native interface to Delphi wrapper class.
But didn't getting any array values from JNI. How can declare Array String in Delphi Wrapper class.
How to convert JNI String array.
This is my Delphi wrapper class Code:
function Java_com_erm_controller_ARMReports_A3(PEnv: PJNIEnv; Obj: JObject;
ex_BSName_ALM: JStrings): Integer; stdcall; export;
var
objRpt: TARMReports;
begin
Result := objRpt.A3(aBSName_ALM);
JVM.Free;
objRpt.Free;
end;
Without knowing what JStrings is actually declared as (it is not defined in Delphi's JNI wrapper units), I can only guess that you need to do something like this:
function Java_com_erm_controller_ARMReports_A3(PEnv: PJNIEnv; Obj: JObject;
ex_BSName_ALM: JStrings): Integer; stdcall; export;
var
strs: array of String;
len, i: Integer;
el: JNIObject;
...
begin
...
len := PEnv.GetArrayLength(PEnv, ex_BSName_ALM);
SetLength(strs, len);
for i := 0 to len-1 do
begin
el := PEnv.GetObjectArrayElement(PEnv, ex_BSName_ALM, i);
strs[i] := JStringToString(JString(el));
end;
...
end;

Passing a parameter to CreateThread

I am having a problem passing a class reference as the parameter to the ThreadProc in a call to CreateThread. Here is a sample program that demonstrates the problem I am having:
program test;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Dialogs;
type
TBlah = class
public
fe: Integer;
end;
function ThreadProc(param: Pointer) : DWORD;
begin
ShowMessage(IntToStr(TBlah(param).fe));
Result := 0;
end;
var
tID: DWORD;
handle: THandle;
b: TBlah;
begin
b := TBlah.Create;
b.fe := 54;
handle := CreateThread(nil, 0, #ThreadProc, Pointer(b), 0, tID);
WaitForSingleObject(handle, INFINITE);
end.
The call to ShowMessage pops up a message box that has something like 245729105 in it, not 54 like I expect.
This is probably just a basic misunderstanding of how Delphi works, so could someone please tell me how to get this working properly?
The problem here is that your thread function has the wrong calling convention. You need to declare it with the stdcall convention:
function ThreadProc(param: Pointer) : DWORD; stdcall;
Having said that, it would be more idiomatic to just use a TThread descendant which handles the OOP to C function back to OOP transitioning for you. That would look like this:
type
TBlah = class(TThread)
protected
procedure Execute; override;
public
fe: Integer;
end;
procedure TBlah.Execute;
begin
ShowMessage(IntToStr(fe));
end;
var
b: TBlah;
begin
b := TBlah.Create(True);
b.fe := 42;
b.Start;
b.WaitFor;
end.
Incidentally, does anyone know why Windows.pas declares TFNThreadStartRoutine as TFarProc rather than a proper typed function pointer?
You're forgetting the stdcall directive.
function ThreadProc(param: Pointer) : DWORD; stdcall;
And don't use Pointer cast in:
handle := CreateThread(nil, 0, #ThreadProc, **Pointer**(b), 0, tID);
b is already a Pointer (a Class, which is an Object Pointer)

Resources