请问delphi怎么访问其他程序创建的共享内存？ ( 积分: 10 )

我的服务器上有一段共享内存，这段共享内存是一个由C语言编写的程序创建的；

现在的问题是：我想在delphi写的程序里面访问这个共享内存，请问要怎么做？？

最好详细点。^_^。

知道Name么?知道的话就简单了。这段拷给你。
unit MemMappedFiles;

interface

uses Windows, Classes;

type
TAccessMode = (amReadOnly, amReadWrite);

TMemMappedFile = class
private
FName: string;
FFileName: string;
FAccessMode: TAccessMode;
FSize: Integer;
FHandle: THandle;
function GetHandle: THandle;
public
constructor Create(const AName: string; AMode: TAccessMode; ASize: Integer;
const AFileName: string); overload;
constructor Create(const AName: string; AMode: TAccessMode; ASize: Integer); overload;
destructor Destroy; override;
function CreateMapView(AMode: TAccessMode): TStream;
end;

implementation

uses SysUtils, Logs;

type
EWindowsError = class(Exception)
public
constructor Create;
end;

TMapViewStream = class(TStream)
private
FMemMappedFile: TMemMappedFile;
FCanWrite: Boolean;
FAddress: Pointer;
FPosition: Integer;
FMutexName: array[0..MAX_PATH] of Char;
FMutex: THandle;
procedure EnsureCreated;
public
constructor Create(AMemMappedFile: TMemMappedFile; AMode: TAccessMode);
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; overload; override;
end;

{ EFileMapException }

function GetLastErrorMessage: string;
var
Buf: array[0..1023] of char;
Len: Integer;
begin
Len := FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
nil, GetLastError, 0, Buf, 1024, nil);
SetString(Result, Buf, Len);
end;

constructor EWindowsError.Create;
begin
inherited Create(GetLastErrorMessage);
end;

{ TMapViewStream }

constructor TMapViewStream.Create(AMemMappedFile: TMemMappedFile;
AMode: TAccessMode);
begin
FMemMappedFile := AMemMappedFile;
FCanWrite := AMode = amReadWrite;
FAddress := nil;
FPosition := 0;
if FCanWrite then
begin
StrPLCopy(FMutexName, Format('MUTEX_%s', [FMemMappedFile.FName]), MAX_PATH);
FMutex := CreateMutex(nil, True, FMutexName);
if FMutex = 0 then
begin
FMutex := OpenMutex(MUTEX_ALL_ACCESS or Windows.SYNCHRONIZE, False,
FMutexName);
if WaitForSingleObject(FMutex, 0) <> WAIT_OBJECT_0 then
begin
CloseHandle(FMutex);
FMutex := 0;
FCanWrite := False;
end;
end;
end;
end;

destructor TMapViewStream.Destroy;
begin
if FMutex <> 0 then
begin
ReleaseMutex(FMutex);
CloseHandle(FMutex);
end;
if FAddress <> nil then
begin
FlushViewOfFile(FAddress, FMemMappedFile.FSize);
UnmapViewOfFile(FAddress);
end;
inherited;
end;

procedure TMapViewStream.EnsureCreated;
const
Accesses: array[Boolean] of Cardinal = (FILE_MAP_READ, FILE_MAP_WRITE);
begin
if FAddress = nil then
begin
FAddress := MapViewOfFile(FMemMappedFile.GetHandle, Accesses[FCanWrite],
0, 0, FMemMappedFile.FSize);
if FAddress = nil then
raise EWindowsError.Create;
end;
end;

function TMapViewStream.Read(var Buffer; Count: Integer): Longint;
begin
EnsureCreated;
if (FPosition >= 0) and (Count >= 0) then
begin
Result := FMemMappedFile.FSize - FPosition;
if Result > 0 then
begin
if Result > Count then Result := Count;
Move(Pointer(Longint(FAddress) + FPosition)^, Buffer, Result);
Inc(FPosition, Result);
Log.Write(Format('读出 %d 字节', [Result]));
Exit;
end;
end;
Result := 0;
end;

function TMapViewStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
EnsureCreated;
case Origin of
soFromBeginning: FPosition := Offset;
soFromCurrent: Inc(FPosition, Offset);
soFromEnd: FPosition := FMemMappedFile.FSize + Offset;
end;
Result := FPosition;
end;

function TMapViewStream.Write(const Buffer; Count: Integer): Longint;
begin
if not FCanWrite then
raise Exception.Create('该映射视图不能写入任何内容')
else
if (FPosition >= 0) and (Count >= 0) then
begin
EnsureCreated;
Result := FMemMappedFile.FSize - FPosition;
if Result > 0 then
begin
if Result > Count then Result := Count;
System.Move(Buffer, Pointer(Longint(FAddress) + FPosition)^, Result);
Inc(FPosition, Result);
Log.Write(Format('写入 %d 字节', [Result]));
Exit;
end;
end;
Result := 0;
end;

{ TMemMappedFile }

constructor TMemMappedFile.Create(const AName: string; AMode: TAccessMode;
ASize: Integer; const AFileName: string);
begin
FName := AName;
FFileName := AFileName;
FAccessMode := AMode;
FSize := ASize;
end;

constructor TMemMappedFile.Create(const AName: string; AMode: TAccessMode;
ASize: Integer);
begin
Create(AName, AMode, ASize, '');
end;

function TMemMappedFile.CreateMapView(AMode: TAccessMode): TStream;
begin
if FAccessMode = amReadOnly then
AMode := amReadOnly;
Result := TMapViewStream.Create(Self, AMode);
end;

destructor TMemMappedFile.Destroy;
begin
if FHandle <> 0 then
CloseHandle(FHandle);
inherited;
end;

