Tuesday, October 30, 2007

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

Thursday, October 25, 2007

Delphi Scoped Enums

Here is an example of using scoped enums. Scoped enums don't get added to the global namespace.

type
  TFoo = (A, B, Foo);
  {$SCOPEDENUMS ON}
  TBar = (A, B, Bar);
  {$SCOPEDENUMS OFF}

begin
  WriteLn(Integer(Foo)); 
  WriteLn(Integer(A)); // TFoo.A
  WriteLn(Integer(TBar.B));
  WriteLn(Integer(TBar.Bar));
  WriteLn(Integer(Bar)); // Error
end;

Friday, October 19, 2007

New Danny Thorpe Blog

Danny Thorpe's blog has has been jumping around the valley over the last couple of years and he has yet another blog that just went live. I believe this one will be his blog for some time given that his name is in the doman.

Wednesday, October 17, 2007

Delphi and C++Builder IDE Memory Usage Tip

Not only can you build .NET applications if you have the Delphi for .NET personality but the IDE uses .NET internally. If you have limited memory the .NET garbage collector might not collect the memory as often as you would like. You can force the .NET garbage collector to happen more frequently. Use Regedit and open the borland key and add a the "Globals" key if it doesn't already exist under BDS\x.0 (Example: BDS\5.0\Globals). Add a string value as follows:

CollectGarbageInterval = "300000"

This sets a timer to force garbage collection every 5 minutes (5 * 60 * 1000 = 300000).

Wednesday, October 3, 2007

Poll: How long have you used Delphi?

I haven't had much time lately to blog, but I figured I'd put a poll asking how long people have used Delphi. This poll will be up for the entire month of October so we can get as many people as possible to respond.

Update: If you have used Delphi for more than 5 years, and clearly a lot of you have, and you feel 5 years isn't even close to the amount of time you've used Delphi, then post a comment we'd all love to read it!

Tuesday, October 2, 2007

October Photo of the Month


Copyright © 2007 Chris Bensen. All rights reserved.


The new photo for this October is a photo I found in my archives and have spent the better part of a day stitching together from 8 photos. I took this photo on a trip to Yellowstone National Park in February 2006. Yes, that is the dead of winter. I snow shoed and snow mobile all around the wonderful outdoor amusement park for the better part of two weeks and enjoyed every minute of the -40 below storms to 20 above crystal clear sky. This photo was taken at sunset while a really big storm came in and we had over an hour to get back to the west entrance. Try snowmobiling through a herd of Bison that have made camp on the middle of the road in -30 below temperatures trying to not bump into the big furry beasts. It was a blast!

You can view more of my Yellowstone photos by clicking here.

Monday, October 1, 2007

Bad Variable Names

A few months back I posted about how to choose variable names. Since then I've had up on my white board, based on some real world variable names we've encountered, some sample bad variable names. It then morphed into visitors trying trying to come up with the worst variable name ever. The current rendition is:


if not IsNotCanNotUnDisable then
Result := not UnTrue;


What bad variable names have you encountered?