PHP DM Gate v0.9 » Последовательный доступ к MMF <span class="vd">[D7, XP]</span>

Сергей М. © (21.07.09 23:04) [20]

Михалыч, ты на вопрос в [18] соизволишь ответить ?)

<Цитата>
antonn © (22.07.09 00:29) [21]

вместо $FFFFFFFF правильнее использовать INVALID_HANDLE_VALUE

<Цитата>
Игорь Шевченко © (22.07.09 01:11) [22]

antonn © (22.07.09 00:29) [21]

> вместо $FFFFFFFF правильнее использовать INVALID_HANDLE_VALUE

const
INVALID_HANDLE_VALUE = DWORD(-1);

почему правильнее ?

<Цитата>
antonn © (22.07.09 01:22) [23]

потому что на 64-битной системе будет не -1 :)

<Цитата>
Игорь Шевченко © (22.07.09 02:05) [24]

antonn © (22.07.09 01:22) [23]

До Delphi 64 еще дожить надо. Хотя специально посмотрел в своих промышленных проектах - таки INVALID_HANDLE_VALUE использую.

Значит, ты прав :)

<Цитата>
Юрий Зотов © (22.07.09 02:06) [25]

> Muxa/Ibl4 (21.07.09 22:33) [17]

Лови, я сегодня добрый. И давно на Delphi не писал, соскучился даже - вот и захотелось размяться слегка. Писал в Delphi 7.

Только не копируй бездумно - разберись в каждой строчке и в каждой букве - что она делает, зачем она это делает, как она это делает и почему она это делает именно тут, а не в другом месте. Справка и MSDN тебе в помощь, там все описано. А что останется неясным - спрашивай здесь.

1. Полный код общего юнита (используется и в DLL, и в тестовой программе)

unit DataType;

interface

type
TData = packed record
Int: integer;
Str: ShortString
end;

PData = ^TData;

TWriteData = procedure(Source: PData); stdcall;
TReadData = function: PData; stdcall;

const
DLL_NAME = 'MMF_DLL';
ReadDataProcName = 'ReadData';
WriteDataProcName = 'WriteData';

implementation

end.

2. Полный код DLL

library MMF_DLL;

uses
Windows,
SysUtils,
DataType in 'DataType.pas';

const
MMF_NAME = 'MySharedData';

var
HData: THandle = 0;
DataPtr: PData = nil;

procedure EntryProc;
begin
HData := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TData), MMF_NAME);
Win32Check(HData <> 0);
DataPtr := MapViewOfFile(HData, FILE_MAP_ALL_ACCESS, 0, 0, 0);
Win32Check(DataPtr <> nil)
end;

procedure ExitProc;
begin
UnmapViewOfFile(DataPtr);
CloseHandle(HData)
end;

procedure MyDllProc(Reason: integer);
begin
case Reason of
DLL_PROCESS_ATTACH: EntryProc;
DLL_PROCESS_DETACH: ExitProc
end
end;

procedure WriteData(Source: PData); stdcall;
begin
DataPtr^ := Source^
end;

function ReadData: PData; stdcall;
begin
Result := DataPtr
end;

exports
ReadData name ReadDataProcName,
WriteData name WriteDataProcName;

begin
if @DllProc = nil then
DllProc := MyDllProc;
MyDllProc(DLL_PROCESS_ATTACH)
end.

3. Код главной формы тестовой программы (на форму бросить 2 кнопки и назначить им OnClick)

uses
DataType;

var
Data: TData;
HLib: THandle = 0;
ReadData: TReadData = nil;
WriteData: TWriteData = nil;

procedure TForm1.FormCreate(Sender: TObject);
begin
HLib := LoadLibrary(DLL_NAME);
Win32Check(HLib <> 0);
@ReadData := GetProcAddress(HLib, ReadDataProcName);
Win32Check(@ReadData <> nil);
@WriteData := GetProcAddress(HLib, WriteDataProcName);
Win32Check(@WriteData <> nil);
Randomize
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeLibrary(HLib)
end;

procedure TForm1.ReadButtonClick(Sender: TObject);
begin
Data := ReadData^;
Caption := Format('Прочитано: < %d %s >', [Data.Int, Data.Str])
end;

procedure TForm1.WriteButtonClick(Sender: TObject);
begin
Data.Int := Random(10);
if Data.Int > 4 then
Data.Str := 'Привет Богам!'
else
Data.Str := 'А DLL-то одна!';
WriteData(@Data);
Caption := Format('Записано: < %d %s >', [Data.Int, Data.Str])
end;

4. Что с этим делать.

Вначале все компилируем в один каталог (любой). Потом запускаем 2 копии тестовой программы и в обоих жмем кнопки Write и Read. Убеждаемся, что каждая программа читает из MMF точно то, что перед этим в MMF записала либо она сама же, либо другая программа.

PS
И богам своим покажи. Решение они приняли, панимашь... обхохотаться можно над такими решениями.

<Цитата>
Германн © (22.07.09 02:48) [26]

> Юрий Зотов © (22.07.09 02:06) [25]
>
> > Muxa/Ibl4 (21.07.09 22:33) [17]
>
> Лови, я сегодня добрый. И давно на Delphi не писал

Я точно не буду таким добрым. :)

<Цитата>
Юрий Зотов © (22.07.09 02:49) [27]

Небольшой комментарий. По сути, процедура WriteData не нужна. После загрузки DLL тестовая программа может вызвать функцию ReadData, от нее получить указатель на общую область памяти и запомнить этот указатель - таким образом, она получает прямой доступ к этой общей области и может писать в нее (и читать из нее) что угодно, без всяких посредников.

В таком варианте функцию ReadData правильнее было бы обозвать, например, GetDataAddress, а в тестовой программе вместо переменной Data:TData ввести переменную DataAddress:PData.

<Цитата>