23.01.2013, 13:36
|
Новичок
|
|
Регистрация: 15.01.2010
Сообщения: 83
Репутация: 10
|
|
вот код, работает
Код:
////////////////////////////////////////////////////////////////////////////////
//
// Демо работы с Файлами отображенными в память процесса
// Автор: Александр (Rouse_) Багель
// © Fangorn Wizards Lab 1998 - 2003
// 23 мая 2003 17:06
// Закоментированные строки содержат пример передачи структуры
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
MMFID = '{D9CFD3BD-3E91-4748-B9F9-7A1825847DF7}';
type
PTestStructure = ^TTestStructure;
TTestStructure = packed record
A: Integer;
B: double;
end;
TForm1 = class(TForm)
btnCreate: TButton;
btnAdd: TButton;
btnClose: TButton;
btnOpen: TButton;
btnRead: TButton;
btnCloseOpen: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
procedure btnAddClick(Sender: TObject);
private
TextAdded, // Два флага для
IsOpenFile: Boolean; // для управления состоянием кнопок
SendMMF, RecMMF: THandle;
SendData, RecData: PChar;
procedure ButtonState(const btnState: Integer);
function OpenSendMMF: Boolean;
function AddText: Boolean;
function CloseSend: Boolean;
function OpenRecMMF: Boolean;
function ReadText: Boolean;
function CloseRec: Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Управляем состоянием кнопок
// Кнопки становятся доступными в тот момент, когда текущая операция,
// содержащаяся в обработчике кнопки, возможна ...
// =============================================================================
procedure TForm1.ButtonState(const btnState: Integer);
begin
case btnState of
0:
begin
btnAdd.Enabled := True;
btnClose.Enabled := True;
btnOpen.Enabled := True;
end;
1:
begin
TextAdded := True;
btnRead.Enabled := IsOpenFile;
end;
2:
begin
TextAdded := False;
btnAdd.Enabled := False;
btnClose.Enabled := False;
btnOpen.Enabled := False;
btnRead.Enabled := False;
btnCloseOpen.Enabled := False;
end;
3:
begin
IsOpenFile := True;
btnCloseOpen.Enabled := True;
btnRead.Enabled := TextAdded;
end;
5:
begin
IsOpenFile := False;
btnRead.Enabled := False;
btnCloseOpen.Enabled := False;
end;
end;
end;
// Общий обработчик для всех кнопок ...
// =============================================================================
procedure TForm1.btnAddClick(Sender: TObject);
var
State: Boolean;
begin
State := False;
case TComponent(Sender).Tag of
0: State := OpenSendMMF;
1: State := AddText;
2: State := CloseSend;
3: State := OpenRecMMF;
4: State := ReadText;
5: State := CloseRec;
end;
if State then
ButtonState(TComponent(Sender).Tag);
end;
// Создаем Memory Mapped File ...
// =============================================================================
function TForm1.OpenSendMMF: Boolean;
begin
SendMMF := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 4096,
PChar(MMFID));
Result := SendMMF <> 0;
end;
// Добавляем в файл текст ...
// (передача структуры находится в закоментированных строках кода)
// =============================================================================
function TForm1.AddText: Boolean;
var
F: TTestStructure;
Z: PTestStructure;
begin
// SendData := MapViewOfFile(SendMMF, FILE_MAP_WRITE, 0, 0, 0);
// Result := SendData <> nil;
// StrPCopy(SendData, memSender.Text);
F.A := StrToInt(Edit1.Text);
F.B := StrToFloat(Edit2.Text);
Z := MapViewOfFile(SendMMF, FILE_MAP_WRITE, 0, 0, 0);
Result := Z <> nil;
Z^ := F;
end;
// Разрушаем Memory Mapped File ...
// =============================================================================
function TForm1.CloseSend: Boolean;
begin
if btnCloseOpen.Enabled then CloseRec;
UnmapViewOfFile(SendData);
SendData := nil;
CloseHandle(SendMMF);
Result := True;
end;
// Открываем созданный ранее Memory Mapped File ...
// =============================================================================
function TForm1.OpenRecMMF: Boolean;
begin
RecMMF := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MMFID));
Result := RecMMF <> 0;
end;
// Читаем из него данные ...
// (прием структуры находится в закоментированных строках кода)
// =============================================================================
function TForm1.ReadText: Boolean;
var
F: TTestStructure;
Z: PTestStructure;
begin
// RecData := MapViewOfFile(RecMMF, FILE_MAP_ALL_ACCESS, 0, 0, 0);
// Result := RecData <> nil;
// memReceive.Text := RecData;
Z := MapViewOfFile(SendMMF, FILE_MAP_ALL_ACCESS, 0, 0, 0);
F := Z^;
Result := Z <> nil;
Edit3.Text := Inttostr(F.A);
Edit4.Text := Floattostr(F.B);
end;
// Закрываем (не разрушаем) Memory Mapped File ...
// =============================================================================
function TForm1.CloseRec: Boolean;
begin
UnmapViewOfFile(RecData);
RecData := nil;
CloseHandle(RecMMF);
Result := True;
end;
end.
|