在 Delphi 中的多个应用程序之间共享一个对象

Question

我正在尝试弄清楚如何在 Delphi 中的多个应用程序之间共享一个对象。我知道这样做的方法是通过 IPC/windows 共享内存调用（即 CreateFileMapping 等），但是在所有示例代码中我发现它们使用像字符串这样的简单类型，而我需要共享一个对象。

我想知道这是否可能，因为我一直以一个只共享对象指针引用而非对象内存本身的应用程序结束。当我尝试从我的其他应用程序检索然后访问该对象时，我遇到了访问冲突。我认为这是因为指针指的是来自其他应用程序的受保护内存。

这是我迄今为止尝试过的代码（如您所见，我正在尝试在多个应用程序之间共享一个 TADOConnection 对象，以便应用程序之间只有一个数据库连接 used/shared）。如果有 better/simpler 方法可以做到这一点（共享 ADO 连接），我很想知道如何做到这一点。

  TSharedData = record
    Connection: TAdoConnection;
  end;

  PSharedData = ^TSharedData;

var
  SharedData: PSharedData;
  hFileMapping: THandle;  
  Form1: TForm1;

implementation

{$R *.dfm}

function CreateNamedFileMapping(const Name: String): THandle;
begin
  Result := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0,
    SizeOf(TSharedData)*8, PChar(Name));

  if Result > 0 then
    SharedData := MapViewOfFile(Result, FILE_MAP_ALL_ACCESS, 0, 0, 0);
end;