function TMemMappedFile.GetHandle: THandle;
const
DesiredAccesses: array[TAccessMode] of Cardinal = (GENERIC_READ, GENERIC_WRITE);
Protections: array[TAccessMode] of Cardinal = (PAGE_READONLY, PAGE_READWRITE);
var
FileHandle: THandle;
begin
if FHandle = 0 then
begin
if Length(FFileName) > 0 then
begin
FileHandle := CreateFile(PChar(FFileName), DesiredAccesses[FAccessMode],
0, nil, OPEN_ALWAYS, 0, 0);
if FileHandle = INVALID_HANDLE_VALUE then
raise EWindowsError.Create;
end
else
FileHandle := INVALID_HANDLE_VALUE;
FHandle := CreateFileMapping(FileHandle, nil, Protections[FAccessMode],
0, FSize, PChar(FName));
if FileHandle <> INVALID_HANDLE_VALUE then
CloseHandle(FileHandle);
if FHandle = 0 then
raise EWindowsError.Create;
end;
Result := FHandle;
end;

end.
创建一个TMemMappedFile实例后，再用CreateMapView建立一个流，访问这个流即可。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask, tlhelp32;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
ComboBox1: TComboBox;
MaskEdit1: TMaskEdit;
Label1: TLabel;
Label2: TLabel;
MaskEdit2: TMaskEdit;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
IsLoad: boolean;
FSnapshotHandle: THandle;
function GetProcessID(var List: TStringList; FileName: string = ''): TProcessEntry32;
end;

var
Form1: TForm1;
implementation

{$R *.DFM}

function HexToInt(HexStr: string): Int64;
var RetVar: Int64;
i: byte;
begin
HexStr := UpperCase(HexStr);
if HexStr[length(HexStr)] = 'H' then
Delete(HexStr, length(HexStr), 1);
RetVar := 0;
for i := 1 to length(HexStr) do begin
RetVar := RetVar shl 4;
if HexStr in ['0'..'9'] then
RetVar := RetVar + (byte(HexStr) - 48)
else
if HexStr in ['A'..'F'] then
RetVar := RetVar + (byte(HexStr) - 55)
else begin
Retvar := 0;
break;
end;
end;

Result := RetVar;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
FProcessEntry32: TProcessEntry32;
ProcessID: integer;
ProcessHandle: THandle;
lpBuffer: pchar;
nSize: DWORD;
lpNumberOfBytes: DWORD;
i: integer;
addr:dword;
s: string;
List: TStringList;
mbi_thunk:TMemoryBasicInformation;
dwOldProtect:dword;
begin
if Combobox1.itemindex = -1 then exit;
List := TStringList.Create;
FProcessEntry32 := GetProcessID(List, Combobox1.text);
if FProcessEntry32.th32ProcessID=0 then exit;
ProcessID := FProcessEntry32.th32ProcessID;
Memo1.Lines.Clear;
memo1.lines.add('Process ID ' + IntToHex(FProcessEntry32.th32ProcessID, 8));
memo1.lines.Add('File name ' + FProcessEntry32.szExeFile);

ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessID);
memo1.Lines.Add('Process Handle ' + intTohex(ProcessHandle, 8));
Memo1.Lines.Add('虚拟内存中的数据:');
addr:=HexToInt(MaskEdit1.text);
nSize:=HexToInt(MaskEdit2.text)-addr+1;
if HexToInt(MaskEdit2.text)>addr then
begin
lpBuffer := AllocMem(nSize);
if(not ReadProcessMemory(ProcessHandle, Pointer(addr), lpBuffer, nSize, lpNumberOfBytes))
or(nSize<>lpNumberOfBytes) then
begin
showmessage('读数据出错，可能是指定的地址不存在.');
exit;
end;
s:='';
for i :=0 to nSize-1 do
begin
s := s + format('%.2X ',[ord(lpBuffer)]);
{读取内容}
if ((i mod 16 ) = 15)or(i=nSize-1) then
begin
Memo1.Lines.Add(s);
s := '';
end;
end;
VirtualQueryEx(ProcessHandle,Pointer(addr),mbi_thunk, sizeof(TMemoryBasicInformation));
VirtualProtectEx(ProcessHandle,Pointer(addr),nSize,PAGE_EXECUTE_READWRITE,mbi_thunk.Protect);
if(not WriteProcessMemory(ProcessHandle, Pointer(addr), lpBuffer, nSize, lpNumberOfBytes))
then
begin
showmessage('写数据出错，可能是该地址不允许写。如果该处不是Rom，可以通过Ring0或其它特权写该内存。');
end;
VirtualProtectEx(ProcessHandle,Pointer(addr), nSize, mbi_thunk.Protect,dwOldProtect);
FreeMem(lpBuffer, nSize);
end;
CloseHandle(ProcessHandle);
List.free;
end;

function Tform1.GetProcessID(var List: TStringList; FileName: string = ''): TProcessEntry32;
var
Ret: BOOL;
s: string;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
Ret := Process32First(FSnapshotHandle, FProcessEntry32);
while Ret do
begin
s := ExtractFileName(FProcessEntry32.szExeFile);
if (FileName = '') then
begin
List.Add(Pchar(s));
end
else if (AnsiCompareText(Trim(s),Trim(FileName))=0) and (FileName <> '') then
begin
List.Add(Pchar(s));
result := FProcessEntry32;
break;
end;
Ret := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
List: TStringList;
i: integer;
begin
Combobox1.clear;
List := TStringList.Create;
GetProcessID(List);
for i := 0 to List.Count - 1 do
begin
Combobox1.items.add(Trim(List.strings));
end;
List.Free;
Combobox1.itemindex := 0;
end;

end.

贴错了 不好意思~ 没看到&quot;共享内存&quot;

先 openmapview就是了