DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
Delphi.NET
Delphi PHP
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: wangkaize
今日帖子: 5
在线用户: 13
导航: 论坛 -> 发布代码 斑竹:liumazi,ruralboy  
作者:
男 cmzy (残梦追月) ▲▲△△△ -
普通会员
2008-3-7 10:44:14
标题:
發一個delphi下無力內存讀寫的代碼。非原創,整理別人的代碼。大俠拍磚啊! 浏览:1216
加入我的收藏
楼主: {**********

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.
----------------------------------------------
-
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v2.1 版权所有 页面执行141.6016毫秒 RSS