Wednesday, 2 June 2010

Sending objects between applications with Delphi 2007 and Delphi 2010

Nowadays we know how difficult it is to send objects between applications in an easy way. That's what I've been working the last days with the great idea of Omar who was designing the case test, trying to come up with a proper way of sending objects between applications in Delphi 2007 and Delphi 2010. The biggest problem here is data serialization, and that's because I've tried both Delphi's version using the JSON library to serialize data and the Clipboard object as an intermediate bridge component for applications.
I've tested different solutions like using Windows messages, SuperObject framework, Memory map files, etc., instead of using the Clipboard object, but none of them were suitable for me. Even the Clipboard isn't a good option but in the same application I can play a lot with it. The problem that we need to face up here is that if we want to send objects between applications we can't send the pointer of the object and wait for the second application to recover the information from it. What we need to do is serialize the object to a well-know format (String, Record, etc) and de-serialize the information to recover our object.
Why Have I used both Delphis? Because in Delphi 2010 we actually have the JSON library with us, and we don't have to install anything to marshall/unmarshall our classes.


Approximation with Delphi 2007:
For this example, we need to download the JSON Library (uLKJSON) and create a new class inherited from TlkJSONObject:

TmyObject = class(TlkJSONobject)
    private
        FDescription: AnsiString;
        FId: integer;
    public
        procedure SetId(const Value: integer);
        procedure SetDescription(const Value: AnsiString);
        function GetId: Integer;
        function GetDescription: string;
        property Description: AnsiString read GetDescription write SetDescription;
        property Id: integer read GetId write SetId;
        procedure FillJson();
        procedure Assigned(o : TlkJSONobject);
    end;
    
{ TmyObject }

procedure TmyObject.Assigned(o: TlkJSONobject);
begin
    Self.FDescription := (o.Field['Description'] as TlkJSONstring).Value;
    Self.FId := (o.Field['Id'] as TlkJSONnumber).value;
end;

procedure TmyObject.FillJson;
begin
    Self.Add('Description', TlkJSONstring.Generate(FDescription));
    Self.Add('Id', TlkJSONnumber.Generate(FId));
end;

function TmyObject.GetId: Integer;
begin
    result := FId;
end;

function TmyObject.GetDescription: AnsiString;
begin
    Result := FDescription;
end;

procedure TmyObject.SetId(const Value: integer);
begin
    FId := Value;
end;

procedure TmyObject.SetDescription(const Value: AnsiString);
begin
    FDescription := Value;
end;

Take a look at the assignment section where we need to fill in all the data using the JSON casting classes (TlkJSONString, TlkJSONNumber, etc).
Then, when we create our new class, we need to do:

uses
    uLKJson;

var
  js: TmyObject;

  js := TmyObject.Create;
  js.Description := 'desc';
  js.Id := 1111;
  js.FillJson;
  s := TlkJSON.GenerateText(js);

Then, if we want to send the JSON Object from one application to another, we can use the ClipBoard object or the windows messaging. In this solution I'll show you the second one as in the next example you'll see the managing with the clipboard.

Sender:

procedure TForm1.SendString(s : string);
var
    copyDataStruct: TCopyDataStruct;
begin
    copyDataStruct.dwData := 0; //use it to identify the message contents
    copyDataStruct.cbData := 1 + Length(s);
    copyDataStruct.lpData := PChar(s);
    SendData(copyDataStruct);
end;

procedure TForm1.SendData(const copyDataStruct: TCopyDataStruct);
var
    receiverHandle: THandle;
    res: integer;
begin
    receiverHandle := FindWindow(PChar('TForm2'), PChar('Form2'));
    if receiverHandle = 0 then
    begin
        ShowMessage('CopyData Receiver NOT found!');
        Exit;
    end;
    res := SendMessage(receiverHandle, WM_COPYDATA, Integer(Handle), Integer(@copyDataStruct));
end;

Receiver:

TForm2 = class(TForm)
    Memo1: TMemo;
    private
        procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
    public
        { Public declarations }
