Delphi Memory Mapped Files Notice new data?

2.8k views Asked by At

althoug my questionn might be noob-ish, let me explain: I recently started playing with MMF, created 2 processes wich access the same memory Pointer, Process1 writes an integer to MMF, Process2 has a button, which onClick, it displays the first integer in MMF.

What i want to do is, when i "send", write data from Process1 to MMF, Process2 Notices this request ontime, and displays the data on exact time, and so on with new data written.

I'm not sure whether a Thread checking for changes in MMF would be ok, sounds Dirty.

Hope somebody could point me out a solution, because i'm out of ideas :(.

Here's a piece of code:

 procedure OpenMap;
 var
   llInit: Boolean;
   lInt: Integer;
 begin
 if Hmapping<>0 then Exit;

   HMapping := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
                 0, MAPFILESIZE, pchar('wowsniff'));
   // Check if already exists
   llInit := (GetLastError() <> ERROR_ALREADY_EXISTS);
   if (hMapping = 0) then

     exit;

   PMapData := MapViewOfFile(HMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
   if PMapData = nil then
     exit;
     if (llInit) then
   begin
     // Init block to #0 if newly created
     FillChar(PMapData^, MAPFILESIZE, 0);
   end
 end;

procedure TForm1.Button3Click(Sender: TObject);
begin
LockMap;
PDword(PMapData)^:=Strtoint(edit1.Text);
UnlockMap;
end;
1

There are 1 answers

6
Remy Lebeau On

Use a named event object for that, either via TEvent or CreateEvent(). Both processes can create the same event name (just like they are creating the same mapping name), then Process 1 can signal the event whenever it writes new data, and Process 2 can wait for the event to be signaled before reading the data (for real-time reading, you should use a thread for the waiting/reading).

You can use a named mutex object, via TMutex or CreateMutex(), to implement your lock/unlock functionality when reading/writing the data.

Try something like this:

Process 1 :

procedure OpenMap;
var
  llInit: Boolean;
begin
  llInit := False;

  if hMapEvent = 0 then
  begin
    hMapEvent := CreateEvent(nil, True, False, PChar('wowsniffDataReady'));
    if hMapEvent = 0 then RaiseLastOSError;
  end;

  if hMapLock = 0 then
  begin
    hMapLock := CreateMutex(nil, False, PChar('wowsniffDataLock'));
    if hMapLock = 0 then RaiseLastOSError;
  end;

  if hMapping = 0 then
  begin
    hMapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, MAPFILESIZE, PChar('wowsniff'));
    if hMapping = 0 then RaiseLastOSError;
    // Check if already exists
    llInit := (GetLastError() <> ERROR_ALREADY_EXISTS);
  end;

  if PMapData = nil then
  begin
    PMapData := MapViewOfFile(hMapping, FILE_MAP_WRITE, 0, 0, MAPFILESIZE);
    if PMapData = nil then RaiseLastOSError;

    if llInit then
    begin
      // Init block to #0 if newly created
      ZeroMemory(PMapData, MAPFILESIZE);
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  LockMap;
  try
    PDword(PMapData)^ := StrToInt(Edit1.Text);
    SetEvent(hMapEvent);
  finally
    UnlockMap;
  end;
end;

procedure TForm1.LockMap;
var
  llRet: DWORD;
 begin
  llRet := WaitForSingleObject(hMapLock, 5000);
  if llRet = WAIT_OBJECT_0 then Exit;
  if llRet <> WAIT_FAILED then SetLastError(llRet);
  RaiseLastOSError;
end;

procedure TForm1.UnlockMap;
begin
  ReleaseMutex(hMapLock);
end;

Process 2:

type
  TMyThread = class(TThread)
  private
    hTerminate: THandle;
    hMapLock: THandle;
    hMapEvent: THandle;
    hMapping: THandle;
    PMapData: Pointer;
  protected
    procedure Execute; override;
    procedure DoTerminate; override;
    procedure TerminatedSet; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

constructor TMyThread.Create;
begin
  inherited Create(False);
  hTerminate := CreateEvent(nil, True, False, nil);
  if hTerminate = 0 then RaiseLastOSError;
end;

destructor TMyThread.Destroy;
begin
  if hTerminate <> 0 then CloseHandle(hTerminate)
end;

procedure TMyThread.TerminatedSet;
begin
  SetEvent(hTerminate);
end;

procedure TMyThread.Execute;
var
  llInit: Boolean;
  llRet, llValue: DWORD;
  llHandles: array[0..1] of THandle;
begin
  hMapEvent := CreateEvent(nil, True, False, PChar('wowsniffDataReady'));
  if hMapEvent = 0 then RaiseLastOSError;

  hMapLock := CreateMutex(nil, False, PChar('wowsniffDataLock'));
  if hMapLock = 0 then RaiseLastOSError;

  hMapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, MAPFILESIZE, PChar('wowsniff'));
  if hMapping = 0 then RaiseLastOSError;
  // Check if already exists
  llInit := (GetLastError() <> ERROR_ALREADY_EXISTS);

  PMapData := MapViewOfFile(hMapping, FILE_MAP_WRITE, 0, 0, MAPFILESIZE);
  if PMapData = nil then RaiseLastOSError;
  if llInit then
  begin
    // Init block to #0 if newly created
    FillChar(PMapData^, MAPFILESIZE, 0);
  end;

  llHandles[0] := hMapEvent;
  llHandles[1] := hTerminate;

  while not Terminated do
  begin
    llRet := WaitForMultipleObjects(2, PWOHandleArray(@llHandles), False, INFINITE);
    case llRet of
      WAIT_OBJECT_0+0:
      begin
        llRet := WaitForSingleObject(hMapLock, 5000);
        if llRet = WAIT_OBJECT_0 then
        begin
          try
            llValue := PDword(PMapData)^;
            ResetEvent(hMapEvent);
          finally
            ReleaseMutex(hMapLock);
          end;
          // use llValue as needed...
          Continue;
        end;
      end;
      WAIT_OBJECT_0+1:
      begin
        Exit;
      end;
    end;
    if llRet <> WAIT_FAILED then SetLastError(llRet);
    RaiseLastOSError;
  end;
end;

procedure TMyThread.DoTerminate;
begin
  if PMapData <> nil then UnmapViewOfFile(PMapData);
  if hMapping <> 0 then CloseHandle(hMapping);
  if hMapEvent <> 0 then CloseHandle(hMapEvent);
  if hMapLock <> 0 then CloseHandle(hMapLock);
  inherited;
end;