本文转自 http://blog.csdn.net/ly_liuyang/article/details/189013

注意：需要JEDI Win32 API（JWA）库支持

另外，该方法不适用于PAE模式（WinXP SP2配备AMD64或EMT64处理器的系统），而且还不能支持Win2003 SP1

uses

  Windows, Dialogs, SysUtils, NTDDK,

  JwaWinNT, JwaWinType, JwaNtStatus, JwaAccCtrl, JwaAclApi, ntdll;

const

  KGDT_NULL     = 0;

  KGDT_R0_CODE  = 8;

  KGDT_R0_DATA  = 16;

  KGDT_R3_CODE  = 24;

  KGDT_R3_DATA  = 32;

  KGDT_TSS      = 40;

  KGDT_R0_PCR   = 48;

  KGDT_R3_TEB   = 56;

  KGDT_VDM_TILE = 64;

  KGDT_LDT      = 72;

  KGDT_DF_TSS   = 80;

  KGDT_NMI_TSS  = 88;

type

  TGDT = record

    Limit,

    BaseLow,

    BaseHigh : Word;

  end;

  PHYSICAL_ADDRESS = Large_Integer;

  CALLGATE_DESCRIPTOR = record

    Offset_0_15, Selector: Word;

    GateDescriptor:Word;

    Offset_16_31: Word;

  end;

implementation

function ZwOpenSection; external 'ntdll.dll';

function ZwClose; external 'ntdll.dll';

function SetDebugPrivilege(CanDebug: boolean): Boolean;

  function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;

  var

    TP: Windows.TOKEN_PRIVILEGES;

    Dummy: Cardinal;

  begin

    TP.PrivilegeCount := 1;

    LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);

    if bEnable then

      TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED

    else TP.Privileges[0].Attributes := 0;

    AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);

    Result := GetLastError = ERROR_SUCCESS;

  end;

var

  hToken: Cardinal;

begin

  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);

  Result := EnablePrivilege(hToken, SE_DEBUG_NAME, CanDebug);

  CloseHandle(hToken);

end;

function SetPhyscialMemorySectionCanBeWrited(hSection: THandle): boolean;

label CleanUp;

var

  pDacl, pNewDacl: JwaWinNT.PACL;

  pSD: JwaWinNT.PSECURITY_DESCRIPTOR;

  dwRes: DWORD;

  ea: EXPLICIT_ACCESS;

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

      MessageDlg(Format('GetSecurityInfo Error %d', [dwRes]), mtError, [mbOK], 0);

      goto CleanUp;

    end;

  ZeroMemory(@ea, sizeof(EXPLICIT_ACCESS));

  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';

  dwRes := SetEntriesInAcl(1, @ea, pDacl, pNewDacl);

  if dwRes ERROR_SUCCESS then

     begin

       MessageDlg(Format('SetEntriesInAcl Error : %d', [dwRes]), mtError, [mbOK], 0);

       goto CleanUp;

     end;

  dwRes := SetSecurityInfo(hSection, SE_KERNEL_OBJECT,

    DACL_SECURITY_INFORMATION, nil, nil, pNewDacl, nil);

  if dwRes ERROR_SUCCESS then

     begin

       MessageDlg(Format('SetSecurityInfo Error : %d', [dwRes]), mtError, [mbOK], 0);

       goto CleanUp;

     end;

  Result := true;

  CleanUp:

  if pSDnil then LocalFree(Cardinal(pSD));

  if pNewDaclnil then LocalFree(Cardinal(pNewDacl));

end;

function OpenPhysicalMemory: THandle;

var

  hSection : THandle;

  status: NTSTATUS;

  objName: UNICODE_STRING;

  objectAttributes: OBJECT_ATTRIBUTES;

begin

  Result := 0;

  RtlInitUnicodeString(@objName, '/Device/PhysicalMemory');

  InitializeObjectAttributes(@objectAttributes, @objName,

    OBJ_CASE_INSENSITIVE or OBJ_KERNEL_HANDLE, 0, nil);

  status := ZwOpenSection(hSection, SECTION_MAP_READ or SECTION_MAP_WRITE, @objectAttributes);

  if (status = STATUS_ACCESS_DENIED) then

     begin

       status := ZwOpenSection(hSection, READ_CONTROL or WRITE_DAC, @objectAttributes);

       if status = STATUS_SUCCESS then  SetPhyscialMemorySectionCanBeWrited(hSection);

       ZwClose(hSection);

       status := ZwOpenSection(hSection, SECTION_MAP_READ or SECTION_MAP_WRITE, @objectAttributes);

     end;

  if status = STATUS_SUCCESS then Result :=hSection;

end;

procedure ClosePhysicalMemory(hPhysicalMemorySection: THandle);

begin

  ZwClose(hPhysicalMemorySection);

end;

function AddressIn4MBPage(Address: ULONG): Boolean;

begin

  Result := (Address > 0) and ($80000000 0 then ExecRing0Proc(@Ring0Func, 32); end; ...... MemoryAddress.VirtualAddress := StrToInt64Def(Edit1.Text, $806AB000);   MmGetPhysicalAddress;   Memo1.Lines.Add(Format('(Ring 0 Mode) Virtual address : $%s  = Physical address : $%s',     [IntToHex(MemoryAddress.VirtualAddress, 8),      IntToHex(MemoryAddress.PhysicalAddress.LowPart, 8)]));