User Question: Native and Managed Interop

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