Autor Beitrag
delfiphan
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 2684
Erhaltene Danke: 32



BeitragVerfasst: Mi 01.09.10 10:44 
Einfache Wrapper Klasse für MMFs. Sowas wie ein GetMem, wobei man dem Block einen Namen geben kann. Instanzen, die gleiche Namen geben, kriegen auch den gleichen Inhalt des Memoryblocks (die Pointers sind jedoch verschieden). Funktioniert auch über Prozessgrenzen hinweg.

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
unit SharedMem;

interface

type
  // Manages shared memory block
  TSharedMemory = class
  private
    FName: string;
    FSize: Cardinal;
    FMemory: Pointer;
    FHandle: THandle;
  public
    constructor Create(const Name: string; Size: Cardinal); overload;
    constructor Create(Size: Cardinal); overload;
    destructor Destroy; override;
    property Name: string read FName;
    property Size: Cardinal read FSize;
    property Memory: Pointer read FMemory;
  end;

implementation

uses Windows, SysUtils, Classes;

function CreateGuid: string;
var
  ID: TGUID;
begin
  Result := '';
  if SysUtils.CreateGuid(ID) = S_OK then
    Result := GUIDToString(ID);
end;

{ TSharedMemory }

constructor TSharedMemory.Create(const Name: string; Size: Cardinal);
begin
  FHandle := CreateFileMapping(INVALID_HANDLE_VALUE, nil,
    PAGE_READWRITE, 0, Size, PChar(Name));
  if FHandle = 0 then
    RaiseLastOSError;

  FMemory := MapViewOfFile(FHandle, FILE_MAP_WRITE, 000);
  if FMemory = nil then
    RaiseLastOSError;

  FName := Name;
end;

constructor TSharedMemory.Create(Size: Cardinal);
begin
  Create(CreateGuid, Size);
end;

destructor TSharedMemory.Destroy;
begin
  if FMemory <> nil then
    UnmapViewOfFile(FMemory);

  if FHandle <> 0 then
    CloseHandle(FHandle);
  inherited;
end;

end.


Test für Inhalt gleich, Pointer unterschiedlich:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
const
  Name = '{278F084C-2B08-4123-915B-C253226C91C2}';
var
  SharedMemory1, SharedMemory2: TSharedMemory;
  S1, S2: ^ShortString;
begin
  SharedMemory1 := nil;
  SharedMemory2 := nil;
  try
    SharedMemory1 := TSharedMemory.Create(Name, SizeOf(S1^));
    SharedMemory2 := TSharedMemory.Create(Name, SizeOf(S2^));

    S1 := SharedMemory1.Memory;
    S2 := SharedMemory2.Memory;

    S1^ := 'foo';
    Assert(S1^ = 'foo');
    Assert(S2^ = 'foo');

    S2^ := 'bar';
    Assert(S1^ = 'bar');
    Assert(S2^ = 'bar');

    Assert(S1 <> S2);
  finally
    SharedMemory1.Free;
    SharedMemory2.Free;
  end;
end;

Für diesen Beitrag haben gedankt: BenBE, spawn89