一个delphi下物理内存读写的代码

{**********

Author:CMZY
Version:
Time:2008/02/20
mail:dashoumail@163.com

读写物理和其它进程内存的API

function:
function ReadOrWritePhyMem(ReadOnly:Boolean; //为TRUE时表示读，FALSE时表示写
Address, //起始地址
Length:DWORD; //长度
buffer:Pointer //缓冲区
):boolean; //成功返回true

function ReadOrWriteProcessMem(ReadOrWrite:Boolean; //为TRUE时表示读，FALSE时表示写
Pid:Cardinal; //进程PID
Address, //起始地址
Length:DWORD; //长度
buffer:Pointer //缓冲区
):Boolean; //成功返回true


**********}


unit MemReadWrite;

interface

uses Windows,SysUtils, Variants, Dialogs, Classes,Aclapi,Accctrl;
type
PUnicodeString = ^TUnicodeString;
TUnicodeString = packed record
Length: Word;
MaximumLength: Word;
Buffer: PWideChar;
end;

NTSTATUS = Integer;

PObjectAttributes = ^TObjectAttributes;
TObjectAttributes = packed record
Length: DWORD;
RootDirectory: THandle;
ObjectName: PUnicodeString;
Attributes: DWORD;
SecurityDescriptor: PSecurityDescriptor;
SecurityQualityOfService: PSecurityQualityOfService;
end;

TZwOpenSection = function(var SectionHandle: THandle; //返回物理内存句柄
DesiredAccess: ACCESS_MASK; //访问权限
var ObjectAttributes: TObjectAttributes
): NTSTATUS;stdcall; //成功则返回status_success

TzwClose=procedure(Sectionhandle:Thandle
);stdcall;

TRtlInitUnicodeString = procedure(var DestinationString: TUnicodeString;
vSourceString: WideString);stdcall;

const
STATUS_SUCCESS = NTSTATUS(0);
STATUS_INVALID_HANDLE = NTSTATUS($C0000008);
STATUS_ACCESS_DENIED = NTSTATUS($C0000022);

OBJ_INHERIT = $00000002;
OBJ_PERMANENT = $00000010;
OBJ_EXCLUSIVE = $00000020;
OBJ_CASE_INSENSITIVE = $00000040;
OBJ_OPENIF = $00000080;
OBJ_OPENLINK = $00000100;
OBJ_KERNEL_HANDLE = $00000200;
OBJ_VALID_ATTRIBUTES = $000003F2;

ObjectPhysicalMemoryDeviceName = '"Device"Physicalmemory';
NTDLL = 'ntdll.dll';
var
ZwOpenSection: TZwOpenSection;
zwClose:TzwClose;
RtlInitUnicodeString: TRtlInitUnicodeString;
hNtdll:HMODULE;
function ReadOrWritePhyMem(ReadOnly:Boolean;
Address,
Length:DWORD;
buffer:Pointer
):boolean;
function ReadOrWriteProcessMem(ReadOrWrite:Boolean;
Pid,
Address,
Length:DWORD;
buffer:Pointer
):Boolean;
implementation

//加载NT.dll并找到函数
function LocateNtdllEntryPoints: BOOLEAN;
begin
Result:=false;
hNtDll:=GetModuleHandle(NTDLL);
if hNTdll=0 then Exit;

if not Assigned(ZwOpenSection) then
ZwOpenSection:=GetProcAddress(hNtdll,'ZwOpenSection');
if not Assigned(ZwClose) then
ZwClose:=GetProcAddress(hNtDll,'ZwClose');
if Not Assigned(RtlInitUnicodeString) then
RtlInitUnicodeString:=GetProcAddress(hNtDll,'RtlInitUnicodeString');

Result:=true;
end;

//设置物理内存为可写
function SetPhyMemCanBeWrite(hSection:THandle):Boolean;
var
pDacl,pNewDacl:PACL;
pSD:PPSECURITY_DESCRIPTOR;
dwRes:Cardinal;
ea:EXPLICIT_ACCESS_A;
label CleanUp;
begin
result:=false;
pDacl:=nil;
pNewDacl:=nil;
pSD:=nil;

//获取物理内存的安全信息
dwRes:=GetSecurityInfo(hSection,
SE_KERNEL_OBJECT,
DACL_SECURITY_INFORMATION,
nil,
nil,
@pDacl,
nil,
pSD);

if dwRes<>ERROR_SUCCESS then
begin
if pSD<>nil then LocalFree(Cardinal(pSD^));
if pNewDacl<>nil then LocalFree(Cardinal(pSD^));
raise Exception.Create('不能获得物理内存的安全信息！')
end;

FillChar(ea,SizeOf(EXPLICIT_ACCESS_A),0);
ea.grfAccessPermissions:=SECTION_MAP_WRITE;//可写的
ea.grfAccessMode:=GRANT_ACCESS;//授予所有权限
ea.grfInheritance:=NO_INHERITANCE;//不可继承
ea.Trustee.TrusteeForm:=TRUSTEE_IS_NAME; //用户
ea.Trustee.TrusteeType:=TRUSTEE_IS_USER;
ea.Trustee.ptstrName:='CURRENT_USER';
SetEntriesInAcl(1,@ea,nil,pNewDacl);

//设置物理内存段的安全信息
dwRes:=SetSecurityInfo(hSection,
SE_KERNEL_OBJECT,
DACL_SECURITY_INFORMATION,
nil,
nil,
@pNewDacl,
nil);

