elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Recuerda que debes registrarte en el foro para poder participar (preguntar y responder)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  [Delphi] DH Player 0.5
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Delphi] DH Player 0.5  (Leído 1,503 veces)
BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Delphi] DH Player 0.5
« en: 28 Febrero 2014, 16:35 pm »

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 :



El codigo :

Código
  1. // DH Player 0.5
  2. // Coded By Doddy H
  3. // Based on this article : http://delphi.about.com/od/multimedia/l/aa112800a.htm
  4.  
  5. unit mp3player;
  6.  
  7. interface
  8.  
  9. uses
  10.  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  11.  Dialogs, Menus, StdCtrls, sListBox, sSkinManager, MPlayer, sGroupBox, jpeg,
  12.  ExtCtrls, ComCtrls, acProgressBar, Buttons, FileCtrl, sEdit, sPageControl,
  13.  sStatusBar, sButton, PerlRegEx, IdBaseComponent, IdComponent, IdTCPConnection,
  14.  IdTCPClient, IdHTTP, sListView, acPNG, sLabel;
  15.  
  16. type
  17.  TForm1 = class(TForm)
  18.    sSkinManager1: TsSkinManager;
  19.    Image1: TImage;
  20.    PopupMenu1: TPopupMenu;
  21.    L1: TMenuItem;
  22.    R1: TMenuItem;
  23.    A1: TMenuItem;
  24.    E1: TMenuItem;
  25.    Timer1: TTimer;
  26.    sPageControl1: TsPageControl;
  27.    sTabSheet1: TsTabSheet;
  28.    sGroupBox4: TsGroupBox;
  29.    MediaPlayer1: TMediaPlayer;
  30.    sGroupBox2: TsGroupBox;
  31.    sEdit1: TsEdit;
  32.    sGroupBox5: TsGroupBox;
  33.    sListBox1: TsListBox;
  34.    sGroupBox1: TsGroupBox;
  35.    sProgressBar1: TsProgressBar;
  36.    sTabSheet2: TsTabSheet;
  37.    sStatusBar1: TsStatusBar;
  38.    sGroupBox3: TsGroupBox;
  39.    sEdit2: TsEdit;
  40.    sListBox2: TsListBox;
  41.    sListBox3: TsListBox;
  42.    sListBox4: TsListBox;
  43.    sButton1: TsButton;
  44.    IdHTTP1: TIdHTTP;
  45.    PerlRegEx1: TPerlRegEx;
  46.    sGroupBox6: TsGroupBox;
  47.    sListView1: TsListView;
  48.    sTabSheet3: TsTabSheet;
  49.    sGroupBox7: TsGroupBox;
  50.    MediaPlayer2: TMediaPlayer;
  51.    sGroupBox8: TsGroupBox;
  52.    sListBox5: TsListBox;
  53.    sGroupBox9: TsGroupBox;
  54.    sGroupBox10: TsGroupBox;
  55.    sProgressBar2: TsProgressBar;
  56.    sProgressBar3: TsProgressBar;
  57.    Timer2: TTimer;
  58.  
  59.    IdHTTP2: TIdHTTP;
  60.  
  61.    sTabSheet4: TsTabSheet;
  62.    sGroupBox11: TsGroupBox;
  63.    Image2: TImage;
  64.    sLabel1: TsLabel;procedure A1Click(Sender: TObject);
  65.    procedure E1Click(Sender: TObject);
  66.    procedure R1Click(Sender: TObject);
  67.    procedure L1Click(Sender: TObject);
  68.    procedure Timer1Timer(Sender: TObject);
  69.    procedure sListBox1DblClick(Sender: TObject);
  70.    procedure FormCreate(Sender: TObject);
  71.    procedure sButton1Click(Sender: TObject);
  72.    procedure sListView1DblClick(Sender: TObject);
  73.    procedure sListBox5DblClick(Sender: TObject);
  74.    procedure Timer2Timer(Sender: TObject);
  75.    procedure IdHTTP2Work(ASender: TObject; AWorkMode: TWorkMode;
  76.      AWorkCount: Int64);
  77.    procedure IdHTTP2WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  78.      AWorkCountMax: Int64);
  79.    procedure IdHTTP2WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  80.  
  81.  private
  82.    { Private declarations }
  83.  public
  84.    { Public declarations }
  85.  end;
  86.  
  87. var
  88.  Form1: TForm1;
  89.  
  90. implementation
  91.  
  92. {$R *.dfm}
  93. // Functions
  94.  
  95. function getfilename(archivo: string): string;
  96. var
  97.  test: TStrings;
  98. begin
  99.  
  100.  test := TStringList.Create;
  101.  test.Delimiter := '/';
  102.  test.DelimitedText := archivo;
  103.  Result := test[test.Count - 1];
  104.  
  105.  test.Free;
  106.  
  107. end;
  108.  
  109. //
  110.  
  111. procedure TForm1.A1Click(Sender: TObject);
  112. begin
  113.  ShowMessage('Contact to lepuke[at]hotmail[com]');
  114. end;
  115.  
  116. procedure TForm1.E1Click(Sender: TObject);
  117. begin
  118.  Form1.Close();
  119. end;
  120.  
  121. procedure TForm1.FormCreate(Sender: TObject);
  122. var
  123.  dir: string;
  124.  search: TSearchRec;
  125.  cantidad: Integer;
  126. begin
  127.  sProgressBar1.Max := 0;
  128.  sProgressBar2.Max := 0;
  129.  sProgressBar3.Max := 0;
  130.  
  131.  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  132.  sSkinManager1.SkinName := 'fm';
  133.  sSkinManager1.Active := True;
  134.  
  135.  begin
  136.  
  137.    dir := ExtractFilePath(Application.ExeName) + '/downloads';
  138.  
  139.    if not(DirectoryExists(dir)) then
  140.    begin
  141.      CreateDir(dir);
  142.    end;
  143.  
  144.    ChDir(dir);
  145.  
  146.    sListBox5.Clear;
  147.  
  148.    cantidad := FindFirst(ExtractFilePath(Application.ExeName)
  149.        + '/downloads/' + '*.mp3', faAnyFile, search);
  150.  
  151.    while cantidad = 0 do
  152.    begin
  153.      if FileExists(dir + '/' + search.name) then
  154.      begin
  155.        sListBox5.Items.Add(search.name);
  156.      end;
  157.      cantidad := FindNext(search);
  158.    end;
  159.    FindClose(search);
  160.  end;
  161.  
  162. end;
  163.  
  164. procedure TForm1.IdHTTP2Work(ASender: TObject; AWorkMode: TWorkMode;
  165.  AWorkCount: Int64);
  166. begin
  167.  sProgressBar2.Position := AWorkCount;
  168.  sStatusBar1.Panels[0].Text := '[+] Downloading ...';
  169.  Form1.sStatusBar1.Update;
  170. end;
  171.  
  172. procedure TForm1.IdHTTP2WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  173.  AWorkCountMax: Int64);
  174. begin
  175.  sProgressBar2.Max := AWorkCountMax;
  176.  sStatusBar1.Panels[0].Text := '[+] Starting download ...';
  177.  Form1.sStatusBar1.Update;
  178. end;
  179.  
  180. procedure TForm1.IdHTTP2WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  181. var
  182.  dir: string;
  183.  search: TSearchRec;
  184.  cantidad: Integer;
  185. begin
  186.  sProgressBar2.Position := 0;
  187.  
  188.  sListBox5.Clear;
  189.  
  190.  dir := ExtractFilePath(Application.ExeName) + '/downloads';
  191.  
  192.  cantidad := FindFirst(ExtractFilePath(Application.ExeName)
  193.      + '/downloads/' + '*.mp3', faAnyFile, search);
  194.  
  195.  while cantidad = 0 do
  196.  begin
  197.    if FileExists(dir + '/' + search.name) then
  198.    begin
  199.      sListBox5.Items.Add(search.name);
  200.    end;
  201.    cantidad := FindNext(search);
  202.  end;
  203.  FindClose(search);
  204.  
  205. end;
  206.  
  207. procedure TForm1.L1Click(Sender: TObject);
  208. var
  209.  dir: string;
  210.  search: TSearchRec;
  211.  cantidad: Integer;
  212.  
  213. begin
  214.  
  215.  SelectDirectory('Select a folder', '', dir);
  216.  
  217.  sListBox1.Clear;
  218.  
  219.  sEdit1.Text := dir;
  220.  cantidad := FindFirst(dir + '/' + '*.mp3', faAnyFile, search);
  221.  
  222.  while cantidad = 0 do
  223.  begin
  224.    if FileExists(dir + '/' + search.name) then
  225.    begin
  226.      sListBox1.Items.Add(search.name);
  227.    end;
  228.    cantidad := FindNext(search);
  229.  end;
  230.  FindClose(search);
  231.  
  232. end;
  233.  
  234. procedure TForm1.R1Click(Sender: TObject);
  235. begin
  236.  sEdit1.Text := '';
  237.  sProgressBar1.Max := 0;
  238.  sListBox1.Clear;
  239. end;
  240.  
  241. procedure TForm1.sButton1Click(Sender: TObject);
  242. var
  243.  cancion: string;
  244.  code: string;
  245.  nombre: string;
  246.  datos: string;
  247.  link: string;
  248.  i: Integer;
  249. begin
  250.  
  251.  sListBox2.Clear;
  252.  sListBox3.Clear;
  253.  sListBox4.Clear;
  254.  sListView1.Clear;
  255.  
  256.  cancion := sEdit2.Text;
  257.  cancion := StringReplace(cancion, ' ', '-', [rfReplaceAll, rfIgnoreCase]);
  258.  
  259.  sStatusBar1.Panels[0].Text := '[+] Searching ... ';
  260.  sStatusBar1.Update;
  261.  
  262.  code := IdHTTP1.Get('http://mp3skull.com/mp3/' + cancion + '.html');
  263.  
  264.  PerlRegEx1.Regex := '<div style="font-size:15px;"><b>(.*)<\/b><\/div>';
  265.  PerlRegEx1.Subject := code;
  266.  
  267.  while PerlRegEx1.MatchAgain do
  268.  // if PerlRegEx1.Match then
  269.  begin
  270.    nombre := PerlRegEx1.SubExpressions[1];
  271.    sListBox2.Items.Add(nombre);
  272.  end;
  273.  
  274.  PerlRegEx1.Regex := '<!-- info mp3 here -->\s+(.*?)<\/div>';
  275.  PerlRegEx1.Subject := code;
  276.  
  277.  while PerlRegEx1.MatchAgain do
  278.  // if PerlRegEx1.Match then
  279.  begin
  280.    datos := PerlRegEx1.SubExpressions[1];
  281.    datos := StringReplace(datos, '<br \/>', ' ', [rfReplaceAll, rfIgnoreCase]);
  282.    datos := StringReplace(datos, '<br />', ' ', [rfReplaceAll, rfIgnoreCase]);
  283.    sListBox3.Items.Add(datos);
  284.  end;
  285.  
  286.  PerlRegEx1.Regex := '<a href=\"(.*)\.mp3\"';
  287.  PerlRegEx1.Subject := code;
  288.  
  289.  while PerlRegEx1.MatchAgain do
  290.  // if PerlRegEx1.Match then
  291.  begin
  292.    link := PerlRegEx1.SubExpressions[1] + '.mp3';
  293.    sListBox4.Items.Add(link);
  294.  end;
  295.  
  296.  for i := 0 to sListBox2.Count - 1 do
  297.  begin
  298.    // ShowMessage(IntToStr(i));
  299.    with sListView1.Items.Add do
  300.    begin
  301.      Caption := sListBox2.Items[i];
  302.      SubItems.Add(sListBox3.Items[i]);
  303.    end;
  304.  end;
  305.  
  306.  sStatusBar1.Panels[0].Text := '[+] Finished ';
  307.  sStatusBar1.Update;
  308.  
  309. end;
  310.  
  311. procedure TForm1.sListBox1DblClick(Sender: TObject);
  312. begin
  313.  
  314.  sProgressBar1.Max := 0;
  315.  
  316.  MediaPlayer1.Close;
  317.  MediaPlayer1.FileName := sEdit1.Text + '/' + sListBox1.Items.Strings
  318.    [sListBox1.ItemIndex];
  319.  MediaPlayer1.Open;
  320.  
  321.  sProgressBar1.Max := MediaPlayer1.Length;
  322. end;
  323.  
  324. procedure TForm1.sListBox5DblClick(Sender: TObject);
  325. begin
  326.  
  327.  MediaPlayer2.Close;
  328.  MediaPlayer2.FileName := ExtractFilePath(Application.ExeName)
  329.    + '/downloads' + '/' + sListBox5.Items.Strings[sListBox5.ItemIndex];
  330.  MediaPlayer2.Open;
  331.  
  332.  sProgressBar3.Max := MediaPlayer2.Length;
  333.  
  334. end;
  335.  
  336. procedure TForm1.sListView1DblClick(Sender: TObject);
  337. var
  338.  FileName: string;
  339.  nombrefinal: string;
  340.  archivobajado: TFileStream;
  341.  url: string;
  342.  
  343. begin
  344.  
  345.  url := sListBox4.Items[sListView1.Selected.Index];
  346.  
  347.  nombrefinal := getfilename(url);
  348.  
  349.  archivobajado := TFileStream.Create(ExtractFilePath(Application.ExeName)
  350.      + '/downloads' + '/' + nombrefinal, fmCreate);
  351.  
  352.  try
  353.  
  354.    begin
  355.      DeleteFile(nombrefinal);
  356.      IdHTTP2.Get(url, archivobajado);
  357.      sStatusBar1.Panels[0].Text := '[+] File Dowloaded';
  358.      Form1.sStatusBar1.Update;
  359.      archivobajado.Free;
  360.    end;
  361.  except
  362.    sStatusBar1.Panels[0].Text := '[-] Failed download';
  363.    Form1.sStatusBar1.Update;
  364.    archivobajado.Free;
  365.    Abort;
  366.  end;
  367.  
  368. end;
  369.  
  370. procedure TForm1.Timer1Timer(Sender: TObject);
  371. begin
  372.  if sProgressBar1.Max <> 0 then
  373.  begin
  374.    sProgressBar1.Position := MediaPlayer1.Position;
  375.  end;
  376. end;
  377.  
  378. procedure TForm1.Timer2Timer(Sender: TObject);
  379. begin
  380.  if sProgressBar3.Max <> 0 then
  381.  begin
  382.    sProgressBar3.Position := MediaPlayer2.Position;
  383.  end;
  384.  
  385. end;
  386.  
  387. end.
  388.  
  389. // The End ?
  390.  

Si lo quieren bajar lo pueden hacer de aca.


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
dvd player
Multimedia
HpMaxi 1 1,589 Último mensaje 10 Marzo 2006, 07:51 am
por Sourraund
[Descarga] CodeGear RAD Studio - Delphi 2007 + Delphi for PHP « 1 2 3 »
Software
GroK 26 25,410 Último mensaje 14 Mayo 2014, 17:51 pm
por sebaseok
FLV Player v2.0.24
Multimedia
MicroAttackeR 0 2,188 Último mensaje 27 Octubre 2008, 18:41 pm
por MicroAttackeR
VMware Player 3.1.3. Crea y ejecuta máquinas virtuales con VMware Player
Software
wolfbcn 0 4,109 Último mensaje 23 Noviembre 2010, 21:11 pm
por wolfbcn
[Delphi] DH Player 0.1
Programación General
BigBear 0 1,616 Último mensaje 13 Mayo 2013, 23:40 pm
por BigBear
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines