{
  Программа демонстрирует переход в Ring0 в Win2k/XP.
  [Для простоты нет обработки ошибок.]
  (c)2004 Роман Янковский aka Kerk / admin@kerkzone.net
-------------------------------------------------------
  Viva la Kerk!
}
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 Ring0Beep; // выполняется в 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,20000000
@@:
  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;
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;
  NtOpenSection(@Result,READ_CONTROL or WRITE_DAC,@attributes);
  GetSecurityInfo(Result,SE_KERNEL_OBJECT,DACL_SECURITY_INFORMATION,
    nil,nil,@OldAcl,nil,SD);
  with Access do
  begin
    grfAccessPermissions := 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 or SECTION_MAP_WRITE,@attributes);
  LocalFree(DWORD(NewAcl));
  LocalFree(DWORD(SD));
end;

var
  PhysMem: THandle;
  gdt: TGDTInfo;
  ptrGDT,Ring0Proc: Pointer;
  CurrentGate: PGateDescriptor;
  OldGate: TGateDescriptor;
  offset,base_address: DWORD;
  FarCall: TFarCall;
begin
  PhysMem := OpenPhysicalMemory; Ring0Proc := @Ring0Beep;
  asm sgdt [gdt] end;
  base_address := QuasiMmGetPhysicalAddress(gdt.Base,offset);
  ptrGDT := MapViewOfFile(PhysMem,FILE_MAP_WRITE+FILE_MAP_READ,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 // call far [FarCall]
    db $0ff,$01d
    dd offset FarCall
  end;
  CurrentGate^ := OldGate;
  UnmapViewOfFile(ptrGDT);
  CloseHandle(PhysMem);
end.