Author: Bertrand Goetzmann
How several processes can share memory to cooperate ?
Answer:
The unit bellow shows how use a file-mapping object to set up memory that can be
shared by processes that load the DLL. The shared DLL memory persists only as long
as the DLL is loaded. This unit is the translation of the DLLSHMEM.C example from
the Win32 Developer's Reference help file (see DLLSHMEM)
The SetSharedMem and GetSharedMem functions must be exported in a dll Delphi
project. If we can't create the file-mapped shared memory ExitCode variable is set
to 1 or 2. Tested with Delphi 6, under Windows 2000.
1 unit SharedMem;
2
3 // Using Shared Memory in a Dynamic-Link Library
4 //
5 // This unit shows how use a file-mapping object to set up memory that can be
6 shared by processes that load the DLL.
7 // The shared DLL memory persists only as long as the DLL is loaded.
8 //
9 // This unit is the translation of the DLLSHMEM.C example from the W32 Developer's
10 Reference help file (see DLLSHMEM)
11 //
12 // The SetSharedMem and GetSharedMem functions must be exported in a dll Delphi
13 project.
14 // If we can't create the file-mapped shared memory ExitCode variable is set to 1
15 or 2.
16 // Tested with Delphi 6, under Windows 2000.
17 //
18 // Written by Bertrand Goetzmann (http://www.object-everywhere.com)
19 // Keywords : Shared-Memory DLL CreateFileMapping MapViewOfFile UnmapViewOfFile
20
21 interface
22
23 procedure SetSharedMem(lpszBuf: PChar);
24 procedure GetSharedMem(lpszBuf: PChar; cchSize: Integer);
25
26 implementation
27
28 uses Windows, SysUtils;
29
30 // Using Shared Memory in a Dynamic-Link Library
31 // The DLL sets up shared memory using a named file-mapping object.
32
33 const
34 SHMEMSIZE = 4096;
35
36 var
37 hMapObject: THandle;
38 lpvMem: Pointer; // pointer to shared memory
39
40 procedure Init;
41 var
42 fInit: Boolean;
43 begin
44 hMapObject := 0; // handle to file mapping
45
46 // The DLL is loading due to process
47 // initialization or a call to LoadLibrary.
48
49 // Create a named file mapping object.
50
51 hMapObject := CreateFileMapping(
52 $FFFFFFFF, // use paging file
53 nil, // no security attributes
54 PAGE_READWRITE, // read/write access
55 0, // size: high 32-bits
56 SHMEMSIZE, // size: low 32-bits
57 'dllmemfilemap'); // name of map object
58
59 if hMapObject = 0 then
60 begin
61 ExitCode := 1;
62 Exit;
63 end;
64
65 // The first process to attach initializes memory.
66
67 fInit := GetLastError <> ERROR_ALREADY_EXISTS;
68
69 // Get a pointer to the file-mapped shared memory.
70
71 lpvMem := MapViewOfFile(
72 hMapObject, // object to map view of
73 FILE_MAP_WRITE, // read/write access
74 0, // high offset: map from
75 0, // low offset: beginning
76 0); // default: map entire file
77
78 if lpvMem = nil then
79 begin
80 ExitCode := 2;
81 Exit;
82 end;
83
84 // Initialize memory if this is the first process.
85
86 if fInit then
87 FillChar(lpvMem^, SHMEMSIZE, 0);
88 end;
89
90 procedure Terminate;
91 begin
92 // Unmap shared memory from the process's address space.
93
94 if lpvMem <> nil then
95 UnmapViewOfFile(lpvMem);
96
97 // Close the process's handle to the file-mapping object.
98
99 if hMapObject <> 0 then
100 CloseHandle(hMapObject);
101 end;
102
103 // SetSharedMem sets the contents of shared memory.
104
105 procedure SetSharedMem(lpszBuf: PChar);
106 begin
107 Move(lpszBuf^, lpvMem^, StrLen(lpszBuf));
108 end;
109
110 // GetSharedMem gets the contents of shared memory.
111
112 procedure GetSharedMem(lpszBuf: PChar; cchSize: Integer);
113 begin
114 Move(lpvMem^, lpszBuf^, cchSize);
115 end;
116
117 initialization
118 Init;
119
120 finalization
121 Terminate;
122
123 end.
Component Download:
http://objecteverywhere.chez.tiscali.fr/SMem.zip
|
