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; |