MitjaStachowiak hat geschrieben:Hast du ein Beispiel dazu?
Hier:
https://gitlab.com/mseide-msegui/mseuni ... /sharedmem
Funktioniert bei mir auf 32 und 64 Bit Linux.
Edit: Habe das Beispiel erweitert.
MitjaStachowiak hat geschrieben:Hast du ein Beispiel dazu?
MitjaStachowiak hat geschrieben:http zur inter-prozess-kommunikation ist irgendwie nicht der richtiger Weg, finde ich. Es soll hier ja nicht über Netzwerk laufen.
m.fuchs hat geschrieben:MitjaStachowiak hat geschrieben:http zur inter-prozess-kommunikation ist irgendwie nicht der richtiger Weg, finde ich. Es soll hier ja nicht über Netzwerk laufen.
HTTP ist eine Möglichkeit für Interprozesskommunikation. Im Gegensatz zu Shared-Memory ist es halt eine Nachrichten-basierte Form.
Hat den Vorteil der besseren Trennung der Prozesse und möglicher Skalierbarkeit. Ist aber langsamer, wenn es um große Datenmengen geht.
Code: Alles auswählen
unit sharedmem;
{
This unit provides simple memory mappings for inter-process communication on
Windows and Linux in a consistent way.
}
{$mode objfpc}{$h+}
interface
uses
Classes, SysUtils{$IFDEF Windows}, Windows{$ENDIF}{$IFDEF Unix}, baseunix {, ipc}{$ENDIF};
function OpenFileMappingSimple(const name:ShortString) : THandle;
function CreateFileMappingSimple(const name:ShortString; Size:QWord) : THandle;
function MapViewOfFileSimple(mapping:THandle; Size:QWord) : Pointer;
procedure UnmapViewOfFileSimple(adr:Pointer; Size:QWord);
procedure CloseFileMappingSimple(const name:ShortString; mapping:THandle);
implementation
{$IFDEF Unix}
const
{$ifdef FPC}clib = 'c';{$else}clib = 'libc.so.6';{$endif}
{$ifdef linux}shmlib = 'rt';{$else}shmlib = clib;{$endif}
O_ACCMODE = $00003;
O_RDONLY = $00000;
O_WRONLY = $00001;
O_RDWR = $00002;
O_CREAT = $00040;//&00100;
O_EXCL = $00080;//&00200;
O_NOCTTY = $00100;//&00400;
O_TRUNC = $00200;//&01000;
O_APPEND = $00400;//&02000;
O_NONBLOCK = $00800;//&04000;
O_NDELAY = O_NONBLOCK;
O_SYNC = $01000;//&010000;
O_FSYNC = O_SYNC;
O_ASYNC = $02000;//&020000;
O_CLOEXEC = $80000;
S_ISUID = $800;
S_ISGID = $400;
S_ISVTX = $200;
S_IRUSR = $100;
S_IWUSR = $80;
S_IXUSR = $40;
type
{$ifdef cpu64}
size_t = QWord;
off_t = QWord;
{$else}
size_t = Cardinal;
off_t = Cardinal;
{$endif}
function shm_open(name: pchar; oflag: longint; mode: Cardinal): longint; cdecl; external shmlib name 'shm_open';
function shm_unlink(name: pchar): longint; cdecl; external shmlib name 'shm_unlink';
function mmap(addr: pointer; lengthint: size_t; prot: longint; flags: longint; fd: longint; offset: off_t): pointer; cdecl; external clib name 'mmap';
function munmap(addr: pointer; length: size_t): longint; cdecl; external clib name 'munmap';
{$ifdef linux}
function ftruncate64(handle: integer; size: int64): integer; cdecl; external clib name 'ftruncate64';
{$else}
function ftruncate64(handle: integer; size: int64): integer; cdecl; external clib name 'ftruncate';
{$endif}
{$endif}
function OpenFileMappingSimple(const name: ShortString): THandle;
var _name : ShortString;
begin
{$IFDEF Windows}
_name := name+#0#0;
Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(@_name[1]));
{$ENDIF}
{$IFDEF Unix}
_name := '/'+name+#0#0;
Result := shm_open(PChar(@_name[1]), O_RDWR, S_IRUSR or S_IWUSR); //Result := shmget(PInteger(@name[1])^, Size, 0);
if (Result < 0) then Result := 0
else Result := Result + 1;
{$ENDIF}
end;
function CreateFileMappingSimple(const name: ShortString; Size: QWord): THandle;
var _name : ShortString;
begin
{$IFDEF Windows}
_name := name+#0#0;
Result := CreateFileMapping(INVALID_HANDLE_VALUE, Windows.LPSecurity_ATTRIBUTES(0), PAGE_READWRITE, 0, Size, PChar(@_name[1]));
{$ENDIF}
{$IFDEF Unix}
_name := '/'+name+#0#0;
Result := shm_open(PChar(@_name[1]), O_RDWR or O_CREAT, S_IRUSR or S_IWUSR); //Result := shmget(PInteger(@name[1])^, Size, IPC_CREAT or 0777);
if (Result < 0) then Result := 0
else begin
ftruncate64(Result, Size);
Result := Result + 1;
end;
{$ENDIF}
end;
function MapViewOfFileSimple(mapping: THandle; Size: QWord): Pointer;
begin
{$IFDEF Windows}
Result := MapViewOfFile(mapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
{$ENDIF}
{$IFDEF Unix}
Result := Fpmmap(nil, Size, PROT_READ or PROT_WRITE, MAP_SHARED, mapping-1, 0); //Result := shmat(mapping, nil, 0);
{$ENDIF}
end;
procedure UnmapViewOfFileSimple(adr: Pointer; Size: QWord);
begin
{$IFDEF Windows}
UnmapViewOfFile(adr);
{$ENDIF}
{$IFDEF Unix}
FPMUnMap(adr, Size); //shmdt(adr);
{$ENDIF}
end;
procedure CloseFileMappingSimple(const name: ShortString; mapping: THandle);
var _name:ShortString;
begin
{$IFDEF Windows}
CloseHandle(mapping);
{$ENDIF}
{$IFDEF Unix}
_name := '/'+name+#0#0;
shm_unlink(PChar(@_name[1])); //shmctl(mapping, IPC_RMID, nil);
{$ENDIF}
end;
end.
Code: Alles auswählen
// required infos
type
TMapInfo = record
Wert1 : Integer;
Wert2 : Integer;
//...
end;
const
mmfName = 'MessdatenUpload';
var
mmfHandle : THandle;
mmfErr : Boolean = false;
isFirstProcess : Boolean = false;
// open/create filemapping
mmfHandle := OpenFileMappingSimple(mmfName);
if (mmfHandle = 0) then begin // auf Linux wird das native Handle +1 gezählt, sodass der invalid-Wert auch 0 ist
inf.isFirstProcess := true;
mmfHandle := CreateFileMappingSimple(mmfName, SizeOf(TMapInfo));
if (mmfHandle = 0) then mmfErr := true;
end;
if (not mmfErr) then begin
mmf := MapViewOfFileSimple(mmfHandle, SizeOf(TMapInfo));
// do something with the mapping
end;
// close filemapping
if (not mmfErr) then begin
UnmapViewOfFileSimple(mmf, SizeOf(TMapInfo));
CloseFileMappingSimple(mmfName, mmfHandle);
end;
mmf := nil;
mmfHandle := 0;