|
15番会議室「FAQ編纂委員会」に寄せられた「よくある質問の答え」
[Q]
Win32 ではWin16 のようなDLLのグローバル変数を使った共有や,GlobalAlloc
によるプロセス間のメモリの共有ができません.何か方法はありませんか?
[A]
Win32では基本的にプロセスごとのアドレス空間は独立しており,他のプロセス
のメモリはたとえDLLであろうとも見れません.これは他のアプリを巻き添えに
してクラッシュさせることを防ぐためです.
共有メモリを使いたければメモリマップドファイルという,ファイルとメモリ
の中間のような仕組みを使います.以下に「ファイルを作らない」メモリ
マップドファイルを使って複数のプロセスの間でメモリを共有することが
できるストリームオブジェクトの実装例を示します.
使い方は生成時にメモリ領域に名前とサイズを指定する以外は通常の
TStream そのものです.同じ名前の領域が既に存在すれば,サイズ指定
は無視されて,同じ領域にマッピングされます.
TCommonMemoryStreamを使うと,プロセス間でダイナミックにコンポーネント
をやりとりすることなどが簡単にできるようになります.
もちろんストリームとして扱わずにポインタを生でいじっても良いですが,
その場合はTCommonMemoryStreamのコンストラクタのコードを参考にして下さい.
[例]
1)フォームにボタンを3個貼り付けたら,以下のハンドラをアタッチして下さい.
2)ComMem.pasを作って,unit1でusesして下さい
3)コンパイルして実行します.
4)Button1 を押すとShapeができます.2回押すと消えます.
5)エクスプローラから project1.exeをダブルクリックして,複数のプロセス
を立ち上げます.
6)新しいプロセスの方で Button2 を押すと,あら不思議,同じShapeがこつ然と
現れます.
7)Button3 を押すとShapeの色が変わりますが,もう一方のプロセスで
Button2を押して読み込み直すと反映されているのがわかります.
--------------共有メモリストリーム--------------------
unit ComMem;
{$R-}
interface
uses SysUtils, Windows, Classes;
type
{ TCommonMemoryStream class }
TCommonMemoryStream = class(TStream)
protected
FMemory: Pointer;
FHandle: Integer;
FSize, FPosition: Longint;
public
constructor Create(const Name: string; Size: Longint);
destructor Destroy; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
procedure SaveToStream(Stream: TStream);
procedure SaveToFile(const FileName: string);
property Handle: Integer read FHandle;
property Memory: Pointer read FMemory;
property Size: Longint read FSize;
end;
implementation
constructor TCommonMemoryStream.Create(const Name: string; Size: Longint);
begin
// ファイル無しのメモリマップドファイルを作成
FHandle := CreateFileMapping( $FFFFFFFF, nil, PAGE_READWRITE,
0, Size, PChar(Name));
if FHandle < 0 then
raise EFCreateError.Create('共有メモリ['+Name+']を開けません')
else begin
FMemory := MapViewOfFile(FHandle,
FILE_MAP_READ or FILE_MAP_WRITE, 0, 0, 0);
FSize := Size;
FPosition := 0;
end;
end;
destructor TCommonMemoryStream.Destroy;
begin
if Handle >= 0 then begin
UnmapViewOfFile(FMemory);
CloseHandle(Handle);
end;
end;
function TCommonMemoryStream.Read(var Buffer; Count: Longint): Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Result := FSize - FPosition;
if Result > 0 then
begin
if Result > Count then Result := Count;
Move(Pointer(Longint(FMemory) + FPosition)^, Buffer, Result);
Inc(FPosition, Result);
Exit;
end;
end;
Result := 0;
end;
function TCommonMemoryStream.Write(const Buffer; Count: Longint): Longint;
var
Pos: Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Pos := FPosition + Count;
if Pos > 0 then
begin
if Pos > FSize then
begin
raise EAccessViolation.Create( '共有メモリを逸脱した書き込み');
end;
System.Move(Buffer, Pointer(Longint(FMemory) + FPosition)^, Count);
FPosition := Pos;
Result := Count;
Exit;
end;
end;
Result := 0;
end;
function TCommonMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
case Origin of
0: FPosition := Offset;
1: Inc(FPosition, Offset);
2: FPosition := FSize + Offset;
end;
Result := FPosition;
end;
procedure TCommonMemoryStream.SaveToStream(Stream: TStream);
begin
if FSize <> 0 then Stream.WriteBuffer(FMemory^, FSize);
end;
procedure TCommonMemoryStream.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
end.
---------使い方の例-----------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ComMem, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
Strm: TStream;
Shape: TShape;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormDestroy(Sender: TObject);
begin
Strm.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Strm := TCommonMemoryStream.Create('MyMem', 20 * 1024);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Shape <> nil then begin
Shape.Free;
Shape := nil;
end else begin
Shape := TShape.Create(Self);
with Shape do begin
Left := 10;
Top := 10;
Parent := Self;
Brush.Color := clRed;
end;
Strm.WriteComponent(Shape);
Strm.Seek(0,0);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
RegisterClass(TShape);
Shape.Free;
Shape := TShape.Create(Self);
Strm.ReadComponent(Shape);
Strm.Seek(0,0);
Shape.Parent := Self;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if Shape <> nil then begin
Shape.Brush.Color := not Shape.Brush.Color;
Strm.WriteComponent(Shape);
Strm.Seek(0,0);
end;
end;
end.
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum FDELPHIに寄せられる質問の中から、よくある質問への回答を FDELPHIのメンバーがまとめたものです。 したがって、これらの回答はボーランド株式会社がサポートする公式のものではなく、掲示されている内容についての問い合わせは受けられない場合があります。
Copyright 1996-1998 Delphi Users' ForumFAQ編纂委員会
|