Since I get a lot of fan mail I figured it was time to start answering it.
"We've tried unmanaged exports before, but haven't had much luck passing or returning nontrivial types. I'd love to see some examples of this. For example, is it safe to call a .NET function that returns a string? Will memory management work correctly? Do I just need to declare the Win32 code to expect a WideString return, or is it more exotic than that?
I'd also be very interested to know if it's possible to pass interfaces from Win32 to a .NET function without using COM."
Here is an example of doing everything you asked; returning nontrivial types between managed and native code such as strings and interfaces without using any COM. We can talk about it in more detail because there are more things you need to know, but this will be a fairly long post so lets just look at the code. Note: I'm human just like all of you so there may be mistakes in the code especially since I whipped it up in under 10 minutes.
First create a Delphi for .NET project called Managed.dll. Here is the code that goes in Managed.dpr:
library Managed;
{$UNSAFECODE ON}
uses
System.Runtime.InteropServices,
ManagedUnit in 'ManagedUnit.pas';
[assembly: Guid('03664AA5-3EBF-4429-AFF9-584499520C68')]
[assembly: ComVisible(False)]
exports
Nothing, TakeString, ReturnString, TakeInterface, ReturnInterface;
end.
Then add a unit to Managed.dll and save it as ManagedUnit.pas. Here is the code that goes in ManagedUnit.pas:
unit ManagedUnit;
interface
uses
System.Runtime.InteropServices;
type
[ComVisible(True)]
ITakeInterface = interface
['{0E86E949-A124-451F-B42D-CA55B5AE7A14}']
function ReturnString: string;
end;
[ComVisible(True)]
IReturnInterface = interface
['{531C5CF4-5C2F-41D8-A5AF-C24D7868D282}']
function ReturnString: string;
end;
procedure Nothing;
procedure TakeString(Value: string);
function ReturnString: string;
procedure TakeInterface(const Value: ITakeInterface);
procedure ReturnInterface(var Value: IReturnInterface);
implementation
uses
Classes, SysUtils, ActiveX, Windows;
type
TDispatchObject = class(TInterfacedObject, IDispatch)
{ IDispatch }
[PreserveSig]
function GetTypeInfoCount(out Count: Integer): HResult;
[PreserveSig]
function GetTypeInfo(Index, LocaleID: Integer;
[MarshalAs(UnmanagedType.IUnknown)] out TypeInfo): HResult;
[PreserveSig]
function GetIDsOfNames([MarshalAs(UnmanagedType.LPStruct)] IID: TGUID;
[in] var Names: string; NameCount, LocaleID: Integer; out DispIDs: Integer): HResult;
[PreserveSig]
function Invoke(DispID: Integer; [MarshalAs(UnmanagedType.LPStruct)] IID: TGUID;
LocaleID: Integer; Flags: Word; var Params: TDispParams;
out VarResult; out ExcepInfo: TExcepInfo; ArgErr: IntPtr): HResult;
end;
TReturnInterface = class(TDispatchObject, IReturnInterface)
{ IReturnInterface }
function ReturnString: string;
end;
procedure Nothing;
begin
WriteLn('nothing');
end;
procedure TakeString(Value: string);
begin
WriteLn(Value);
end;
function ReturnString: string;
begin
Result := 'hello';
end;
procedure TakeInterface(const Value: ITakeInterface);
begin
WriteLn(Value.ReturnString);
end;
procedure ReturnInterface(var Value: IReturnInterface);
begin
Value := TReturnInterface.Create;
end;
{ TDispatchObject }
function TDispatchObject.GetIDsOfNames(IID: TGUID; var Names: string;
NameCount, LocaleID: Integer; out DispIDs: Integer): HResult;
begin
end;
function TDispatchObject.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
end;
function TDispatchObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
end;
function TDispatchObject.Invoke(DispID: Integer; IID: TGUID; LocaleID: Integer;
Flags: Word; var Params: TDispParams; out VarResult;
out ExcepInfo: TExcepInfo; ArgErr: IntPtr): HResult;
begin
end;
{ TReturnInterface }
function TReturnInterface.ReturnString: string;
begin
Result := 'hello';
end;
end.
Now create a Delphi for Win32 project called Native.dll. Add a unit to Native.dll and save it as NativeUnit.pas. Here is the code that goes in NativeUnit.pas:
unit NativeUnit;
interface
uses
Managed_TLB;
procedure Run;
implementation
uses
SysUtils, Math, ActiveX, Windows;
type
TNothingProc = procedure; stdcall;
TTakeStringProc = procedure(Value: PChar); stdcall;
TReturnStringProc = function: PChar; stdcall;
TTakeInterfaceProc = procedure(const Value: ITakeInterface); stdcall;
TReturnInterfaceProc = procedure(var Value: IReturnInterface); stdcall;
TTakeInterface = class(TInterfacedObject, IDispatch, ITakeInterface)
{ ITakeInterface }
function ReturnString: WideString; safecall;
{ IDispatch }
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
end;
var
SavedCW: Word;
Handle: THandle;
InternalNothing: TNothingProc;
InternalTakeString: TTakeStringProc;
InternalReturnString: TReturnStringProc;
InternalTakeInterface: TTakeInterfaceProc;
InternalReturnInterface: TReturnInterfaceProc;
procedure Nothing;
begin
SavedCW := Get8087CW;
Set8087CW($027f);
InternalNothing;
Set8087CW(SavedCW);
end;
procedure TakeString(Value: PChar);
begin
SavedCW := Get8087CW;
Set8087CW($027f);
InternalTakeString(Value);
Set8087CW(SavedCW);
end;
function ReturnString: PChar;
begin
SavedCW := Get8087CW;
Set8087CW($027f);
Result := InternalReturnString;
Set8087CW(SavedCW);
end;
procedure TakeInterface(const Value: ITakeInterface);
begin
SavedCW := Get8087CW;
Set8087CW($027f);
InternalTakeInterface(Value);
Set8087CW(SavedCW);
end;
procedure ReturnInterface(var Value: IReturnInterface);
begin
SavedCW := Get8087CW;
Set8087CW($027f);
InternalReturnInterface(Value);
Set8087CW(SavedCW);
end;
procedure Initialize;
begin
Handle := LoadLibrary(PChar('Managed.dll'));
@InternalNothing := GetProcAddress(Handle, 'Nothing');
@InternalTakeString := GetProcAddress(Handle, 'TakeString');
@InternalReturnString := GetProcAddress(Handle, 'ReturnString');
@InternalTakeInterface := GetProcAddress(Handle, 'TakeInterface');
@InternalReturnInterface := GetProcAddress(Handle, 'ReturnInterface');
end;
procedure Uninitialize;
begin
FreeLibrary(Handle);
end;
procedure Run;
var
R: IReturnInterface;
T: ITakeInterface;
begin
Initialize;
try
// Simple managed function call.
Nothing;
// Pass a string from native to managed.
TakeString('hello');
// Pass a string from managed to native.
WriteLn(ReturnString);
// Pass an object implementing an interface from native to managed.
T := TTakeInterface.Create;
TakeInterface(T);
// Pass an object implementing an interface from managed to native.
ReturnInterface(R);
if R <> nil then
WriteLn(R.ReturnString);
finally
Uninitialize;
end;
end;
{ TTakeInterface }
function TTakeInterface.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
end;
function TTakeInterface.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
end;
function TTakeInterface.GetTypeInfoCount(out Count: Integer): HResult;
begin
end;
function TTakeInterface.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
end;
function TTakeInterface.ReturnString: WideString;
begin
Result := 'hello';
end;
end.
At this point you will need to have built Managed.dll. Run "tlibimp -P+ Managed.dll" to generate Managed_TLB.pas. Add Managed_TLB.pas to Native.dll so now Native.dpr should look like this:
program Native;
{$APPTYPE CONSOLE}
uses
Managed_TLB in 'Managed_TLB.pas',
NativeUnit in 'NativeUnit.pas';
begin
Run;
end.
Last step is to run native.exe where you should see the following output:
nothing
hello
hello
hello
hello