end;

procedure TForm2.WMCopyData(var Msg: TWMCopyData);
var
    test: String;
    js : TlkJSONobject;
    tt : TmyObject;
begin
    test := PChar(Msg.CopyDataStruct.lpData);
    js := TlkJSON.ParseText(test) as TlkJSONobject;
    tt := TmyObject.Create();
    tt.Assigned(js);

    Memo1.lines.Add(tt.Description);
    Memo1.lines.Add(IntToStr(tt.Id));
    //Send something back
    msg.Result := -1;
end;

Approximation with Delphi 2010:
In this example, you'll see a little example using the clipboard spy by Zarko Gajic. With his solution, we can start a form in promiscuous mode listening all the messages that belong to the clipboard. Delphi 2010 incorporates in this version the DBXJSON, and DBXJSONReflect units that work with JSON. Now with simple functions we can create Converters and Reverters of our classes.

First of all, we need to define our class:

unit Customer;

interface

uses
  DBXJSON, DBXJSONReflect, SysUtils, Contnrs;

type
  TMaritalStatus = (msMarried, msEngaged, msEligible);

  TCustomer = class
  private
    FName: string;
    FAge: integer;
    FMaritalStatus: TMaritalStatus;
  public
    property Name: string read FName write FName;
    property Age: integer read FAge write FAge;
    property MaritalStatus: TMaritalStatus read FMaritalStatus write FMaritalStatus;
    function ToString: string; override;
    constructor Create(Name: string; Age: integer; MaritalStatus: TMaritalStatus);
  end;

  TCustomerList = class(TObjectList)
  protected
    function GetItem(Index: integer): TCustomer; overload;
    procedure SetItem(Index: integer; AObject: TCustomer);
  public
    property Items[Index: integer]: TCustomer read GetItem write SetItem; default;
  end;

  TManager = class(TObject)
  private
    FCustomerList: TCustomerList;
    procedure SetCustomerList(const Value: TCustomerList);
  public
    property CustomerList: TCustomerList read FCustomerList write SetCustomerList;
    constructor Create;
    destructor Destroy; override;
    class function CreateAndInitialize: TManager;
  end;

Then we need to define a little record that will attach a pointer of our object. This record will be sent through the clipboard and the other application setted up in promiscuous mode, will remain waiting until it receives a message that has information for it.

TTransfer = record
    Handle: Cardinal;
    JSONValue: TJSONObject;
    manager : TManager;
    s : PUnicodeString; //PAnsiString;
  end;

Converter / Reverter functions: These functions are following the structure that JSON needs to marshall/unmarshall our class, but we need to serialize / de-serialize all the class attributes in order to match our variable definition with JSON variable definition (ex: TObjectList -> TListOfObjects):

function ManagerToJSON(manager: TManager): TJSONObject;
var
  m: TJSONMarshal;
begin
  if Assigned(manager) then
  begin
    m := TJSONMarshal.Create(TJSONConverter.Create);
    m.RegisterConverter(TManager, 'FCustomerList', function(Data: TObject; Field: String): TListOfObjects
var
  customers: TCustomerList;
  i: integer;
begin
  customers := TManager(Data).FCustomerList;
  SetLength(result, customers.Count);
  if customers.Count > 0 then
    for i := 0 to customers.Count - 1 do
      result[i] := customers[i];
 end);
    try
      result := m.Marshal(manager) as TJSONObject;
    finally
      m.Free;
    end;
  end;
end;

function JSONToManager(json: TJSONObject): TManager;
var
  unm: TJSONUnMarshal;
begin
  unm := TJSONUnMarshal.Create;
  unm.RegisterReverter(TManager, 'FCustomerList', procedure(Data: TObject; Field: String; Args: TListOfObjects)var obj: TObject;
customers :
TCustomerList;
Customer :
TCustomer;
i :
integer;
begin
  customers := TManager(Data).FCustomerList;
  customers.Clear;
  for obj in Args do
  begin
    Customer := obj as TCustomer;
    customers.Add(TCustomer.Create(Customer.Name, Customer.Age, Customer.MaritalStatus));
  end;
end);
  try
    result := unm.Unmarshal(json) as TManager;
  finally
    unm.Free;
  end;
