Foro de elhacker.net

Un reproductor de musica , en esta version le agregue un buscador usando mp3skull para buscar y descargar canciones , para despues guardarlas en una carpeta llamada "downloads" y escucharlas cuando quieran.

Una imagen :

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

El codigo :

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

Si lo quieren bajar lo pueden hacer de aca (http://sourceforge.net/projects/dhplayer/).