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.
