Ceci est une ancienne révision du document !

Mémoire partagée

Utilisation d'une classe TTICSharedMemory

uTICSharedMemory

Cette unité contient le code de l'object TTICSharedMemory

unit uTICSharedMemory;
 
{$mode ObjFPC}{$H+}
 
interface
 
uses
  Windows;
 
type
 
  { TTICSharedMemory }
 
  TTICSharedMemory = class
  private
    FPointer:   Pointer;
    FLastError: DWord;
    FHandle:    THandle;
    procedure FreeHandle;
  public
    constructor Create(AName: PChar; ASize: integer);
    destructor Destroy; override;
    property LastError: DWord read FLastError;
    property Pointer: pointer read FPointer;
  end;
 
implementation
 
{ TTICSharedMemory }
 
procedure TTICSharedMemory.FreeHandle;
begin
  if FHandle <> 0 then
  begin
    CloseHandle(FHandle);
    FHandle := 0;
  end;
end;
 
constructor TTICSharedMemory.Create(AName: PChar; ASize: integer);
begin
  FHandle    := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,
    0, ASize, AName);
  FLastError := GetLastError;
 
  if FHandle > 0 then
  begin
    FPointer := MapViewOfFile(FHandle, FILE_MAP_WRITE, 0, 0, 0);
    if not assigned(FPointer) then FreeHandle;
  end;
end;
 
destructor TTICSharedMemory.Destroy;
begin
  if assigned(FPointer) then
  begin
    UnmapViewOfFile(FPointer);
    FPointer := nil;
  end;
  FreeHandle;
  inherited;
end;
 
end.

Titre

uFormClient.pas

unit uFormClient;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  SysUtils,
  Forms,
  Controls,
  Graphics,
  Dialogs,
  StdCtrls,
  ExtCtrls,
  uTICSharedMemory;
 
type
 
  TDatas = packed record
    Text: shortstring;
    Size: integer;
    Date: TDateTime;
  end;
 
  PDatas = ^TDatas;
 
  { TFormClient }
 
  TFormClient = class(TForm)
    Memo:   TMemo;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FSMem:   TTICSharedMemory;
    FPDatas: PDatas;
  public
 
  end;
 
var
  FormClient: TFormClient;
 
implementation
 
{$R *.lfm}
 
{ TFormClient }
 
procedure TFormClient.FormCreate(Sender: TObject);
begin
  FSMem   := TTICSharedMemory.Create('shmemtest', sizeof(TDatas));
  FPDatas := FSMem.Pointer;
end;
 
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
  Memo.Lines.Add(DateTimeToStr(FPDatas^.Date));
  Memo.Lines.Add(FPDatas^.Text);
  Memo.Lines.Add('Longueur:%d', [FPDatas^.Size]);
end;
 
end.

Titre

uFormServer.pas

unit uFormServer;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  uTICSharedMemory;
 
type
 
  TDatas = packed record
    Text: shortstring;
    Size: integer;
    Date: TDateTime;
  end;
 
  PDatas = ^TDatas;
 
  { TFormServer }
 
  TFormServer = class(TForm)
    Edit1: TEdit;
    procedure Edit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FPDatas: PDatas;
    FSMem : TTICSharedMemory;
  public
 
  end;
 
var
  FormServer: TFormServer;
 
implementation
 
{$R *.lfm}
 
{ TFormServer }
 
procedure TFormServer.FormCreate(Sender: TObject);
begin
  FSMem:=TTICSharedMemory.Create('shmemtest',sizeof(TDatas));
  FPDatas:=FSMem.Pointer;
end;
 
procedure TFormServer.FormDestroy(Sender: TObject);
begin
  FSMem.Free;
end;
 
procedure TFormServer.Edit1Change(Sender: TObject);
begin
  FPDatas^.Text:=Edit1.Text+#0;
  FPDatas^.Size:=length(Edit1.Text);
  FPDatas^.Date:=now;
end;
 
 
end.

A voir

Apparement shmat est propre a Linux/Unix

Vous pourriez laisser un commentaire si vous étiez connecté.