آیا دلفی می تونه به صورت مستقیم به حافظه سیستم عامله دسترسی پیدا کنه؟

[A_2006]

سلام دوستان.
شما چی می گید؟

[Felony]

برنامه های تولید شده توسط دلفی از توابع استاندارد API استفاده میکنند ، توابع API استاندارد در سطح سیستم عامل User Mode هستند ، بنابر این برنامه شما هم یک برنامه User Mode هست ، در User Mode چیزی به نام " دسترسی مستقیم " مفهومی نداره .

[lord_viper]

یه یونیت به اسم ring0 هست البته تو xp کار میکنه فقط میتونین به اون قسمتها دسترسی داشته باشین من باهاش یه برنامه برای ارتباط با پورت پارالل نوشته بودم



unit ring0;
interface
uses
Windows,SysUtils,Aclapi,Accctrl,NtDll;
type

_GDTENTRYR = packed record
Limit : WORD ;
BaseLow : WORD ;
BaseHigh : WORD ;
end;
TGDTENTRYR = _GDTENTRYR;
PGDTENTRYR = ^TGDTENTRYR;

_CALLGATE_DESCRIPTOR = packed record
Offset_0_15 : WORD;
Selector : WORD ;
ParamCount_SomeBits : Byte ;
Type_AppSystem_Dpl_Present : Byte ;
Offset_16_31 : WORD ;
end;
TCALLGATE_DESCRIPTOR = _CALLGATE_DESCRIPTOR;
PCALLGATE_DESCRIPTOR = ^TCALLGATE_DESCRIPTOR;
const
ObjectPhysicalMemoryDeviceName = '\Device\Physicalmemory';



function ReadWritePhyMem(Address: DWORD; Length: DWORD; Buffer: PChar;ReadOrNot: Boolean = True): Boolean;
function ExecRing0Proc( Entry,seglen : ULONG):Boolean;//执行ring0层程序

implementation

function SetPhysicalMemorySectionCanBeWrited(hSection: THandle): Boolean;
var
pDacl: PACL;
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,D ACL_SECURITY_INFORMATION,nil,
nil,@pDacl,nil,pSD);
try
if dwres<>ERROR_SUCCESS then
Exit;

FillChar(ea,SizeOf(EXPLICIT_ACCESS),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,D ACL_SECURITY_INFORMATION,
Nil,Nil,pNewDacl,Nil);
if dwRes=ERROR_SUCCESS then
Exit;

Result:=True;
finally
if pSD<>Nil then
LocalFree(Cardinal(pSD^));
if pNewDacl<>Nil then
LocalFree(Cardinal(pSD^));
end;
end;

function GetPhysicalAddress(vAddress:ULONG):LARGE_INTEGER;

begin

if (vAddress < $80000000) or (vAddress >= $A0000000) then
Result.QuadPart := vAddress and $FFFF000
else
Result.QuadPart := vAddress and $1FFFF000;

end;

function OpenPhysicalMemory(ReadOrNot: Boolean): THandle;
var
Status: NTSTATUS;
PhysMem: THandle;
PhysMemString: UNICODE_STRING;
Attributes: TNtObjectAttributes;
SectionAttrib: Integer;
begin
Result:=0;
RtlInitUnicodeString(@PhysMemString,ObjectPhysical MemoryDeviceName);
InitializeObjectAttributes(@Attributes,
@PhysMemString,
OBJ_CASE_INSENSITIVE or OBJ_KERNEL_HANDLE,
0,
Nil);

if ReadOrNot then
SectionAttrib:=SECTION_MAP_READ
else
SectionAttrib:=SECTION_MAP_READ or SECTION_MAP_WRITE;
Status:=ZwOpenSection(@PhysMem,SectionAttrib,@Attr ibutes);
if not ReadOrNot then
begin
if Status=STATUS_ACCESS_DENIED then
begin
Status:=ZwOpenSection(@PhysMem,READ_CONTROL or WRITE_DAC,@Attributes);
SetPhysicalMemorySectionCanBeWrited(PhysMem);
ZwClose(PhysMem);
Status:=ZwOpenSection(@PhysMem,SectionAttrib,@Attr ibutes);
end;
end;
if not NT_SUCCESS(Status) then
Exit;

Result:=PhysMem;
end;

function MapPhysicalMemory(ReadOrNot: Boolean; PhysicalMemory: THandle;
Address: DWORD; Length: DWORD; var VirtualAddress: pointer): Boolean;
var
Access: Cardinal;
Status: NTSTATUS;
Base:LARGE_INTEGER;

SystemInfo: TSystemInfo;
Offset,Granularity: ULONG;
begin
Result := FALSE;


