Memory mapping for process communication

Unit Filemap;


Interface


Uses
Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms,
Stdctrls, Dialogs;


Type
Defining the Tfilemap Class
Tfilemap = Class (Tcomponent)
Private
Fmaphandle:thandle; Memory-mapped file handle
Fmutexhandle:thandle; Mutex handle
fmapname:string; Memory-mapped objects
fsynchmessage:string; Synchronizing information
Fmapstrings:tstringlist; Store mapping File information
Fsize:dword; Map File Size
Fmessageid:dword; Registered message number
Fmappointer:pchar; Data area pointers for map files
Flocked:boolean; Lock
Fismapopen:boolean; Whether the file is open
Fexistsalready:boolean; Indicates whether a file mapping has been established
Freading:boolean; Reading memory-mapped file data
Fautosynch:boolean; Whether to synchronize automatically
Fonchange:tnotifyevent; When the contents of the Memory data area change
Fformhandle:hwnd; Window handle for storing this window
Fpnewwndhandler:pointer; //
Fpoldwndhandler:pointer; //
Procedure Setmapname (value:string);
Procedure Setmapstrings (value:tstringlist);
Procedure SetSize (Value:dword);
Procedure Setautosynch (Value:boolean);
Procedure EnterCriticalSection;
Procedure LeaveCriticalSection;
Procedure Mapstringschange (Sender:tobject);
Procedure Newwndproc (var fmessage:tmessage);
Public
Constructor Create (aowner:tcomponent); Override
destructor Destroy; Override
Procedure Openmap;
Procedure Closemap;
Procedure Readmap;
Procedure Writemap;
Property Existsalready:boolean read Fexistsalready;
Property Ismapopen:boolean read Fismapopen;
Published
Property Maxsize:dword read Fsize write SetSize;
Property Autosynchronize:boolean read Fautosynch write setautosynch;
Property mapname:string read Fmapname write setmapname;
Property Mapstrings:tstringlist read Fmapstrings write setmapstrings;
Property Onchange:tnotifyevent read Fonchange write Fonchange;
End




Implementation


constructor function
Constructor Tfilemap.create (aowner:tcomponent);
Begin
Inherited Create (Aowner);
Fautosynch: = True;
Fsize: = 4096;
Freading: = False;
Fmapstrings: = tstringlist.create;
Fmapstrings.onchange: = Mapstringschange;
Fmapname: = ' Unique & Common name ';
Fsynchmessage: = fmapname + ' Synch-now ';
If Aowner is Tform then
Begin
Fformhandle: = (Aowner as Tform). Handle;
Get the address of the window processing process
Fpoldwndhandler: = Ptr (GetWindowLong (Fformhandle, GWL_WNDPROC));
Fpnewwndhandler: = Makeobjectinstance (Newwndproc);
If Fpnewwndhandler = Nil Then
Raise Exception.create (' out of resources ');
To set the new address of the window processing process
SetWindowLong (Fformhandle, GWL_WNDPROC, Longint (Fpnewwndhandler));
End
else raise Exception.create (' The owner of the component should be Tform ');
End




Destructors
destructor Tfilemap.destroy;
Begin
Closemap;
Restore Windows processing process address
SetWindowLong (Fformhandle, GWL_WNDPROC, Longint (Fpoldwndhandler));
If Fpnewwndhandler <> Nil Then
Freeobjectinstance (Fpnewwndhandler);
Releasing objects
Fmapstrings.free;
Fmapstrings: = nil;
inherited destroy;
End