if dwRes = ERROR_SUCCESS then
begin
if pSD<>nil then LocalFree(Cardinal(pSD^));
if pNewDacl<>nil then LocalFree(Cardinal(pSD^));
Result:=true;
end;
end;

//打开物理内存 Readon_ly=false时可以写，若失败返回 0
function OpenPhyMem(ReadOnly:Boolean):THandle;
var
PhyMemName:TUnicodestring;//物理内存名
wsPhyMemName:WideString;
attrib:TObjectAttributes;
SectionAttrib:Integer;
status:NTSTATUS;
hPhyMem:THandle;
begin
result:=0;

wsPhyMemName:= ObjectPhysicalMemoryDeviceName;

RtlInitUnicodeString(PhyMemName,wsPhyMemName); //初始化设备对象名

attrib.Length:=SizeOf(TObjectAttributes);
attrib.ObjectName:=@PhyMemName;
attrib.Attributes:=OBJ_CASE_INSENSITIVE or OBJ_KERNEL_HANDLE;
attrib.RootDirectory:=0;
attrib.SecurityDescriptor:=nil;
attrib.SecurityQualityOfService:=nil;

if ReadOnly then
SectionAttrib:=SECTION_MAP_READ
else
SectionAttrib:=SECTION_MAP_READ or SECTION_MAP_WRITE;

status:= ZwOpenSection(hPhyMem,SectionAttrib,Attrib);

if (Not ReadOnly) and (status=STATUS_ACCESS_DENIED) then
begin
//用另一种方式打开物理内存
status:= ZwOpenSection(hPhyMem,READ_CONTROL or WRITE_DAC,Attrib);

SetPhyMemCanBeWrite(hPhyMem); //设置物理内存可写

ZwClose(hPhyMem);//关闭物理内存
//重新打开
status:= ZwOpenSection(hPhyMem,SectionAttrib,Attrib);
end;

if status<0 then
begin
Exit; //失败，则推出
end;
Result:=hPhyMem;
end;

//影射物理内存为本进程的虚拟内存
function MapPhyMem(ReadOnly:Boolean; //是否只读
PhyMem:THandle; //物理内存句柄
Address, //起始地址
Length:DWORD; //长度
var VirtualAddress:Pchar //本地虚拟地址
):Boolean; //成功返回true
var
Access:Cardinal;
begin
result:=false;

if ReadOnly then Access:=FILE_MAP_READ
else Access:= FILE_MAP_READ or FILE_MAP_WRITE;

VirtualAddress:=MapViewOfFile(PhyMem,Access,0,Address,Length);

//返回值VirtualAddress自动按页对齐，需要改正？？
Inc(DWORD(VirtualAddress),Access mod $1000);

result:=true;
end;

//取消影射
procedure UnMapPhyMem(Address:pointer);
begin
UnmapViewOfFile(Address);
end;

//读写物理内存！
function ReadOrWritePhyMem(ReadOnly:Boolean; //是否只读
Address,
Length:DWORD;
buffer:Pointer
):boolean;
var
hPhyMem:THandle;
VAddress:Pchar;
begin
result:=false;

if not Assigned(ZwOpenSection) then Exit;

hPhyMem:=OpenPhyMem(ReadOnly);

if hPhyMem=0 then Exit;


if not MapPhyMem(ReadOnly,hPhyMem,Address,length,vaddress) then Exit;

try
if ReadOnly then
Move(vaddress^,buffer^,length)
else
Move(buffer^,vaddress^,length);
result:=true;
Except
on e:Exception do
begin
MessageDlg('缓中区长度不足或内存跨段。'+#$D+
'每个内存段为4K的整数倍，每次读写不能跨越多个不同的内存段。',
mtError, [mbok],0);
end;
end;
UnMapPhyMem(VAddress);
ZwClose(hPhyMem);
end;

//读写其它进程内存
function ReadOrWriteProcessMem(ReadOrWrite:Boolean;Pid:Cardinal;Address,Length:DWORD;buffer:Pointer):Boolean;
var
hProcess:THandle;
ReadLength:Cardinal;
mbi:TMemoryBasicInformation;
OldProtect:DWORD;
begin
Result:=false;
if ReadOrWrite then //如果是读取
begin
hProcess:=OpenProcess(PROCESS_ALL_ACCESS,false,Pid); //打开进程



if (not ReadProcessMemory(hProcess, Pointer(Address), buffer, Length, ReadLength))
or (Length<>ReadLength) then
begin
// ShowMessage(IntToStr(GetlastError));
CloseHandle(hProcess);
Exit;
end;

end else //如果是写入
begin
hProcess:=OpenProcess(PROCESS_ALL_ACCESS,false,Pid);

//查询内存属性
VirtualQueryEx(hProcess,Pointer(Address),mbi,SizeOf(TMemoryBasicInformation));

//修改属性
virtualProtectEx(hProcess,Pointer(Address),Length,PAGE_EXECUTE_READWRITE,mbi.Protect);

if (not WriteProcessMemory(hProcess,Pointer(Address),buffer,Length,ReadLength))
or (ReadLength<>Length) then
begin
CloseHandle(hProcess);
Exit;
end;

//恢复属性
VirtualProtectEx(hProcess,Pointer(Address),Length,Mbi.Protect,OldProtect);
end;
CloseHandle(hProcess);
Result:=true;
end;

Initialization
if not LocateNtdllEntryPoints then raise Exception.Create('不能加载NT.dll！');
Finalization
FreeLibrary(hNtdll);
end.