YouTube Downloader

[mohfa]

يعمل وقد حملته :

هل انت متصل وراء Proxy ؟

[khiro.alg]

[color="darkorange"]السلام عليكم
باركالله فيك أخي على البرنامج الجميل
لكن أخي ممكن السورس حتى نتعلم من خبرتك وتفيد إخوانك المسلمين؟؟؟[/color]

[Delphi 7]

السلام عليكم ورحمه الله وبركاته
بصراحه برنامج رائع لكن توجد مشكله الى وهي : عندما اقوم بوضع رابط اليوتيوب او الفيديو المراد تحميله في الرنامج لا يقوم برنامجك بتحميل ؟

[greenhat]

السلام عليكم ورحمه الله وبركاته
بصراحه برنامج رائع لكن توجد مشكله الى وهي : عندما اقوم بوضع رابط اليوتيوب او الفيديو المراد تحميله في الرنامج لا يقوم برنامجك بتحميل ؟

عندي نفس المشكلة

[Delphi4Us]

هذا كود للتحميل

كود :

unit uDownload;

interface

uses
 Classes,
 SysUtils,
 IDHttp,
 WinInet,
 Windows;

const
 c_YouTubeHeader = 'http://www.youtube.com/watch?v=';
 c_YouTubeHost = 'http://www.youtube.com/';

procedure TryDownloadYouTubeVideo(UrlPath: string; Dir: string);

implementation

procedure TryDownloadYouTubeVideo(UrlPath: string; Dir: string);
var
 http: TIdHttp;
 strm: TStringStream;
 FName: string;
 FUrl: string;

 function fnc_GetSourcePath: string;
 const
   c_sBeginPath = 'img.src = "http:\/\/';
   c_sMiddlePath = '\/';
   c_dMiddlePath = '/videoplayback?sparams=id%2Cexpire%2Cip%2Cipbits%2Citag%2Csource%2Cratebypass%2C';
   c_sEndPath = '"';
   c_dBeginPath = 'http://tc.';
   c_dEndPath = 'redirect_counter=1';

   c_sBreakChar1 = '%2C';
   c_sBreakChar2 = '\u0026';

   c_dBreakChar = '&';

 var
   tmpstr: string;
   tmpstrlst: TStringList;
   tmpRes: string;

   function fnc_IsTrash: Boolean;
   begin
     Result := (Pos(c_sBreakChar1, tmpstr) <> 0) and
               (Pos(c_sBreakChar2, tmpstr) <> 0) and
               (Pos(c_sBreakChar1, tmpstr) < Pos(c_sBreakChar2, tmpstr));
   end;

 begin
   Result := '';
   tmpstrlst := TStringList.Create;
   try
     tmpstr := strm.DataString;
     Delete(tmpstr, 1, Pos(c_sBeginPath, tmpstr) + Length(c_sBeginPath) - 1);
     Delete(tmpstr, Pos(c_sEndPath, tmpstr), Length(tmpstr));

     tmpstrlst.Delimiter := '.';
     tmpstrlst.DelimitedText := Copy(tmpstr, 1, Pos(c_sMiddlePath, tmpstr) - 1);

     tmpRes := Concat(c_dBeginPath,
                      tmpstrlst.Strings[3],
                      '.',
                      Copy(tmpstrlst.Strings[4], 3, Length(tmpstrlst.Strings[4])),
                      '.',
                      tmpstrlst.Strings[5],
                      '.',
                      tmpstrlst.Strings[6],
                      '.',
                      tmpstrlst.Strings[7],
                      c_dMiddlePath);

     while fnc_IsTrash do
       Delete(tmpstr, 1, Pos(c_sBreakChar1, tmpstr) + Length(c_sBreakChar1) - 1);

     tmpstrlst.Delimiter := c_dBreakChar;
     tmpstrlst.Clear;

     while Pos(c_sBreakChar2, tmpstr) <> 0 do
     begin
       tmpstrlst.Add(Copy(tmpstr, 1, Pos(c_sBreakChar2, tmpstr) - 1));
       Delete(tmpstr, 1, Pos(c_sBreakChar2, tmpstr) + Length(c_sBreakChar2) - 1);
     end;

     tmpstrlst.Add(tmpstr);
     tmpstrlst.Add(c_dEndPath);

     tmpRes := Concat(tmpRes,
                      tmpstrlst.DelimitedText);
   finally
     FreeAndNil(tmpstrlst);
   end;

   Result := tmpRes;
 end;

 function fnc_GetFileName: string;

   function fnc_GetDir: string;
   begin
     Result := Dir;
     if Result[Length(Result)] <> '\' then
       Result := Concat(Result, '\');
   end;

 const
   c_TitleBegin = '

---

هذا مثال اخر متاح للتحميل

كود :

http://www.planet-source-code.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=72656&strZipAccessCode=tp%2FS726562111

---

لمنصة لازروس انظرو هذه الصفحة

كود :

http://forum.lazarus.freepascal.org/index.php?topic=15884.0