お知らせ

電子会議

ライブラリ

FDelphi サイト全文検索

Delphi FAQ一覧

サンプル蔵



FDelphi FAQ
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編纂委員会