CreateFileMapping between two processes

[rpetges]

Dear all,

I want to use shared data between two Lazarus applications using the Windows FileMapping mechanism. Please have a look at the attached test project.

In fact, I need to pass a variable string length from the caller to the receiver. The length can grow up to several KB of data. In the test application, a data structure has been defined and it contains a variable of type string.

Code: Pascal  [Select][+][-]

1.   TData = packed record
2.     FUniqueID: DWORD;
3.     FName: string;
4.   end;  

The variable FName is initialized as follow (TForm1.SendClick) :

Code: Pascal  [Select][+][-]

1. Data.FName := 'ABC-';

Data is correctly exchanged when clicking on the "Send" and then "Receive" button, even between TWO instances. Large strings of more than 800 characters also work without problems.

Now, initialization code is changed to :

Code: Pascal  [Select][+][-]

1. Data.FName := 'ABC-';
2. Data.FName := Data.FName + 'DEF';

For ONE instance, it still works fine.

When you launch TWO instances of the compiled application, and click "Send" in the first one and then "Receive" in the second instance, some garbage data is transmitted, but not the requested data. In the message dialog, the text for the label "Name" may be empty or the "Receiver" application may crash.

I tried so many things and can't get it working. Maybe it's just a small adjustment.

How can I get this working ?

Many thanks for your help,
Romain

[Martin_fr]

"string" defaults to "ansistring"

It may work if you use shortstring. But then the length is limited.

Ansistring, is just a pointer to some memory (within the current process) where the actual text is. So you just copy this pointer. If you read within the same process, then it may work sometimes (kind of, it may leak mem).

You need to copy the actual text data instead.

[rpetges]

Shortstring works, but I'm too limited in size.

Can you provide a practical example that works for dynamic text sizes ... I'm somehow lost 

Many thanks

[ASerge]

Can you provide a practical example that works for dynamic text sizes ... I'm somehow lost 

Code: Pascal  [Select][+][-]

1. program Project1;
2. {$APPTYPE CONSOLE}
3. {$MODE OBJFPC}
4. {$LONGSTRINGS ON}
5.  
6. uses SysUtils, uPageFileStream;
7.  
8. const
9.   CMapName = '{9D809F6B-FC10-4E4F-B352-4A7773762BAA}'; // Any unique name
10.  
11. type
12.   TData = record
13.     FUniqueID: DWORD;
14.     FName: string;
15.   end;
16.  
17. function Receive(out Data: TData): Boolean;
18. var
19.   Stream: TPageFileStream;
20. begin
21.   Stream := TPageFileStream.CreateForRead(CMapName);
22.   try
23.     Result := (pfsValid in Stream.States) and (Stream.Size >= SizeOf(Data));
24.     if Result then
25.     begin
26.       Data.FUniqueID := Stream.ReadDWord;
27.       Data.FName := Stream.ReadAnsiString;
28.     end;
29.   finally
30.     Stream.Free;
31.   end;
32. end;
33.  
34. var
35.   Stream: TPageFileStream;
36.   DataIn, DataOut: TData;
37. begin
38.   DataIn.FUniqueID := 15;
39.   DataIn.FName := 'Some string';
40.   // SizeOf(DataIn) + Length(DataIn.FName) is enough
41.   Stream := TPageFileStream.Create(SizeOf(DataIn) + Length(DataIn.FName), CMapName);
42.   try
43.     Stream.WriteDWord(DataIn.FUniqueID);
44.     Stream.WriteAnsiString(DataIn.FName);
45.     // Do interprocess
46.     if Receive(DataOut) then
47.       Writeln('ID=', DataOut.FUniqueID, ', Name=', DataOut.FName)
48.     else
49.       Writeln(SysErrorMessage(GetLastOSError));
50.   finally
51.     Stream.Free;
52.   end;
53.   Readln;
54. end.

unit uPageFileStream are included.

[rpetges]

Works great 

Many thanks ASerge !

[Remy Lebeau]

Stream := TPageFileStream.Create(SizeOf(DataIn) + Length(DataIn.FName), CMapName);

DataIn is a TData, which contains a string, which is a pointer.  So right off the bat, you are relying on SizeOf(Pointer) = 4 to match the 4-byte leading DWORD that WriteAnsiString() writes.  That is not the case if you compile for 64-bit instead of 32-bit.  OK granted, an 8-byte pointer will simply allocate more memory than needed, no harm done.  But you are also relying on the string containing characters that fit within 8 bits each when written by WriteAnsiString(). That is certainly the case when string=AnsiString, but not guaranteed when string=UnicodeString, such as in {$ModeSwitch UnicodeStrings}.  So again, you might end up over-allocating when the length of a Unicode string is greater than the length of the ANSI equivalent.  In fact, WriteAnsiString() and ReadAnsiString() are both coded to assume string=AnsiString, so they won't even work correctly when string=UnicodeString.

Personally, I wouldn't suggest serializing strings using AnsiString at all. Better to use UTF-8 instead, eg:

Code: [Select]

function Receive(out Data: TData): Boolean;
var
  Stream: TPageFileStream;
  TheSize: DWORD;
  S: UTF8String;
begin
  Result := False;
  Stream := TPageFileStream.CreateForRead(CMapName);
  try
    if (pfsValid in Stream.States) and (Stream.Size >= (SizeOf(DWord)*2)) then
    begin
      Data.FUniqueID := Stream.ReadDWord;
      TheSize := Stream.ReadDWord;
      if (TheSize > 0) and ((Stream.Size - Stream.Position) >= TheSize) then
      begin
        SetLength(S, TheSize);
        Stream.ReadBuffer(Pointer(S)^, TheSize);
        Data.FName := UTF8Decode(S);
        Result := True;
      end;
    end;
  finally
    Stream.Free;
  end;
end;
     
function Send(const Data: TData): Boolean;
var
  Stream: TPageFileStream;
  TheSize: DWORD;
  S: UTF8String;
begin
  Result := False;
  S := UTF8Encode(Data.FName);
  TheSize := Length(S);
  Stream := TPageFileStream.Create((SizeOf(DWord) * 2) + TheSize, CMapName);
  try
    if pfsValid in Stream.States then
    begin
      Stream.WriteDWord(DataIn.FUniqueID);
      Stream.WriteDWord(TheSize);
      Stream.WriteBuffer(Pointer(S)^, TheSize);
    end;
  finally
    Stream.Free;
  end;
end;

var
  DataIn, DataOut: TData;
begin
  DataIn.FUniqueID := 15;
  DataIn.FName := 'Some string';
  if Send(DataIn) then
  begin
    // Do interprocess
    if Receive(DataOut) then
      Writeln('ID=', DataOut.FUniqueID, ', Name=', DataOut.FName)
    else
      Writeln(SysErrorMessage(GetLastOSError));
  end else
      Writeln(SysErrorMessage(GetLastOSError));
  Readln;
end.


[marcov]

(FPC 3.x based Lazaruses change the default 1-byte encoding to utf8)