GetSystemInfo(SystemInfo);
Granularity := SystemInfo.dwAllocationGranularity;
Offset := Address mod Granularity;
Length := Length + Offset;


if ReadOrNot then
Access:=PAGE_READONLY
else
Access:=PAGE_READWRITE;
VirtualAddress :=nil;
Base:=GetPhysicalAddress(Address-Offset);
status := NtMapViewOfSection(PhysicalMemory,
THandle(-1),
VirtualAddress,
0,
Length,
Base,
Length,
ViewShare,
0,
Access);

if not NT_SUCCESS(Status) then
Exit;
VirtualAddress:=Pointer(DWORD(VirtualAddress)+Offs et);
//Inc(DWORD(VirtualAddress),Address Mod $1000);
Result:=True;
end;

procedure UnMapPhysicalMemory(Address: Pointer);
begin
NtUnmapViewOfSection(THandle(-1), Address);
end;


function ReadWritePhyMem(Address: DWORD; Length: DWORD; Buffer: PChar;
ReadOrNot: Boolean = True): Boolean;
var
PhysMem: THandle;
vAddress: Pointer;
begin
Result:=False;

PhysMem:=OpenPhysicalMemory(ReadOrNot);
if PhysMem=0 then
Exit;

if not MapPhysicalMemory(ReadOrNot,PhysMem,Address,Length ,vAddress) then
Exit;

try
if ReadOrNot then
Move(vAddress^,Buffer^,Length)
else
Move(Buffer^,vAddress^,Length);

Result:=True;
except
on E: Exception do

MessageBox(0,PChar('errror'#13+
'coud not open ring0'),
'error',MB_ICONERROR+MB_OK+MB_SYSTEMMODAL);

end;

UnMapPhysicalMemory(vAddress);
ZwClose(PhysMem);
end;


function InstallCallgate(Section:THandle; FunProc:ULONG):ULONG;
var
gdt : TGDTENTRYR;
begin
asm sgdt gdt end;
end;

function ExecRing0Proc( Entry,seglen : ULONG):Boolean;
var
gdt : TGDTENTRYR;
cg : PCALLGATE_DESCRIPTOR;

PhysMem: THandle;
ReadOrNot: Boolean ;
Address : ULONG;
vAddress: Pointer;

bType : Byte;

_farcall:array [0..2]of word;

begin
Result:=False;
ReadOrNot := FALSE;
asm sgdt gdt end;

PhysMem:=OpenPhysicalMemory(ReadOrNot);
if PhysMem=0 then
Exit;

Address := (gdt.BaseHigh shl 16) or gdt.BaseLow;

if not MapPhysicalMemory(ReadOrNot,PhysMem,Address,gdt.Li mit+1,vAddress) then
Exit;

cg := PCALLGATE_DESCRIPTOR(ULONG(vAddress)+(gdt.Limit and $FFF8));
while ( ULONG(cg) > ULONG(vAddress)) do
begin

bType := cg.Type_AppSystem_Dpl_Present ;
bType := bType shr 4; //btmp := cg.type
if( bType = 0) then
begin
cg.offset_0_15 := LOWORD(Entry);
cg.selector := 8;
cg.ParamCount_SomeBits := 0;
{
cg->type = 0xC; // 386 call gate
cg->app_system = 0; // A system descriptor
cg->dpl = 3; // Ring 3 code can call
cg->present = 1;
}
//cg.Type_AppSystem_Dpl_Present :=$C7;
cg.Type_AppSystem_Dpl_Present :=$EC;

cg.Offset_16_31 := HIWORD(Entry);
break;
end;
Dec(cg);
end;

_farcall[2]:=(ULONG(cg)-ULONG(vAddress)) or 3; //Ring 3 callgate;

if(not VirtualLock(pointer(Entry),seglen)) then
exit;

SetThreadPriority(GetCurrentThread(),THREAD_PRIORI TY_TIME_CRITICAL);

Sleep(0);

asm
lea eax, _farcall
DB 0FFH, 018H //call fword ptr [eax]
end;

SetThreadPriority(GetCurrentThread(),THREAD_PRIORI TY_NORMAL);

VirtualUnlock(pointer(Entry),seglen);

//Clear callgate
PPointer(cg)^ := nil;
Inc(cg);
PPointer(cg)^ := nil;
cg.Offset_0_15 :=0;
cg.Selector :=0;
cg.ParamCount_SomeBits :=0;
cg.Type_AppSystem_Dpl_Present :=0;
cg.Offset_16_31 :=0;

UnMapPhysicalMemory(vAddress);
ZwClose(PhysMem);

Result := TRUE;
end;

end.