Différences

Ci-dessous, les différences entre deux révisions de la page.

--- prog:lazarus:cas:processus:shared_memory [12/03/2023 14:27]
thierry [A voir]
+++ prog:lazarus:cas:processus:shared_memory [12/03/2023 17:21] (Version actuelle)
thierry [Mémoire partagée]
@@ Ligne 1: / Ligne 1: @@
 ====== Mémoire partagée ======
+Ma problématique est de faire communiquer deux applications différentes (sur le même PC) entre elles...
+Voici quelques pistes :
+===== Utilisation d'une classe TTICSharedMemory =====
+Ci dessous un exemple de données partagées entre deux applications Windows.\\
+Un serveur avec un ''TEdit'', qui modifie la mémoire partagé dés qu'on modifie la valeur du ''TEdit''.\\
+Un Client, qui affiche toutes les secondes la valeur de la donnée partagée.
+==== uTICSharedMemory ====
+Cette unité contient le code de l'object TTICSharedMemory
+<code delphi uTICSharedMemory>
+unit uTICSharedMemory;
+{$mode ObjFPC}{$H+}
+interface
+uses
+  Windows;
+type
+  { TTICSharedMemory }
+  TTICSharedMemory = class
+  private
+    FPointer:   Pointer;
+    FLastError: DWord;
+    FHandle:    THandle;
+    procedure FreeHandle;
+  public
+    // AName = l'identifiant du fichier partagé en mémoire
+    // ASize = la taille totale des données partagées
+    constructor Create(AName: PChar; ASize: integer);
+    destructor Destroy; override;
+    property LastError: DWord read FLastError;
+   // Pointer = l'adresse de la donnée partagée
+    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,
+, 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.
+</code>
+==== Le Client ====
+Cette unité contient le code du client.\\
+C'est un ''TForm'' avec un ''TMemo'' et un ''TTimer''.\\
+Toutes les secondes il accéde a la mémoire partagé et affiche son contenu dans le ''TMemo''
+<code delphi uFormClient.pas>
+unit uFormClient;
+{$mode objfpc}{$H+}
+interface
+uses
+  SysUtils,
+  Forms,
+  Controls,
+  Graphics,
+  Dialogs,
+  StdCtrls,
+  ExtCtrls,
+  uTICSharedMemory;
+type
+  // La structure qui sera échangée entre les deux applications
+  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.
+</code>
+==== Le Serveur ====
+Un ''TForm'' contenant un ''TEdit''.\\
+Dés que l'on modifie le ''TEdit'' il met a jour la mémoire partagée.
+<code delphi uFormServer.pas>
+unit uFormServer;
+{$mode objfpc}{$H+}
+interface
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
+  uTICSharedMemory;
+type
+  // Structure de données partagée
+  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
+  // Modification de la mémoire partagée
+  FPDatas^.Text:=Edit1.Text+#0;
+  FPDatas^.Size:=length(Edit1.Text);
+  FPDatas^.Date:=now;
+end;
+end.
+</code>
 ===== A voir =====
 <note important>Apparement ''shmat'' est propre a Linux/Unix</note>
   * [[https://www.developpez.net/forums/d1143012/c-cpp/c/memoire-commune-entre-processus-shmat/]]
   * [[https://www.freepascal.org/docs-html/rtl/ipc/shmat.html]]