function GetSharedData: PSharedData;
begin
  result := nil;
  hFileMapping := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, 'MySharedMemory');
  if (hFileMapping > 0) then
    Result := MapViewOfFile(hFileMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
end;

procedure TForm1.createClick(Sender: TObject);
begin
   hFileMapping := CreateNamedFileMapping('MySharedMemory');
   if (hFileMapping > 0) and Assigned(SharedData) then
   begin
     SharedData^.Connection := TAdoConnection.Create(nil);
     // can't use Assign as it is not supported by _Connection
     SharedData^.Connection.ConnectionObject := AdoConnection1.ConnectionObject;
   end;
end;

procedure TForm1.retrieveClick(Sender: TObject);
begin
   SharedData := GetSharedData;
  if assigned(SharedData) then
    // should be set to true if everything was ok
    ShowMessage(BoolToStr( SharedData.Connection.Connected, true));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   AdoConnection1.Connected := False;

  if assigned(SharedData) then
    UnmapViewOfFile(SharedData);
  if hFileMapping > 0 then
    CloseHandle(hFileMapping);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  AdoConnection1.Connected := true;
end;

end.

ADOConnection1 是我表单上的一个对象。我知道我需要使用 "Assign" 之类的东西来复制整个对象内存，但这在 ADO ConnectionObject 上不存在。为了确保问题不只是 ConnectionObject，我还尝试传递一个简单的对象，如 TStringlist，然后使用 assign 复制内存，但它仍然在应用程序 #2 中获取 AV。

如果我运行在同一个应用程序中创建和检索它工作正常。当我复制此应用程序和应用程序 #1 中的运行 "create" 函数和应用程序 #2 中的 "retrieve" 时，我遇到了访问冲突。

Answer 1

已在评论中确定无法在不同进程之间共享对象。我稍微简化了您的测试用例，以便能够弄清楚为什么会这样。

在这个版本中，共享失败的对象是比ADOConnection简单得多的对象，只有一个整型字段。应用程序的第一个实例创建一个映射并写入一个包含整数、对象和字符串字段的记录。应用程序的任何后续实例都会尝试检索并显示该信息。

unit Unit1;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TSimpleObject = class(TObject)
  private
    FInt: Integer;
  end;

  TSharedData = record
    Int: Integer;
    SimpleObject: TSimpleObject;
    Str: string;
  end;
  PSharedData = ^TSharedData;

var
  SharedData: PSharedData;
  hFileMapping: THandle;

const
  MapName = 'MySharedMemory';

procedure TForm1.FormCreate(Sender: TObject);
var
  MapExists: Boolean;
begin
  hFileMapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,
      0, SizeOf(TSharedData), MapName);
  Win32Check(hFileMapping <> 0);
  MapExists := GetLastError = ERROR_ALREADY_EXISTS;

  SharedData := MapViewOfFile(hFileMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  Win32Check(SharedData <> nil);

  if MapExists then begin
    ShowMessage(IntToStr(SharedData.Int));
    ShowMessage(IntToStr(SharedData.SimpleObject.FInt));
    ShowMessage(SharedData.Str);
  end else begin
    SharedData.Int := 555;
    SharedData.SimpleObject := TSimpleObject.Create;
    SharedData.SimpleObject.FInt := 666;
    SharedData.Str := 'test string';
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Win32Check(CloseHandle(hFileMapping));
  Win32Check(UnmapViewOfFile(SharedData));
end;

应用程序的第二个实例将能够正确显示第一个值，即记录的整数字段。但是，它会因对象的整数字段或记录的字符串字段而失败。它将引发访问冲突或显示不正确的值。

我在表格上放了一个备忘录并转储了一些内存地址以便能够看到发生了什么。

procedure TForm1.FormCreate(Sender: TObject);
var
  MapExists: Boolean;
begin
  Memo1.Clear;
  hFileMapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,
      0, SizeOf(TSharedData), MapName);
  Win32Check(hFileMapping <> 0);
  MapExists := GetLastError = ERROR_ALREADY_EXISTS;

  SharedData := MapViewOfFile(hFileMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  Win32Check(SharedData <> nil);

  if MapExists then begin
    Memo1.Lines.Add(Format('Found at %p', [SharedData]));
//    ShowMessage(IntToStr(SharedData.Int));
//    ShowMessage(IntToStr(SharedData.SimpleObject.FInt));
//    ShowMessage(SharedData.Str);
  end else begin
    Memo1.Lines.Add(Format('Created at %p', [SharedData]));
    SharedData.Int := 555;
    SharedData.SimpleObject := TSimpleObject.Create;
    SharedData.SimpleObject.FInt := 666;
    SharedData.Str := 'test string';
  end;
  Memo1.Lines.Add('');
  Memo1.Lines.Add(Format('@SharedData.Int: %p', [@SharedData.Int]));
  Memo1.Lines.Add(Format('PInteger(@SharedData.Int)^: %d', [PInteger(@SharedData.Int)^]));
  Memo1.Lines.Add('');
  Memo1.Lines.Add(Format('@SharedData.SimpleObject: %p', [@SharedData.SimpleObject]));
  Memo1.Lines.Add(Format('@SharedData.SimpleObject.FInt: %p', [@SharedData.SimpleObject.FInt]));
  Memo1.Lines.Add(Format('PInteger(@SharedData.SimpleObject.FInt)^: %d', [PInteger(@SharedData.SimpleObject.FInt)^]));
  Memo1.Lines.Add('');
  Memo1.Lines.Add(Format('Pointer(@SharedData.Str)^: %p', [Pointer(Pointer(@SharedData.Str)^)]));
  Memo1.Lines.Add('character payload');
  Memo1.Lines.Add('PChar(Pointer(SharedData.Str)): ' + PChar(Pointer(SharedData.Str)));
end;

下图，左边是应用的第一个实例，右边是第二个实例。请注意，第二个实例可能需要几次尝试才能在没有访问冲突的情况下显示。

第一行是地图的起始地址。请注意，它们在两种情况下都不相同（但是它们有可能相同）。这与我们的案例无关，但却是 documentation of MapViewOfFile 警告的原因：

Do not store pointers in the memory mapped file; store offsets from the base of the file mapping so that the mapping can be used at any address.

第二行是共享记录的整型域地址。在这两种情况下，这都等于映射内存的起始地址。这是预期的，因为它是记录的第一个字段。以下行将该地址中保存的值转储为整数，它们看起来很好。

第四行转储记录中包含的对象的地址。对于这两种情况，这都是从映射开头偏移四个字节。看起来对吗？继续下一行，它转储对象中包含的整数字段的地址。

class 的整型字段地址有两点值得警惕。首先，它们在两种情况下都是平等的。这不应该是这种情况，因为地图文件根本不是从相同的地址开始的。其次，它们远离地图文件的地址。毕竟我们保留了 12 个字节，而不是 34 兆字节。

原因是，对象引用（在前一行中转储了地址）实际上是指向位于其他地方的对象实例的指针，并且该指针指向映射内存之外的位置分割。这对于第一个实例来说不是问题，因为它是分配内存的进程。然而，对于第二种情况，该地址具有完全不同的含义。且不说该地址中没有对象，甚至有可能该地址不可读。转储的整数值与预期值不同也就不足为奇了。

上一段转储记录的字符串字段也是同理。字符串payload应该是的地址和第二个进程意义完全不同

Assign不会帮助对象字段，它将指定源对象的属性和其他属性复制到当前对象，它不会重新定位或复制对象的实例。但是人们可能想知道是否可以使用在已知地址上定义的实例内存来创建对象，例如通过覆盖 NewInstance。不幸的是，对于任何比本例中的对象稍微复杂一点的东西，这也是不可能的。不可能在单个内存块中包含对象运行所需的所有内存。例如，对于您尝试共享的 ADOConnection，ConnectionObject 是另一个指针。

在 Delphi 中的多个应用程序之间共享一个对象

sharing an object between multiple applications in Delphi

delphi

ipc

shared-memory