Descargar un video de youtube en formato flv

[jlmsr63]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Urlmon, Buttons, StdCtrls, Ddeman, Wininet, MMSystem;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
SpeedButton2: TSpeedButton;
Label3: TLabel;
procedure SpeedButton2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function GetURL(Service: string): string;
var
ClDDE: TDDEClientConv;
temp: PChar;
begin
Result := '';
ClDDE := TDDEClientConv.Create(nil);
with ClDDE do
begin
SetLink(Service, 'WWW_GetWindowInfo');
temp := RequestData('0xFFFFFFFF');
Result := StrPas(temp);
StrDispose(temp);
CloseLink;
end;
ClDDE.Free;
end;

function Download(Url: string; Archivo: string): Boolean;
var
hFile: THandle;
hNet: HINTERNET;
hUrl: HINTERNET;
Buffer: array[0..102400] of Char;
BytesRead: DWORD;
BytesWritten: DWORD;
begin
Result := FALSE;
hFile := CreateFile(PChar(Archivo), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
hNet := InternetOpen('agent', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if (hNet <> nil) then
begin
hUrl := InternetOpenUrl(hNet, PChar(Url), nil, 0,
INTERNET_FLAG_RELOAD, 0);
if (hUrl <> nil) then
begin
while (InternetReadFile(hUrl, @Buffer, sizeof(Buffer), BytesRead)) do
begin
if (BytesRead = 0) then
begin
Result := TRUE;
break;
end;
if (not WriteFile(hFile, Buffer, BytesRead, BytesWritten, nil)) then
break;
if (BytesRead <> BytesWritten) then
break;
end;
InternetCloseHandle(hUrl);
end;
InternetCloseHandle(hNet);
end;
CloseHandle(hFile);
end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
// Copiar del Explorador
var
Video : String;
ca : iinterface;
stat : iBindStatusCallBack;
tag : _tagBindInfo;
exGuid : tguid;
rr : cardinal;
noIp : Pointer;
Linea : String;
f : textfile;
n : Integer;
direccion : String;
url_youtube : String;
id_youtube : String;
begin
Video := GetURL('IExplore');
Edit1.Text := copy(Video,Pos('http',Video),Pos('","',Video)-Pos('http',Video));
Form1.Caption := copy(Video,Pos('","',Video)+3,Length(Video)-(Pos('","',Video)+3))+'.flv';
try
// PlaySound(Pchar('START'),0,SND_ASYNC);
except
end;
// Buscar codigo de seguridad de Downloadyoutubevideos
rr := 0;
exGuid.D1 := rr;
exGuid.D2 := word('0');
exGuid.D3 := word('.');
id_youtube := copy(Edit1.Text,Pos('=',Edit1.Text)+1,length(Edit1.Text));
// Memo1.Lines.Add(id_youtube);
url_youtube := 'http://www.downloadyoutubevideos.com/watch.php?theyturl=http%3A%2F%2Fes.youtube.com%2Fwatch%3Fv%3D' + id_youtube + '&goYT=Download';
// Memo1.Lines.Add(url_youtube);
with tag do
begin
iid := exGuid;
cbSize := sizeOf(url_youtube);
securityAttributes.lpSecurityDescriptor := noIp;
securityAttributes.nLength := length('0.0.0.0');
securityAttributes.bInheritHandle := True;
end;
try
urlmon.URLDownloadToFile(ca, PAnsichar(url_youtube), 'MARIA YOUTUBE VIDEO.html', 1, stat);
except
ShowMessage('No es posible descargar la pagina web!');
end;
AssignFile(f,'MARIA YOUTUBE VIDEO.html');
reset(f);
for n := 1 to 200 do
begin
readln(f,Linea);
if Pos('DOWNLOAD VIDEO',Linea) <> 0 then
begin
direccion := copy(linea,Pos('http',Linea),Pos('">D',Linea)-Pos('http',Linea));
// memo1.Lines.Add(direccion);
end;
end;
Edit2.Text := direccion;
CloseFile(f);
try
PlaySound(Pchar('START'),0,SND_ASYNC);
except
end;
// Download de Youtube
Label3.Caption := '0%';
Download(Edit2.Text,'d:\'+Form1.Caption);
Label3.Caption := '100%';
try
PlaySound(Pchar('EXIT'),0,SND_ASYNC);
except
end;
end;

end.

[jlmsr63]

Si no desean copiar y pegar la direccion del video basta con pulsar el boton y la direccion sera extraida del explorador por defecto, disculpen el no indentado pero es mi primera vez aqui......

[[xEsk]]

Hola :)

Si quieres ver otra forma de bajar videos de Youtube y un montón mas (unos 55 sitios mas) -> http://xviservicethief.sourceforge.net/

Originalmente lo empecé a escribir en Delphi (hasta la 1.3a) por si quieres ver el código en Object Pascal lo puedes bajar desde ahí. Pero actualmente esta escrito en C++ y Qt4.

(Si quieres leer sobre sus inicios -> http://www.clubdelphi.com/foros/showthread.php?t=47798

Saludos.

[jlmsr63]

Te incluyo otros utilitarios para transformar videos agregarles pistas de audio volverlas stereo etc, etc, etc
// Para Convertir los Videos
//
//Para obtener información de un archivo de audio o video
//-------------------------------------------------------
//ffmpeg -i archivo.mpg
//
//Para cambiar tamaño a un archivo
//--------------------------------
//ffmpeg -i "e:\Fallados\Fey - Me cuesta tanto olvidarte.avi" -y -qscale 1 -sameq -vcodec msmpeg4v2 -s 320x240 "e:\videos\Fey - Me cuesta tanto olvidarte.avi"
//ffmpeg -i "e:\Fallados\Alejandro Sanz - Mi soledad y yo.avi" -y -qscale 1 -sameq -vcodec msmpeg4v2 -s 320x240 "e:\videos\Alejandro Sanz - Mi soledad y yo.avi"
//
//Para extraer el audio de un video
//---------------------------------
//ffmpeg -i "D:\Videos\Madonna - La isla bonita.avi" -y -vn -acodec copy "D:\Videos_\Madonna - La isla bonita.mp3"
//Para Metanormalizer Steinberg
// Equialize Loudnes RMS (activado)
// Maximize if possible (activado)
// Global (activado)
// Llevar todo los archivos a Wav
//Para normalizar en Volumen de todos los videos
//----------------------------------------------
//Para Normalizer ( Normaliza el Nivel de audio a 0db para que todos tengan el mismo volumen )
//Debes utilizar el Steinberg Wavelab
//
//Para convertir el audio a Stereo
//--------------------------------
//Aplica el efecto StereoExpander del Steinberg WaveLab
//
//Extraer el audio Usando codecs de audio mp3, mp2 y mp1 stereo o mono
//--------------------------------------------------------------------
//ffmpeg -i "D:\Videos\Fey - Me cuesta tanto olvidarte.avi" -y -vn -f mp3 "D:\Videos_\Fey - Me cuesta tanto olvidarte.mp3"
//
//Introducir archivo de audio (modificado) en el video y cambiar de tamaño y Cambiar el audio
//-------------------------------------------------------------------------------------------
//ffmpeg -y -i "D:\Videos\Fey - Me cuesta tanto olvidarte.avi" -i "D:\Videos_\Fey - Me cuesta tanto olvidarte.wav" -map 0:0 -map 1:0 -ss 00:00:00.000 -vcodec msmpeg4v2 -b 1000000 -qscale 1 -ac 2 -ab 128000 -ar 44100 -acodec libmp3lame -s 320x240 -f avi "D:\Videos_\Fey - Me cuesta tanto olvidarte.avi"
//
//Convierte archivo fvl a avi usando ffmpeg de dvdsoftvideodownload ( Reconoce codec mp3 )
//-----------------------------------------------------------------
//ffmpeg.exe -y -i "C:\DVDVideoSoft\Temp\video_download_temp_00_39_51_140.flv" -ss 0.00 -vcodec msmpeg4v2 -b 3000000 -acodec mp3 -f avi -year 30212472 -track 30212472 "D:\youtube - calo - formas de amor (video).avi"
//
//Convierte archivo vob ( DVD ) a avi
//-----------------------------------
//ffmpeg -y -i "D:\Video Vob\video.vob" -ss 00:00:00.000 -vcodec msmpeg4v2 -b 3000000 -sameq -qscale 1 -s 320x240 -f avi "D:\Video Vob\Video San Juan de Dios 320x240.avi"
//
//
//Para ejecutarlos desde delphi usas debes tener el ffmpeg en la carpeta del programa y la dll
//Luego usas esta rutina para que no tengas problemas de saturacion del cpu ni del disco duro que
//es muy comun en programas de este tipo ( Puedes convertir hasta 100 videos simultaneamente sin problemas )
//
// En el memo1 van los procesos,puedes cargarlos con loadfromfile ejemplo:
// ffmpeg.exe -y -i "C:\DVDVideoSoft\Temp\video_download_temp_00_39_51_140.flv" -ss 0.00 -vcodec msmpeg4v2 -b 3000000 -acodec mp3 -f avi -year 30212472 -track 30212472 "D:\youtube - calo - formas de amor (video).avi"
//

Delphi [-]procedure Runffmpeg(Que:String;EnMemo:TMemo);
const
CUANTOBUFFER = 2000;
var
Seguridades : TSecurityAttributes;
PaLeer,PaEscribir : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
CuandoSale : DWord;
begin
with Seguridades do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
{Creamos el pipe...}
if Createpipe (PaLeer, PaEscribir, @Seguridades, 0) then
begin
Buffer := AllocMem(CUANTOBUFFER + 1);
FillChar(Start,Sizeof(Start),#0);
start.cb := SizeOf(start);
start.hStdOutput := PaEscribir;
start.hStdInput := PaLeer;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;

if CreateProcess(nil,
PChar(Que),
@Seguridades,
@Seguridades,
true,
// Esto es importante para que no sature el CPU y el HD
IDLE_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
then
begin
// si ejecutas varios
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(PaLeer);
CloseHandle(PaEscribir);
end;
end;
var
i : integer;
InputString: string;
begin
for i:= 0 to Memo2.Lines.Count -1 do
begin
if (i mod 10)= 0 then
begin
InputString:= InputBox('Procesando los lotes', 'Continuamos con: '+inttostr(i), 'S');
if uppercase(InputString) <> 'S' then exit;
end;
Memo1.Lines.Add(memo2.Lines[i]);
Runffmpeg(pchar(memo2.Lines[i]),Memo1);
Memo1.Lines.Add(inttostr(i));
end;
end;

Que lo disfruten