这段代码很有意义的父亲纪念版，它是在我一生人中最痛苦的时期所开发的。唉，一切都成为永恒的怀念......
需要JEDI Win32 API（JWA）库支持
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
