请问delphi怎么访问其他程序创建的共享内存？？

Question

我的服务器上有一段共享内存，这段共享内存是一个由C语言编写的程序创建的；现在的问题是：我想在delphi写的程序里面访问这个共享内存，请问要怎么做？？最好详细点。^_^。

Answer 1

给个Unit 对你有用
unit SharedMemory;interfaceuses
  Windows, Messages, SysUtils, StdCtrls, Classes, Graphics, Controls, Forms, Dialogs;type
  TSharedMemory = class(TComponent)
  private
    hFileMapping: THandle;
    FHandle: string;
    lp: pointer;
    FSize: integer;
    procedure SetContents(const Value: string);
    procedure SetHandle(const Value: string);
    function GetContents: string;
    procedure SetSize(const Value: integer);
    function GetContentsObj: TObject;
    procedure SetContentsObj(const Value: TObject);
    function GetContentsComp: TComponent;
    procedure SetContentsComp(const Value: TComponent);
    function GetContentsEdit: TEdit;
    procedure SetContentsEdit(const Value: TEdit);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Contents: string read GetContents write SetContents;
    property ContentsObj: TObject read GetContentsObj write SetContentsObj;
    property ContentsComp: TComponent read GetContentsComp write SetContentsComp;
    property ContentsEdit: TEdit read GetContentsEdit write SetContentsEdit;
  published
    property Handle: string read FHandle write SetHandle;
    property Size: integer read FSize write SetSize default 255;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Silicon Commander', [TSharedMemory]);
end;constructor TSharedMemory.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSize := 255;
end;destructor TSharedMemory.Destroy;
begin
  inherited Destroy;
  if lp <> nil then
    UnmapViewOfFile(lp);
  if hFileMapping <> 0 then
    CloseHandle(hFileMapping);
end;function TSharedMemory.GetContents: string;
begin
  if lp = nil then
    Result := ''
  else
    Result := StrPas(lp);
end;function TSharedMemory.GetContentsComp: TComponent;
begin
  if lp = nil then
    Result := nil
  else
    Result := TComponent(lp);
end;function TSharedMemory.GetContentsEdit: TEdit;
begin
  if lp = nil then
    Result := nil
  else
    Result := TEdit(lp);
end;function TSharedMemory.GetContentsObj: TObject;
begin
  if lp = nil then
    Result := nil
  else
    Result := TObject(lp);
end;procedure TSharedMemory.SetContents(const Value: string);
begin
  if (csDesigning in ComponentState) then
    Exit;
(* If a mapping does not exist, do nothing *)
  if lp = nil then
    Exit;
  StrPCopy(lp, Value);
end;procedure TSharedMemory.SetContentsComp(const Value: TComponent);
begin
  if (csDesigning in ComponentState) then
    Exit;
(* If a mapping does not exist, do nothing *)
  if lp = nil then
    Exit;
  lp := Value;
end;procedure TSharedMemory.SetContentsEdit(const Value: TEdit);
begin
  if (csDesigning in ComponentState) then
    Exit;
(* If a mapping does not exist, do nothing *)
  if lp = nil then
    Exit;
  lp := Value;
end;procedure TSharedMemory.SetContentsObj(const Value: TObject);
begin
  if (csDesigning in ComponentState) then
    Exit;
(* If a mapping does not exist, do nothing *)
  if lp = nil then
    Exit;
  lp :=Value;
end;procedure TSharedMemory.SetHandle(const Value: string);
begin
  if FHandle = Value then
    Exit;
  FHandle := Value;
  if (csDesigning in ComponentState) then
    Exit;
(* Close down any file mapping that may be currently open *)
  if lp <> nil then
    UnmapViewOfFile(lp);
  if hFileMapping <> 0 then
    CloseHandle(hFileMapping);
(* See if a file mapping already exists with this name *)
  hFileMapping := OpenFileMapping(FILE_MAP_ALL_ACCESS, FALSE, PChar(FHandle));
(* If not, create a new one *)
  if hFileMapping = 0 then
    hFileMapping := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE or SEC_COMMIT, 0, FSize, PChar(FHandle));
  if hFileMapping = 0 then
    raise Exception.Create('CreateFileMapping failed with error code ' + IntToStr(GetLastError));
(* Map the view of the file *)
  lp := MapViewOfFile(hFileMapping, FILE_MAP_ALL_ACCESS, 0, 0, FSize);
  if lp = nil then
    raise Exception.Create('MapViewOfFile failed with error code ' + IntToStr(GetLastError));
end;procedure TSharedMemory.SetSize(const Value: integer);
begin
  FSize := Value;
end;
end.

Answer 2

To sfgvvv() :        谢谢你的回复；
        我的目的是想在delphi写的程序里面访问另外一个由C语言写的程序创建的共享内存段；好像应当用OpenFileMapping
        
        可是不知道怎么设置OpenFileMapping的参数啊：
        
        这个由C语言写的程序创建共享内存的代码是：
        
        key_t tmpkey ;
char *tmpfilename=NULL ;
int shmid;
struct shm *shmptr;

strcpy(tmpfilename,"I:\shmdir\SHMFILE");

tmpkey = ftok ( tmpfilename , SHMKEY ) ;

shmid = shmget ( tmpkey, sizeof ( struct shm ),PERMS | IPC_CREAT | IPC_EXCL );

shmptr = ( struct shm * ) shmat ( shmid, ( char * ) 0, 0 );

这样创建的共享内存，请问在delphi怎么访问这个共享内存？？

这种情况下怎么设置OpenFileMapping的参数？？怎么设置OpenFileMapping的最后一个参数？？         还是说在delphi根本无法访问这个共享内存段？？

Answer 3

To sfgvvv() :      在procedure TSharedMemory.SetHandle(const Value: string);
里面，这个value是不是不能带路进啊？？       比如说我想把这个value设置成"I:\sharememory\SHMFILE1"，结果程序运行的时候出现I/O Error 3，说找不到文件的路径；
       可是我如果只设置成value:='SHMFILE'，则没有问题，问题是在我的硬盘里面怎么也找不到这个文件；
       请问CreateFileMapping是不是不会生成Fhandle相应的文件？？