end;

Setting up the form in promiscuous mode:

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure WMChangeCBChain(var Msg: TMessage); message WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Msg: TMessage); message WM_DRAWCLIPBOARD;
  public
  end;

var
  Form1: TForm1;
  transfer: TTransfer;
  transferPointer: ^TTransfer;
  OurFormat: Integer;
  MemberHandle: THandle;
  NextInChain: THandle;

procedure TForm1.WMDrawClipboard(var Msg: TMessage);
var
  MemberPointer: ^TTransfer;
  MemberInClip: THandle;
  AMember: TTransfer;
  han: Cardinal;
  myJSONCustomer: TManager;
  obj: TJSONObject;
  i: Integer;
  man: TManager;
begin
  if Clipboard.HasFormat(cf_text) then
  begin
    Memo1.Lines.Clear;
    Memo1.PasteFromClipboard;
  end
  else if Clipboard.HasFormat(OurFormat) then
  begin
    if OpenClipboard(Handle) then
    begin
      MemberInClip := GetClipboardData(OurFormat);
      MemberPointer := GlobalLock(MemberInClip);
      han := MemberPointer^.Handle;
      obj := MemberPointer^.JSONValue;
      man := MemberPointer^.Manager;
      if Assigned(man) then
      begin
        i := man.CustomerList.Count;
      end;
      myJSONCustomer := JSONToManager(obj);
      GlobalUnLock(MemberInClip);
      CloseClipboard();
      with Memo1.Lines do
      begin
        Clear;
        Add('Clipboard has TMember data:');
        for i := 0 to myJSONCustomer.CustomerList.Count - 1 do
        begin
          Add(IntToStr(myJSONCustomer.CustomerList.Items[i].Age));
          Add(myJSONCustomer.CustomerList.Items[i].Name);
        end;
      end;
    end;
  end;

  if NextInChain <> 0 then
    SendMessage(NextInChain, WM_DrawClipboard, 0, 0);
end;  

procedure TForm1.FormCreate(Sender: TObject);
begin
  NextInChain := SetClipboardViewer(Self.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  GlobalFree(MemberHandle);
  ChangeClipboardChain(Handle, NextInChain);
end;

procedure TForm1.WMChangeCBChain(var Msg: TMessage);
var
  Remove, Next: THandle;
begin
  Remove := Msg.WParam;
  Next := Msg.LParam;
  with Msg do
    if NextInChain = Remove then
      NextInChain := Next
    else if NextInChain <> 0 then
      SendMessage(NextInChain, WM_CHANGECBCHAIN, Remove, Next)
end;

Sending data through the clipboard:

procedure TForm1.Button1Click(Sender: TObject);
var
  Manager: TManager;
  obj: TJSONObject;
  s: unicodestring;
  myJSONCustomer: TManager;
  i: Integer;
  StringBytes: TBytes;
  JSON: TJSONObject;
begin
  Manager := TManager.Create();
  Manager.CustomerList.Add(TCustomer.Create('Pedro0', 30, msEligible));
  Manager.CustomerList.Add(TCustomer.Create('Pedro1', 31, msEligible));
  Manager.CustomerList.Add(TCustomer.Create('Pedro2', 32, msEligible));
  Manager.CustomerList.Add(TCustomer.Create('Pedro3', 33, msEligible));
  Manager.CustomerList.Add(TCustomer.Create('Pedro4', 34, msEligible));
  Manager.CustomerList.Add(TCustomer.Create('Pedro5', 35, msEligible));

  obj := ManagerToJSON(Manager);
  s := obj.ToString;
  Memo1.Lines.Add(s);

  OurFormat := RegisterClipboardFormat('CF_TTransfer');
  Memo1.Lines.Add('Format: ' + IntToStr(OurFormat));
  if OpenClipboard(Self.Handle) then
  begin
    EmptyClipboard;
    MemberHandle := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, SizeOf(TTransfer));
    transferPointer := GlobalLock(MemberHandle);

    transferPointer.Handle := Handle;
    transferPointer.JSONValue := obj;
    transferPointer.Manager := Manager;
    transferPointer.s := @s;

    StringBytes := TEncoding.ASCII.GetBytes(s);
    JSON := TJSONObject.Create;
    JSON.Parse(StringBytes, 0);
    Memo1.Lines.Add(JSON.ToString);

    Manager := JSONToManager(obj);
    for i := 0 to Manager.CustomerList.Count - 1 do
    begin
      Memo1.Lines.Add(IntToStr(Manager.CustomerList[i].Age));
      Memo1.Lines.Add(Manager.CustomerList[i].Name);
    end;

    GlobalUnLock(MemberHandle);
    SetClipboardData(OurFormat, MemberHandle);
    CloseClipboard();
  end;
  Manager.Free;
