![]() |
|
YouTube Downloader - نسخة قابلة للطباعة +- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum) +-- قسم : منتديات دلفي الأخرى (https://delphi4arab.net/forum/forumdisplay.php?fid=4) +--- قسم : برامج دلفي من عمل الأعضاء (https://delphi4arab.net/forum/forumdisplay.php?fid=27) +--- الموضوع : YouTube Downloader (/showthread.php?tid=1711) الصفحات:
1
2
|
YouTube Downloader - mohfa - 28-03-2010 يعمل وقد حملته : هل انت متصل وراء Proxy ؟ YouTube Downloader - khiro.alg - 01-08-2010 [color="darkorange"]السلام عليكم باركالله فيك أخي على البرنامج الجميل لكن أخي ممكن السورس حتى نتعلم من خبرتك وتفيد إخوانك المسلمين؟؟؟[/color] YouTube Downloader - Delphi 7 - 25-08-2010 السلام عليكم ورحمه الله وبركاته بصراحه برنامج رائع لكن توجد مشكله الى وهي : عندما اقوم بوضع رابط اليوتيوب او الفيديو المراد تحميله في الرنامج لا يقوم برنامجك بتحميل ؟ YouTube Downloader - greenhat - 15-11-2010 Delphi 7 كتب :السلام عليكم ورحمه الله وبركاتهعندي نفس المشكلة RE: YouTube Downloader - Delphi4Us - 05-04-2017 هذا كود للتحميل كود : 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 |