دخول

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

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة