如何在2000和xp下用delphi进入ring0？对本问题不报希望，随便贴贴。

Question

回答问题请看清题目然后回答，以下情况的回答不给分：
1.回答在9x下的代码不给分
2.回答非delphi的代码不给分
3.编译无法通过或者无用的代码不给分
对这个问题的答案没报什么希望，贴这个问题就是因为我的可用分比较多。

Answer 1

哦.要求很多哦....http://www.delphibbs.com/keylife/iblog_show.asp?xid=6680看看这里....

Answer 2

再看这里:
http://www.delphibbs.com/keylife/iblog_show.asp?xid=6679

Answer 3

可以实现，但我不会，看一下《delphi下深入windows内核编程》吧；

Answer 4

好像LiuYang会，发信息叫他来看一下。

Answer 5

呵呵，楼主口气好大哦-_#参看：
http://community.csdn.net/Expert/topic/3567/3567620.xml?temp=.668606LYSoft版本：
http://blog.csdn.net/ly_liuyang/archive/2004/11/20/189013.aspx
虽然看上去上相似其实不一样的：）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; http://lysoft.7u7.net

Answer 6

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;http://lysoft.7u7.net