/
smem.pas
100 lines (87 loc) · 2.02 KB
/
smem.pas
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
unit smem;
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
interface
uses
registry;
type
TCtrlMemory = record
inps, rate: Int32;
freq: array [0..7] of Int32;
end;
TDataMemory = array [0..7, 0..4095, 0..1] of Single;
TSharedMemory = record
public
ctrl: ^TCtrlMemory;
data: ^TDataMemory;
rgst: TRegistry;
name: array [0..1023] of Char;
function Open: TRegistry;
procedure Close;
procedure Notify;
function Wait: Boolean;
private
mapping: THandle;
event: THandle;
end;
implementation
uses
sysutils,
windows;
function TSharedMemory.Open: TRegistry;
var
n, s: Int32;
p: PChar;
begin
n := 0;
s := GetModuleFileName(MainInstance, name, SizeOf(name));
if s <> 0 then
begin
p := StrRScan(name, '.');
if p <> nil then p^ := #0;
p := StrRScan(name, '_');
if p <> nil then n := StrToIntDef(p + 1, 0);
end;
try
name := Format('SDR_SMEM_%d_MEM', [n]);
mapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0,
SizeOf(TCtrlMemory) + SizeOf(TDataMemory), name);
WinCheck(mapping <> 0);
name := Format('SDR_SMEM_%d_EVT', [n]);
event := CreateEvent(nil, True, False, name);
WinCheck(event <> 0);
ctrl := MapViewOfFile(mapping, FILE_MAP_WRITE, 0, 0, 0);
WinCheck(ctrl <> nil);
name := Format('\Software\SDR_SMEM_%d', [n]);
rgst := TRegistry.Create;
rgst.OpenKey(name, True);
name := Format('SMEM %d', [n]);
except
Close;
Result := nil;
Exit;
end;
data := Pointer(ctrl) + SizeOf(TCtrlMemory);
Result := rgst;
end;
procedure TSharedMemory.Close;
begin
rgst.Free;
if ctrl <> nil then UnmapViewOfFile(ctrl);
if event <> 0 then CloseHandle(event);
if mapping <> 0 then CloseHandle(mapping);
ctrl := nil;
data := nil;
end;
function TSharedMemory.Wait: Boolean;
begin
if event = 0 then Exit(False);
ResetEvent(event);
Result := WaitForSingleObject(event, 100) <> WAIT_TIMEOUT;
end;
procedure TSharedMemory.Notify;
begin
if event = 0 then Exit;
SetEvent(event);
end;
end.