EvilZone

Programming and Scripting => Other => : Doddy February 28, 2014, 04:55:40 PM

: [Delphi] DH Player 0.5
: Doddy February 28, 2014, 04:55:40 PM

A program to download and listen music.

An image :

(http://doddyhackman.webcindario.com/images/dhplayer05.jpg)

Code :
 

:

// DH Player 0.5
// Coded By Doddy H
// Based on this article : http://delphi.about.com/od/multimedia/l/aa112800a.htm

unit mp3player;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, sListBox, sSkinManager, MPlayer, sGroupBox, jpeg,
  ExtCtrls, ComCtrls, acProgressBar, Buttons, FileCtrl, sEdit, sPageControl,
  sStatusBar, sButton, PerlRegEx, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, sListView, acPNG, sLabel;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    L1: TMenuItem;
    R1: TMenuItem;
    A1: TMenuItem;
    E1: TMenuItem;
    Timer1: TTimer;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sGroupBox4: TsGroupBox;
    MediaPlayer1: TMediaPlayer;
    sGroupBox2: TsGroupBox;
    sEdit1: TsEdit;
    sGroupBox5: TsGroupBox;
    sListBox1: TsListBox;
    sGroupBox1: TsGroupBox;
    sProgressBar1: TsProgressBar;
    sTabSheet2: TsTabSheet;
    sStatusBar1: TsStatusBar;
    sGroupBox3: TsGroupBox;
    sEdit2: TsEdit;
    sListBox2: TsListBox;
    sListBox3: TsListBox;
    sListBox4: TsListBox;
    sButton1: TsButton;
    IdHTTP1: TIdHTTP;
    PerlRegEx1: TPerlRegEx;
    sGroupBox6: TsGroupBox;
    sListView1: TsListView;
    sTabSheet3: TsTabSheet;
    sGroupBox7: TsGroupBox;
    MediaPlayer2: TMediaPlayer;
    sGroupBox8: TsGroupBox;
    sListBox5: TsListBox;
    sGroupBox9: TsGroupBox;
    sGroupBox10: TsGroupBox;
    sProgressBar2: TsProgressBar;
    sProgressBar3: TsProgressBar;
    Timer2: TTimer;

    IdHTTP2: TIdHTTP;

    sTabSheet4: TsTabSheet;
    sGroupBox11: TsGroupBox;
    Image2: TImage;
    sLabel1: TsLabel;procedure A1Click(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure L1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure sListBox1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure sListView1DblClick(Sender: TObject);
    procedure sListBox5DblClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure IdHTTP2Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure IdHTTP2WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure IdHTTP2WorkEnd(ASender: TObject; AWorkMode: TWorkMode);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$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 TForm1.A1Click(Sender: TObject);
begin
  ShowMessage('Contact to lepuke[at]hotmail[com]');
end;

procedure TForm1.E1Click(Sender: TObject);
begin
  Form1.Close();
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  dir: string;
  search: TSearchRec;
  cantidad: Integer;
begin
  sProgressBar1.Max := 0;
  sProgressBar2.Max := 0;
  sProgressBar3.Max := 0;

  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'fm';
  sSkinManager1.Active := True;

  begin

    dir := ExtractFilePath(Application.ExeName) + '/downloads';

    if not(DirectoryExists(dir)) then
    begin
      CreateDir(dir);
    end;

    ChDir(dir);

    sListBox5.Clear;

    cantidad := FindFirst(ExtractFilePath(Application.ExeName)
        + '/downloads/' + '*.mp3', faAnyFile, search);

    while cantidad = 0 do
    begin
      if FileExists(dir + '/' + search.name) then
      begin
        sListBox5.Items.Add(search.name);
      end;
      cantidad := FindNext(search);
    end;
    FindClose(search);
  end;

end;

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

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

procedure TForm1.IdHTTP2WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
var
  dir: string;
  search: TSearchRec;
  cantidad: Integer;
begin
  sProgressBar2.Position := 0;

  sListBox5.Clear;

  dir := ExtractFilePath(Application.ExeName) + '/downloads';

  cantidad := FindFirst(ExtractFilePath(Application.ExeName)
      + '/downloads/' + '*.mp3', faAnyFile, search);

  while cantidad = 0 do
  begin
    if FileExists(dir + '/' + search.name) then
    begin
      sListBox5.Items.Add(search.name);
    end;
    cantidad := FindNext(search);
  end;
  FindClose(search);

end;

procedure TForm1.L1Click(Sender: TObject);
var
  dir: string;
  search: TSearchRec;
  cantidad: Integer;

begin

  SelectDirectory('Select a folder', '', dir);

  sListBox1.Clear;

  sEdit1.Text := dir;
  cantidad := FindFirst(dir + '/' + '*.mp3', faAnyFile, search);

  while cantidad = 0 do
  begin
    if FileExists(dir + '/' + search.name) then
    begin
      sListBox1.Items.Add(search.name);
    end;
    cantidad := FindNext(search);
  end;
  FindClose(search);

end;

procedure TForm1.R1Click(Sender: TObject);
begin
  sEdit1.Text := '';
  sProgressBar1.Max := 0;
  sListBox1.Clear;
end;

procedure TForm1.sButton1Click(Sender: TObject);
var
  cancion: string;
  code: string;
  nombre: string;
  datos: string;
  link: string;
  i: Integer;
begin

  sListBox2.Clear;
  sListBox3.Clear;
  sListBox4.Clear;
  sListView1.Clear;

  cancion := sEdit2.Text;
  cancion := StringReplace(cancion, ' ', '-', [rfReplaceAll, rfIgnoreCase]);

  sStatusBar1.Panels[0].Text := '[+] Searching ... ';
  sStatusBar1.Update;

  code := IdHTTP1.Get('http://mp3skull.com/mp3/' + cancion + '.html');

  PerlRegEx1.Regex := '<div style="font-size:15px;"><b>(.*)<\/b><\/div>';
  PerlRegEx1.Subject := code;

  while PerlRegEx1.MatchAgain do
  // if PerlRegEx1.Match then
  begin
    nombre := PerlRegEx1.SubExpressions[1];
    sListBox2.Items.Add(nombre);
  end;

  PerlRegEx1.Regex := '<!-- info mp3 here -->\s+(.*?)<\/div>';
  PerlRegEx1.Subject := code;

  while PerlRegEx1.MatchAgain do
  // if PerlRegEx1.Match then
  begin
    datos := PerlRegEx1.SubExpressions[1];
    datos := StringReplace(datos, '<br \/>', ' ', [rfReplaceAll, rfIgnoreCase]);
    datos := StringReplace(datos, '<br />', ' ', [rfReplaceAll, rfIgnoreCase]);
    sListBox3.Items.Add(datos);
  end;

  PerlRegEx1.Regex := '<a href=\"(.*)\.mp3\"';
  PerlRegEx1.Subject := code;

  while PerlRegEx1.MatchAgain do
  // if PerlRegEx1.Match then
  begin
    link := PerlRegEx1.SubExpressions[1] + '.mp3';
    sListBox4.Items.Add(link);
  end;

  for i := 0 to sListBox2.Count - 1 do
  begin
    // ShowMessage(IntToStr(i));
    with sListView1.Items.Add do
    begin
      Caption := sListBox2.Items[i];
      SubItems.Add(sListBox3.Items[i]);
    end;
  end;

  sStatusBar1.Panels[0].Text := '[+] Finished ';
  sStatusBar1.Update;

end;

procedure TForm1.sListBox1DblClick(Sender: TObject);
begin

  sProgressBar1.Max := 0;

  MediaPlayer1.Close;
  MediaPlayer1.FileName := sEdit1.Text + '/' + sListBox1.Items.Strings
    [sListBox1.ItemIndex];
  MediaPlayer1.Open;

  sProgressBar1.Max := MediaPlayer1.Length;
end;

procedure TForm1.sListBox5DblClick(Sender: TObject);
begin

  MediaPlayer2.Close;
  MediaPlayer2.FileName := ExtractFilePath(Application.ExeName)
    + '/downloads' + '/' + sListBox5.Items.Strings[sListBox5.ItemIndex];
  MediaPlayer2.Open;

  sProgressBar3.Max := MediaPlayer2.Length;

end;

procedure TForm1.sListView1DblClick(Sender: TObject);
var
  FileName: string;
  nombrefinal: string;
  archivobajado: TFileStream;
  url: string;

begin

  url := sListBox4.Items[sListView1.Selected.Index];

  nombrefinal := getfilename(url);

  archivobajado := TFileStream.Create(ExtractFilePath(Application.ExeName)
      + '/downloads' + '/' + nombrefinal, fmCreate);

  try

    begin
      DeleteFile(nombrefinal);
      IdHTTP2.Get(url, 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;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if sProgressBar1.Max <> 0 then
  begin
    sProgressBar1.Position := MediaPlayer1.Position;
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  if sProgressBar3.Max <> 0 then
  begin
    sProgressBar3.Position := MediaPlayer2.Position;
  end;

end;

end.

// The End ?

Available for download here (http://sourceforge.net/projects/dhplayer/)

: Re: [Delphi] DH Player 0.5
: Kulverstukas February 28, 2014, 05:28:08 PM

I see you use Borland/Embarcadero Delphi IDE. Very nice, which one do you use?

: Re: [Delphi] DH Player 0.5
: Doddy February 28, 2014, 06:15:47 PM

I just moved to Delphi XE2