delphi的关于ring0级的编写的一些资料，有些杂，还有些乱，不好意思！附带了一些windowsapi的资料----
下面是局部的代码，具体见附件------（）
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;
  PatchCodeAddr: DWord;
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;