28-03-2010, 11:08 AM
الصفحات : 1 2
01-08-2010, 02:56 PM
[color="darkorange"]السلام عليكم
باركالله فيك أخي على البرنامج الجميل
لكن أخي ممكن السورس حتى نتعلم من خبرتك وتفيد إخوانك المسلمين؟؟؟[/color]
باركالله فيك أخي على البرنامج الجميل
لكن أخي ممكن السورس حتى نتعلم من خبرتك وتفيد إخوانك المسلمين؟؟؟[/color]
25-08-2010, 07:07 PM
السلام عليكم ورحمه الله وبركاته
بصراحه برنامج رائع لكن توجد مشكله الى وهي : عندما اقوم بوضع رابط اليوتيوب او الفيديو المراد تحميله في الرنامج لا يقوم برنامجك بتحميل ؟
بصراحه برنامج رائع لكن توجد مشكله الى وهي : عندما اقوم بوضع رابط اليوتيوب او الفيديو المراد تحميله في الرنامج لا يقوم برنامجك بتحميل ؟
15-11-2010, 04:55 PM
Delphi 7 كتب :السلام عليكم ورحمه الله وبركاتهعندي نفس المشكلة
بصراحه برنامج رائع لكن توجد مشكله الى وهي : عندما اقوم بوضع رابط اليوتيوب او الفيديو المراد تحميله في الرنامج لا يقوم برنامجك بتحميل ؟
05-04-2017, 10:58 PM
هذا كود للتحميل
هذا مثال اخر متاح للتحميل
لمنصة لازروس انظرو هذه الصفحة
كود :
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الصفحات : 1 2