//сервер
unit mainServ;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TfrmServer = class(TForm)
    btnCreate: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure btnCreateClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Private declarations }
    procedure CreateFileMap;
    procedure CloseFileMap;
  public
    { Public declarations }
  end;

const
  MMFName: PWideChar = 'DelphiFileMappedExample'; // имя объекта файлового отображения
  bufSize=2048;//размер буфера

var
  hFile,hMapedFile:HWND;
  pMapFile:Pointer;
  frmServer: TfrmServer;
  WM_WRITEFILEMAP:Cardinal;
implementation

{$R *.dfm}

procedure TfrmServer.btnCreateClick(Sender: TObject);
begin
  CreateFileMap;////Создание именованной, совместно используемой памяти
end;

procedure TfrmServer.CloseFileMap;
begin
  if not Assigned(pMapFile) then
    UnmapViewOfFile(pMapFile);
  if hMapedFile<>INVALID_HANDLE_VALUE then
    CloseHandle(hMapedFile);
  if (hFile<>INVALID_HANDLE_VALUE) then
    CloseHandle(hFile);
end;

//Создание именованной, совместно используемой памяти
procedure TfrmServer.CreateFileMap;
var
  outBuff:array[0..bufSize] of Char;
  byteWrt:Cardinal;
begin
  CloseFileMap;
  hFile:=CreateFile(PWideChar('Temp.txt'),
                    GENERIC_READ or GENERIC_WRITE,
                    FILE_SHARE_READ or FILE_SHARE_WRITE,
                    nil,CREATE_ALWAYS or OPEN_EXISTING,
                    FILE_ATTRIBUTE_NORMAL,0);

  if hFile=INVALID_HANDLE_VALUE then
  begin
    ShowMessage('Ошибка при создании файла '+SysErrorMessage(GetLastError));
    Exit;
  end;
  Memo1.MaxLength:=bufSize;
  StrPCopy(outBuff,Memo1.Lines.Text);
  WriteFile(hFile,outBuff,bufSize*SizeOf(Char),byteWrt,nil);

  hMapedFile:=CreateFileMapping(hFile,                //INVALID_HANDLE_VALUE-использование файла подкачки
                                nil,                  // защита по умолчанию
                                PAGE_READWRITE,       //доступ к чтению/записи
                                0,                    // макс. размер объекта
                                bufSize*SizeOf(Char), // размер буфера
                                MMFName);             // имя отраженного в памяти объекта

  if hMapedFile=INVALID_HANDLE_VALUE then
  begin
    ShowMessage('Ошибка при проецировании файла в память '+SysErrorMessage(GetLastError));
    CloseHandle(hFile);
    Exit;
  end;
  pMapFile:=MapViewOfFile(hMapedFile,           //дескриптор "проецируемого" объекта
                          FILE_MAP_ALL_ACCESS,  // разрешение чтения/записи
                          0,0,
                          bufSize*SizeOf(Char));//размер буфера
  if pMapFile=nil then
  begin
    ShowMessage('Ошибка при отображении файла '+SysErrorMessage(GetLastError));
    CloseHandle(hMapedFile);
    CloseHandle(hFile);
    Exit;
  end;
  //оповещаем всех клиентов о том, что файл изменился))
  SendMessage(HWND_BROADCAST,WM_WRITEFILEMAP,0,0);
end;

procedure TfrmServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CloseFileMap;
end;

procedure TfrmServer.Timer1Timer(Sender: TObject);
begin
  Memo1.Lines.Add(TimeToStr(time));
  if Length(Memo1.Text) >=bufSize then
    Memo1.Clear;
  CreateFileMap;
end;

initialization
  WM_WRITEFILEMAP:=RegisterWindowMessage('WM_WRITEFILEMAP');

end.


//клиент

unit clientMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmClient = class(TForm)
    btnRead: TButton;
    Memo1: TMemo;
    procedure btnReadClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    procedure WndProc(var Msg: TMessage); override;
  end;
const
  MMFName: PWideChar = 'DelphiFileMappedExample'; // имя объекта файлового отображения
  bufSize=100;//размер буфера

var
  frmClient: TfrmClient;
  WM_WRITEFILEMAP:Cardinal;

implementation

{$R *.dfm}

procedure TfrmClient.btnReadClick(Sender: TObject);
var
  hMapedFile:HWND;
  pMapFile:Pointer;

begin
  hMapedFile:=OpenFileMapping(FILE_MAP_ALL_ACCESS, // доступ к чтению/записи
                              False, //имя не наследуется
                              MMFName);//имя "проецируемого " объекта

  if hMapedFile=INVALID_HANDLE_VALUE then
  begin
    ShowMessage('Ошибка при проецировании файла в память '+SysErrorMessage(GetLastError));
    Exit;
  end;

  pMapFile:=MapViewOfFile(hMapedFile,//дескриптор "проецируемого" объекта
                          FILE_MAP_ALL_ACCESS,// разрешение чтения/записи
                          0,0,
                          bufSize*SizeOf(Char));//размер буфера

  if pMapFile=nil then
  begin
    ShowMessage('Ошибка при отображении файла '+SysErrorMessage(GetLastError));
    CloseHandle(hMapedFile);
    Exit;
  end;

  Memo1.Text:=PChar(pMapFile);
  UnmapViewOfFile(pMapFile);
  CloseHandle(hMapedFile);
end;

procedure TfrmClient.WndProc(var Msg: TMessage);
begin
  inherited;
  if Msg.Msg=WM_WRITEFILEMAP then
    btnReadClick(Self);

end;

initialization
  WM_WRITEFILEMAP:=RegisterWindowMessage('WM_WRITEFILEMAP');

end.