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.
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
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;
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, 0, 0, 0);
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:
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; |