end;

If we take a look at the JSON data format we can see the following string:

{"type":"Customer.TManager","id":1,"fields":{"FCustomerList":[{"type":"Customer.TCustomer","id":2,"fields":{"FName":"Pedro0","FAge":30,"FMaritalStatus":"msEligible"}},{"type":"Customer.TCustomer","id":3,"fields":{"FName":"Pedro1","FAge":31,"FMaritalStatus":"msEligible"}},{"type":"Customer.TCustomer","id":4,"fields":{"FName":"Pedro2","FAge":32,"FMaritalStatus":"msEligible"}},{"type":"Customer.TCustomer","id":5,"fields":{"FName":"Pedro3","FAge":33,"FMaritalStatus":"msEligible"}},{"type":"Customer.TCustomer","id":6,"fields":{"FName":"Pedro4","FAge":34,"FMaritalStatus":"msEligible"}},{"type":"Customer.TCustomer","id":7,"fields":{"FName":"Pedro5","FAge":35,"FMaritalStatus":"msEligible"}}]}}

But, our problem doesn't end here. This fantastic solution only works in the same application, then we can send objects between forms by sending a pointer of it using the clipboard. In this promiscuous mode, all the forms are waiting for its data, because we can send different types to the clipboard and then filter it.

As a solution for handling objects between applications, I've used the same technology, but instead of sending a full object, I use JSON for sending a full string and then do the reconstruction of my object from the JSON string sent.

it's as easy as this:

Sender:

obj := ManagerToJSON(Manager); 
s := obj.ToString; 
Clipboard.AsText := string(s);

Receiver:

var 
    StringBytes : TBytes;
    JSON: TJSONObject;
begin
  s := Clipboard.AsText;
  StringBytes := TEncoding.ASCII.GetBytes(s); 
  JSON := TJSONObject.Create; 
  JSON.Parse(StringBytes, 0); 
  Memo1.Lines.Add(JSON.ToString);

If you come up with different ideas or have a better solution, please feel free to add a comment.

4 comments:

  1. Hello, nice post about JSON, comunication and Delphi.

    Did you know our OpenSource Framework? It just look like something you should be interrested in.

    It works from Delphi 7 to Delphi 2010, so you can make such cross-compiler programs talk with our framework. You can even use it with an embedded in-memory very fast (but limited) database, or an embedded SQlite3 engine.

    It uses JSON for data encoding, with UTF-8.
    It uses RTTI to define and get data fields from classes definition (don't write any SQL - just define Delphi classes, and the framework will use it).
    It can communicate either through a direct in memory link (a single exe or a dll), a named pipe, windows messages, and HTTP/1.1.

    You can take a look at http://synopse.info/forum/viewtopic.php?id=13

    ReplyDelete
  2. Thank you for your comment A. Bouchez. You can take for granted that I'll give Synopse a try. It sounds very interesting.

    ReplyDelete
  3. TmyObject Could you provide an example that within the class contains a TMyObject TlkJSONlist another object?

    ReplyDelete