Open file mappings and map to process space
Procedure Tfilemap.openmap;
Var
TEMPMESSAGE:ARRAY[0..255] of Char;
Begin
if (fmaphandle = 0) and (fmappointer = nil) Then
Begin
Fexistsalready: = False;
Create a file Map object
Fmaphandle: = createfilemapping ($FFFFFFFF, Nil, page_readwrite, 0, Fsize, PChar (fmapname));
if (Fmaphandle = Invalid_handle_value) or (fmaphandle = 0) Then
Raise Exception.create (' Create file mapping object failed! ')
Else
Begin
Determine if a file mapping has been established
if (fmaphandle <> 0) and (GetLastError = error_already_exists) Then
Fexistsalready: = True; If it is established, set it to true.
Map the view of the file to the address space of the process
Fmappointer: = MapViewOfFile (Fmaphandle, file_map_all_access, 0, 0, 0);
If Fmappointer = Nil Then
Raise Exception.create (' map file view to process ' address space failed ')
Else
Begin
Strpcopy (Tempmessage, fsynchmessage);
Registering message Constants in Windows
Fmessageid: = RegisterWindowMessage (Tempmessage);
If Fmessageid = 0 Then
Raise Exception.create (' Registration message failed ')
End
End
Create a mutex object to use when writing a file mapping space to keep data synchronized
Fmutexhandle: = Windows.createmutex (Nil, False, PChar (Fmapname + '). Mtx '));
If Fmutexhandle = 0 Then
Raise Exception.create (' failed ' to create mutex object ');
Fismapopen: = True;
If Fexistsalready then//determine if the memory file mapping is turned on
Readmap
Else
Writemap;
End
End


Disassociate the file view from the memory-mapped space and close the file map
Procedure Tfilemap.closemap;
Begin
If Fismapopen Then
Begin
Releasing mutex objects
If Fmutexhandle <> 0 Then
Begin
CloseHandle (Fmutexhandle);
Fmutexhandle: = 0;
End
Close Memory Objects
If Fmappointer <> Nil Then
Begin
To disassociate a file view from a memory-mapped space
UnmapViewOfFile (Fmappointer);
Fmappointer: = nil;
End
If Fmaphandle <> 0 Then
Begin
and close the file map
CloseHandle (Fmaphandle);
Fmaphandle: = 0;
End
Fismapopen: = False;
End
End


Read Memory file mapping content
Procedure Tfilemap.readmap;
Begin
Freading: = True;
if (fmappointer <> nil) then Fmapstrings.settext (Fmappointer);
Freading: = False;
End


Write to the memory-mapped file
Procedure Tfilemap.writemap;
Var
Stringspointer:pchar;
Handlecounter:integer;
Sendtohandle:hwnd;
Begin
If Fmappointer <> Nil Then
Begin
Stringspointer: = Fmapstrings.gettext;
Enter the mutex state to prevent other threads from entering the synchronization area code
EnterCriticalSection;
If StrLen (stringspointer) + 1 <= fsize
Then System.move (stringspointer^, fmappointer^, StrLen (stringspointer) + 1)
Else
Raise Exception.create (' Write string failed, string too big! ');
Leave the Mutex state
LeaveCriticalSection;
Broadcast message indicating that the contents of the memory-mapped file have been modified
SendMessage (Hwnd_broadcast, Fmessageid, Fformhandle, 0);
Release Stringspointer
Strdispose (Stringspointer);
End
End


When the Mapstrins value is changed
Procedure Tfilemap.mapstringschange (Sender:tobject);
Begin
If Freading and Assigned (Fonchange) Then
Fonchange (self)
else if (not freading) and Fismapopen and Fautosynch then
Writemap;
End


Setting the Mapname property value
Procedure Tfilemap.setmapname (value:string);
Begin
if (fmapname <> value) and (Fmaphandle = 0) and (Length (Value) < 246) Then
Begin
Fmapname: = Value;
Fsynchmessage: = fmapname + ' Synch-now ';
End
End


Setting the Mapstrings property value
Procedure Tfilemap.setmapstrings (value:tstringlist);
Begin
If Value.text <> Fmapstrings.text Then
Begin
If Length (value.text) <= Fsize Then
Fmapstrings.assign (Value)
Else
Raise Exception.create (' Write value too large ');
End
End


Set the memory file size
Procedure Tfilemap.setsize (Value:dword);
Var
Stringspointer:pchar;
Begin
if (fsize <> Value) and (fmaphandle = 0) Then
Begin
Stringspointer: = Fmapstrings.gettext;
if (Value < StrLen (stringspointer) + 1) Then
Fsize: = StrLen (stringspointer) + 1
else fsize: = Value;
If fsize < fsize: = 32;
Strdispose (Stringspointer);
End
End


Set whether to synchronize
Procedure Tfilemap.setautosynch (Value:boolean);
Begin
If Fautosynch <> Value Then
Begin
Fautosynch: = Value;
If Fautosynch and Fismapopen then Writemap;
End
End


Enter the mutex so that the synchronized code cannot be accessed by another thread
Procedure Tfilemap.entercriticalsection;
Begin
if (fmutexhandle <> 0) and not flocked then
Begin
Flocked: = (WaitForSingleObject (fmutexhandle, INFINITE) = WAIT_OBJECT_0);
End
End


Dissolve the mutex, you can enter the protected synchronization code area
Procedure Tfilemap.leavecriticalsection;
Begin
if (fmutexhandle <> 0) and flocked then
Begin
ReleaseMutex (Fmutexhandle);
flocked: = False;
End
End


Message capture Process
Procedure Tfilemap.newwndproc (var fmessage:tmessage);
Begin
With Fmessage do
Begin
If Fismapopen then//memory File Open
{If the message is Fmessageid and wparam is not fformhandle, call Readmap,
To read the contents of a memory-mapped file, indicating that the contents of the memory-mapped file have changed}
if (MSG = Fmessageid) and (WParam <> fformhandle) Then
Readmap;
Result: = CallWindowProc (Fpoldwndhandler, Fformhandle, MSG, WParam, LParam);
End
End

End.

Unit mainfrm;


Interface


Uses
Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs,
Stdctrls, Extctrls, Filemap;


Type
Tfrmmain = Class (Tform)
Btnwritemap:tbutton;
Btnreadmap:tbutton;
Btnclear:tbutton;
Chkexistsalready:tcheckbox;
Chkismapopen:tcheckbox;
Btnopenmap:tbutton;
Btnclosemap:tbutton;
Mmocont:tmemo;
Chkautosynchronize:tcheckbox;
Label5:tlabel;
Lblhelp:tlabel;
Procedure Btnwritemapclick (Sender:tobject);
Procedure Btnreadmapclick (Sender:tobject);
Procedure Btnclearclick (Sender:tobject);
Procedure Btnopenmapclick (Sender:tobject);
Procedure Btnclosemapclick (Sender:tobject);
Procedure Formcreate (Sender:tobject);
Procedure Chkautosynchronizeclick (Sender:tobject);
Procedure Mmocontkeydown (Sender:tobject; var Key:word;
Shift:tshiftstate);
Private
Defining Objects for Tfilemap
Filemap:tfilemap;
Defines the onchange event that Filemapchange is used to assign to Filemap
Procedure Filemapchange (Sender:tobject);
Procedure Check;
{Private declarations}
Public
{Public declarations}
End


Var
Frmmain:tfrmmain;
Implementation


{$R *. DFM}


Check the Existsalready and Ismapopen properties of the Filemap
Procedure Tfrmmain.check;
Begin
chkexistsalready.checked: = Filemap.existsalready;
chkismapopen.checked: = Filemap.ismapopen;
End


Initialize the Filemap object when the form is created
Procedure Tfrmmain.formcreate (Sender:tobject);
Begin
Create an Object Filemap
Filemap: = Tfilemap.create (self);
Filemap.onchange: = Filemapchange;
chkautosynchronize.checked: = filemap.autosynchronize;
Initializes the contents of the Filemap if the memory object has not yet been created
If not Filemap.existsalready then
Begin
MmoCont.Lines.LoadFromFile (' PROJECT1.DPR ');
FileMap.MapStrings.Assign (Mmocont.lines);
End
Lblhelp.caption: = ' Instructions for use: Run two or more of this application, press the "Open Memory Map" button, '
+ #13 + ' Check the ' sync ' checkbox, change it in the Notes box, and in another application will '
+ #13 + ' The information after the move, but also can read and write data buttons to get shared information '
End


Data written to the memory file map
Procedure Tfrmmain.btnwritemapclick (Sender:tobject);
Begin
Filemap.writemap;
End


Reading data from a memory file map
Procedure Tfrmmain.btnreadmapclick (Sender:tobject);
Begin
Filemap.readmap;
End


Clear Memory File data
Procedure Tfrmmain.btnclearclick (Sender:tobject);
Begin
Mmocont.clear;
FileMap.MapStrings.Clear;
Check
End


Open Memory File mapping
Procedure Tfrmmain.btnopenmapclick (Sender:tobject);
Begin
Filemap.mapname: = ' Delphi 6 ';
Filemap.openmap;
Check
End


Turn off memory mapping
Procedure Tfrmmain.btnclosemapclick (Sender:tobject);
Begin
Filemap.closemap;
Check;
End


Displays the most recent data when the data of the memory-mapped file changes
Procedure Tfrmmain.filemapchange (Sender:tobject);
Begin
Mmocont.Lines.Assign (filemap.mapstrings);
Check;
End


Set whether to display synchronously
Procedure Tfrmmain.chkautosynchronizeclick (Sender:tobject);
Begin
Filemap.autosynchronize: = chkautosynchronize.checked;
End


When you write in the Notes box, update the memory map file at the same time
Procedure Tfrmmain.mmocontkeydown (Sender:tobject; var Key:word;
Shift:tshiftstate);
Begin
FileMap.MapStrings.Assign (Mmocont.lines);
End


End.

http://blog.csdn.net/zang141588761/article/details/52062603

Memory mapping for process communication