预览模式: 普通 | 列表
这段代码很有意义的父亲纪念版,它是在我一生人中最痛苦的时期所开发的。唉,一切都成为永恒的怀念......
注意:需要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 pSD<>nil then LocalFree(Cardinal(pSD));
  if pNewDacl<>nil 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<=Address) and (Address<$A0000000)
end;
function MiniMmGetPhysicalAddress(vAddress: ULONG): ULONG;
begin
  if AddressIn4MBPage(vAddress)
     then Result := vAddress - $80000000
     else Result := $FFFFFFFF;
end;
function MiniMmGetPhysicalPageAddress(VirtualAddress: ULONG): ULONG;
begin
  if AddressIn4MBPage(VirtualAddress)
     then Result := VirtualAddress and $1FFFF000
     else Result := $FFFFFFFF;
end;
function ExecRing0Proc(ProcEntryPoint: Pointer; SegmentLength: ULONG): boolean;
var
  GDT : TGDT; mapAddr: ULONG;
  hSection : THandle;
  cg: ^CALLGATE_DESCRIPTOR;
  farcall : array [0..2] of Word;
  BaseAddress: Pointer;
  setcg: boolean;
  i: Cardinal;
begin
  Result := false;
  asm SGDT GDT end;
  i := (gdt.BaseHigh shl 16) or gdt.BaseLow;
  mapAddr := MiniMmGetPhysicalPageAddress(i);
  if mapAddr=$FFFFFFFF then
     begin
       MessageDlg(Format('Can not convert GDT virtual address of [Base = %s  Limit = %s]',
         [IntToHex(i, 8), IntToHex(GDT.Limit, 4)]), mtError, [mbOK], 0);
       Exit;
     end;
  hSection := OpenPhysicalMemory;
  if hSection=0 then
     begin
       MessageDlg('Error in open physical memory.', mtError, [mbOK], 0);
       Exit;
     end;
  BaseAddress := MapViewOfFile(hSection, FILE_MAP_READ or FILE_MAP_WRITE, 0, mapAddr,    //low part
                     (gdt.Limit+1));
  if BaseAddress = nil then
     begin
       ZwClose(hSection);
       MessageDlg(Format('MapViewOfFile Error : %s%sGDT : Address = %s   Limit = %s',
         [SysErrorMessage(GetLastError), #13#10, IntToHex(mapAddr, 8), IntToHex(GDT.Limit, 4)]), mtError, [mbOK], 0);
       Exit;
     end;
  setcg := false;
  i := Cardinal(BaseAddress)+8;  // skip first empty entry
  while i < Cardinal(BaseAddress)+(gdt.Limit and $FFF8) do
    begin
      cg:=Ptr(i);
      with cg^ do
        begin
          if IntToHex(GateDescriptor, 4)[2] = '0' then  // call gate not present
             begin   // install callgate
               Offset_0_15 := LOWORD(Integer(ProcEntryPoint));
               Selector := KGDT_R0_CODE; // ring 0 code
               // [Installed flag=1] [Ring 3 code can call=11] 0 [386 call gate=1100] 00000000
               GateDescriptor := $EC00;
               Offset_16_31 := HIWORD(Integer(ProcEntryPoint));
               setcg := TRUE;
               Break;
             end;
        end;
      Inc(i, 8);
    end;
  if not setcg then
     begin
       UnMapViewOfFile(BaseAddress);
       ZwClose(hSection);
       MessageDlg('Can not install CallGate in your system GDT', mtError, [mbOK], 0);
       Exit;
     end;
  farcall[0] := 0;  farcall[1] := 0;
  farcall[2] := (short(ULONG(cg)-ULONG(BaseAddress))) or 3;  //Ring 3 callgate;
  if not VirtualLock(ProcEntryPoint, SegmentLength) then
     begin
       MessageDlg(SysErrorMessage(GetLastError), mtError, [mbOK], 0);
       Exit;
     end;
  try
    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
    Sleep(0);
    asm  // call callgate
      //  push arg1 ... argN  // call far fword ptr [farcall]
      LEA EAX, farcall  // load to EAX
      DB 0FFH, 018H  // hardware code, means call fword ptr [eax]
    end;
    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
    Result := true;
  except
    on e: Exception do MessageDlg(e.Message, mtError, [mbOK], 0);
  end;
  VirtualUnlock(ProcEntryPoint, SegmentLength);
  // Clear callgate
  FillChar(cg^, 8, 0);
  UnMapViewOfFile(BaseAddress);
  ClosePhysicalMemory(hSection);
end;
使用示例,读取CMOS时钟:
unit NTRing0_Unit;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;
type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  tHour, tMin, tSec: byte;
implementation
{$R *.dfm}
uses NTRing0;
procedure Ring0Proc; stdcall;
begin
  asm            // ring0 prolog
    PUSHAD // push eax,ecx,edx,ebx,ebp,esp,esi,edi onto the stack
    PUSHFD // decrement stack pointer by 4 and push EFLAGS onto the stack
    CLI    // disable interrupt
    // execute your ring0 code here ...
    MOV AH,0
    MOV DX,$70
    MOV AL,AH
    OUT DX,AL
    INC DX
    IN AL,DX
    MOV tSec,AL
    //
    MOV AH,2
    MOV DX,$70
    MOV AL,AH
    OUT DX,AL
    INC DX
    IN AL,DX
    MOV tMin,AL
    //
    MOV AH,4
    MOV DX,$70
    MOV AL,AH
    OUT DX,AL
    INC DX
    IN AL,DX
    MOV tHour,AL
    // ring0 epilog
    POPFD // restore registers pushed by pushfd
    POPAD // restore registers pushed by pushad
    RETF  // you may retf <sizeof arguments> if you pass arguments
  end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  //  execute ring 0
  if ExecRing0Proc(@Ring0Proc, 100) then
  ShowMessage(Format('CMOS Time is %d:%d:%d',
    [10*(tHour shr 4) + tHour and $F,
     10*(tMin shr 4) + tMin and $F,
     10*(tSec shr 4) + tSec and $F]));
end;
end.
调用NTOSKrnl.exe中的Ring0函数实现VA->PA(虚拟地址到物理地址)的转换
type
  TMemoryAddress = record
    PhysicalAddress : PHYSICAL_ADDRESS;  //*000
    VirtualAddress : DWord;  //*008
  end;
var
  MemoryAddress : TMemoryAddress;
  _MmGetPhysicalAddress : Cardinal;
  NTOSBaseAddr : Cardinal;
// NTOSkern.exe的加载地址,2003系统默认是$804DE000
procedure Ring0Func; stdcall;
begin
  asm
    pushad
    pushf
    cli
    mov esi, MemoryAddress.VirtualAddress
    push esi
    call _MmGetPhysicalAddress
    mov MemoryAddress.PhysicalAddress.LowPart, eax  // save low part of LARGE_INTEGER
    mov MemoryAddress.PhysicalAddress.HighPart, edx       // save high part of LARGE_INTEGER
    popf
    popad
    retf
  end;
end;
procedure MmGetPhysicalAddress;
var hNTDll: THandle;
begin
  _MmGetPhysicalAddress := 0;
  hNTDll := LoadLibrary('ntoskrnl.exe');
  if hNTDll <> 0 then
     begin
       _MmGetPhysicalAddress := NTOSBaseAddr + Cardinal(GetProcAddress(hNTDll, 'MmGetPhysicalAddress')) - hNTDll;
       FreeLibrary(hNTDll);
//       ShowMessage(Format('Virtual address of MmGetPhysicalAddress in Kernel Mode  : %s', [IntToHex(_MmGetPhysicalAddress, 8)]));
     end;
  if _MmGetPhysicalAddress > 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)]));

powered by LYSoft LiuYang
http://lysoft.g4soft.net

查看更多...

Tags: Delphi Ring0

分类:Tech | 固定链接 | 评论: 2 | 引用: 0 | 查看次数: 5362