unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  ExtCtrls, StdCtrls, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL,
  IdSSLOpenSSL;
type
  TForm1 = class(TForm)
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    Memo1: TMemo;
    Panel1: TPanel;
    IdHTTP1: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    function DownloadYoutubeMovie2FLV(AVideoID: string; ASavePath: string): Boolean;
  end;

var
  Form1: TForm1;

implementation

uses
  IdURI,
  StrUtils,
  SkRegularExpressions;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  LabeledEdit1.Text := 'https://youtu.be/Yq1Ip8IzR60';
end;
//=============================================================================
//  ダウンロード開始用ボタンクリック
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LIdURL   : TIdURI;
  LParams   : string;
  LStrList  : TStringList;
  LLeftText : string;
  LVideoID  : string;
  LLoopCnt  : Integer;
  LResult   : Boolean;
begin
  Memo1.Lines.Clear;
  Memo1.Update;
  Button1.Enabled := False;
  Button1.Update;

  Screen.Cursor := crHourGlass;
  LVideoID := '';
  LIdURL   := TIdURI.Create(Trim(LabeledEdit1.Text));
  try
    LParams := LIdURL.Params;
    if Trim(LParams) <> '' then begin
      LStrList := TStringList.Create;
      try
        LStrList.Delimiter := '&';
        LStrList.DelimitedText := LParams;

        LLeftText := 'v=';
        for LLoopCnt := 0 to LStrList.Count - 1 do begin
          if StartsText(LLeftText, LStrList[LLoopCnt]) then begin
            LVideoID := StrUtils.ReplaceText(LStrList[LLoopCnt], LLeftText, '');
            Break;
          end;
        end;
      finally
        FreeAndNil(LStrList);
      end;
    end else begin
      LVideoID := LIdURL.Document;
    end;


    LResult := False;
    for LLoopCnt := 0 to 2 do begin
      if DownloadYoutubeMovie2FLV(LVideoID, 'Youtube.flv') then begin
        MessageDlg('ダウンロード終了', mtInformation, [mbOK], 0);
        LResult := True;
        break;
      end;
    end;
    if not LResult then begin
      MessageDlg('失敗しました', mtWarning, [mbOK], 0);
    end;
  finally
    FreeAndNil(LIdURL);
    Screen.Cursor := crDefault;
  end;
  Button1.Enabled := True;
  Button1.SetFocus;
end;

//-----------------------------------------------------------------------------
//  ビデオIDを指定してYoutubeの動画をダウンロードする関数
//  失敗することも多いので注意
//-----------------------------------------------------------------------------
function TForm1.DownloadYoutubeMovie2FLV(AVideoID: string;
  ASavePath: string): Boolean;
var
  LTargetUrl   : string;
  LMemStream   : TMemoryStream;
  LStrList     : TStringList;
  LbasePattern : string;
  LBaseText    : string;
  LMatch       : TMatch;
  LDirectUrl   : string;
begin
  Result := False;
  if AVideoID = '' then exit;

  if IdHTTP1.Connected then begin
    IdHTTP1.Disconnect;
  end;

  //送信するリクエスト文字列
  LTargetUrl := 'https://www.youtube.com/get_video_info?video_id=' + AVideoID;

  LMemStream := TMemoryStream.Create;
  LStrList   := TStringList.Create;
  try
    try
      IdHTTP1.Request.UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
      IdHTTP1.Get(LTargetUrl, LMemStream);

      LMemStream.Position := 0;
      LStrList.LoadFromStream(LMemStream, TEncoding.UTF8);


      if (IdHTTP1.ResponseCode >= 100) and (IdHTTP1.ResponseCode <= 399) then begin

        LbasePattern := 'url_encoded_fmt_stream_map=([^&]+)';
        LBaseText := TRegEx.Match(LStrList.Text, LbasePattern).Value;
        //取得した文字列をデコードする
        LBaseText := TIdURI.URLDecode(LBaseText);

        //取得したテキストから最初のurl=の部分を取り出す
        LDirectUrl := '';
        for LMatch in TRegEx.Matches(LBaseText, 'url=([^&]+)') do begin
          LDirectUrl := LMatch.Groups[1].Value;
          LDirectUrl := TIdURI.URLDecode(LDirectUrl);
          break;
        end;
        if Trim(LDirectUrl) = '' then exit;

        //以下の文字を変換しておく(他にも変換が必要な文字があるかも知れない)
        //変換しないと失敗する可能性が高い
        LDirectUrl := ReplaceText  (LDirectUrl, '%2C', ',');
        LDirectUrl := ReplaceText  (LDirectUrl, '%2F', '/');
        LDirectUrl := ReplaceText  (LDirectUrl, '+', ' ');

        //取得したダウンロード用のURLを表示
        Memo1.Lines.Text := LDirectUrl;
        Memo1.Update;

        //ダイレクトURLから動画ファイルをダウンロード
        //時間がかかる
        LMemStream.Clear;
        IdHTTP1.Get(LDirectUrl, LMemStream);
        LMemStream.Position := 0;
        LMemStream.SaveToFile(ASavePath);

        Result := True;
      end;
    except
    end;
  finally
    FreeAndNil(LMemStream);
    FreeAndNil(LStrList);
  end;
end;

end.

function TForm1.DownloadYoutubeMovie2FLV(AVideoID: string;
  ASavePath: string): Boolean;
var
  LTargetUrl   : string;
  LMemStream   : TMemoryStream;
  LStrList     : TStringList;
  LbasePattern : string;
  LBaseText    : string;
  LDirectUrl   : string;
begin
  Result := False;

  if IdHTTP1.Connected then begin
    IdHTTP1.Disconnect;
  end;

  //送信するリクエスト文字列
  LTargetUrl := 'https://www.youtube.com/get_video_info?video_id=' + AVideoID;

  LMemStream := TMemoryStream.Create;
  LStrList   := TStringList.Create;
  try
    try
      IdHTTP1.Request.UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
      IdHTTP1.Get(LTargetUrl, LMemStream);

      LMemStream.Position := 0;
      LStrList.LoadFromStream(LMemStream, TEncoding.UTF8);


      if (IdHTTP1.ResponseCode >= 100) and (IdHTTP1.ResponseCode <= 399) then begin

        LbasePattern := 'url_encoded_fmt_stream_map=([^&]+)';
        LBaseText := TRegEx.Match(LStrList.Text, LbasePattern).Value;
        //取得した文字列をデコードする
        LBaseText := TIdURI.URLDecode(LBaseText);

        //取得したテキストからurl=の部分を取り出す
        LDirectUrl := TRegEx.Match(LBaseText, 'url=([^&]+)').Value;

        LDirectUrl := TIdURI.URLDecode(LDirectUrl);
        LDirectUrl := StrUtils.ReplaceText(LDirectUrl, 'url=', '');
        LDirectUrl := StrUtils.ReplaceText(LDirectUrl, '%2C', ',');
        LDirectUrl := StrUtils.ReplaceText(LDirectUrl, '%2F', '/');
        LDirectUrl := StrUtils.ReplaceText(LDirectUrl, '+', ' ');

        //各パラメータに分割
        LStrList.Clear;
        LStrList.Delimiter := '&';
        LStrList.DelimitedText := LDirectUrl;

        //結果を表示
        Memo1.Lines.Text := LStrList.Text;

        Result := True;
      end;
    except
    end;
  finally
    FreeAndNil(LMemStream);
    FreeAndNil(LStrList);
  end;
end;

function TForm1.DownloadYoutubeMovie2FLV(AVideoID: string;
  ASavePath: string): Boolean;
var
  LTargetUrl   : string;
  LMemStream   : TMemoryStream;
  LStrList     : TStringList;
  LbasePattern : string;
  LBaseText    : string;
  LTempText    : string;
  LLoopCnt     : Integer;
begin
  Result := False;

  if IdHTTP1.Connected then begin
    IdHTTP1.Disconnect;
  end;

  //送信するリクエスト文字列
  LTargetUrl := 'https://www.youtube.com/get_video_info?video_id=' + AVideoID;

  LMemStream := TMemoryStream.Create;
  LStrList   := TStringList.Create;
  try
    try
      IdHTTP1.Request.UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
      IdHTTP1.Get(LTargetUrl, LMemStream);

      LMemStream.Position := 0;
      LStrList.LoadFromStream(LMemStream, TEncoding.UTF8);


      if (IdHTTP1.ResponseCode >= 100) and (IdHTTP1.ResponseCode <= 399) then begin

        LbasePattern := 'url_encoded_fmt_stream_map=([^&]+)';
        LBaseText := TRegEx.Match(LStrList.Text, LbasePattern).Value;

        //取得した文字列をデコードする
        LBaseText := TIdURI.URLDecode(LBaseText);

        LStrList.Clear;
        LStrList.Delimiter := '&';
        LStrList.DelimitedText := LBaseText;

        for LLoopCnt := 0 to LStrList.Count - 1 do begin
          LTempText := TIdURI.URLDecode(LStrList[LLoopCnt]);
          LTempText := ReplaceText  (LTempText, '%2C', ',');
          LTempText := ReplaceText  (LTempText, '%2F', '/');
          LTempText := ReplaceText  (LTempText, '+', ' ');

          LStrList[LLoopCnt] := LTempText;
        end;
        LStrList.SaveToFile('MovieInfo.txt');

        Result := True;
      end;
    except
    end;
  finally
    FreeAndNil(LMemStream);
    FreeAndNil(LStrList);
  end;
end;

function TForm1.DownloadYoutubeMovie2FLV(AVideoID: string;
  ASavePath: string): Boolean;
var
  LTargetUrl : string;
  LMemStream : TMemoryStream;
  LStrList   : TStringList;
  LBaseText  : string;
  LTempText  : string;
  LLoopCnt   : Integer;
begin
  Result := False;

  if IdHTTP1.Connected then begin
    IdHTTP1.Disconnect;
  end;

  //送信するリクエスト文字列
  LTargetUrl := 'https://www.youtube.com/get_video_info?video_id=' + AVideoID;

  LMemStream := TMemoryStream.Create;
  LStrList   := TStringList.Create;
  try
    try
      IdHTTP1.Request.UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
      IdHTTP1.Get(LTargetUrl, LMemStream);

      LMemStream.Position := 0;
      LStrList.LoadFromStream(LMemStream, TEncoding.UTF8);


      if (IdHTTP1.ResponseCode >= 100) and (IdHTTP1.ResponseCode <= 399) then begin

        //取得した文字列をデコードする
        LBaseText := TIdURI.URLDecode(LStrList.Text);

        LStrList.Clear;
        LStrList.Delimiter := '&';
        LStrList.DelimitedText := LBaseText;

        for LLoopCnt := 0 to LStrList.Count - 1 do begin
          LTempText := TIdURI.URLDecode(LStrList[LLoopCnt]);
          LTempText := ReplaceText  (LTempText, '%2C', ',');
          LTempText := ReplaceText  (LTempText, '%2F', '/');
          LTempText := ReplaceText  (LTempText, '+', ' ');

          LStrList[LLoopCnt] := LTempText;
        end;
        //取得した情報をテキストファイルに保存
        LStrList.SaveToFile('VideoInfo.txt');

        Result := True;
      end;
    except
    end;
  finally
    FreeAndNil(LMemStream);
    FreeAndNil(LStrList);
  end;
end;

      if (IdHTTP1.ResponseCode >= 100) and (IdHTTP1.ResponseCode <= 399) then begin

        LbasePattern := 'title=([^&]+)';
        LResText := TRegEx.Match(LStrList.Text, LbasePattern).Value;
        //取得した文字列をデコードする
        LResText := TIdURI.URLDecode(LResText);
        LResText := StrUtils.ReplaceText(LResText, '+', ' ');

        Memo1.Text := LResText;

        Result := Length(LResText) > 0;
      end;

uses
  SkRegularExpressions;

{$R *.dfm}

//=============================================================================
//  Youtubeの動画再生ページのHTMLコードから動画の情報を取得する例
//  公開日を取得する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMovieUrl : string;
  LHtmlCode : TStringList;
  LPattern  : string;
  LMatch    : TMatch;
  LResText  : string;
begin
  Memo1.Lines.Clear;
  LMovieUrl := 'https://www.youtube.com/watch?v=Yq1Ip8IzR60';

  LHtmlCode := TStringList.Create;
  IdHTTP1.HandleRedirects := True;
  try
    try
      LHtmlCode.Text := IdHTTP1.Get(LMovieUrl);

      LResText := '';
      LPattern := 'class="watch-time-text">(.*?)<';
      for LMatch in TRegEx.Matches(LHtmlCode.Text, LPattern) do begin
        LResText := LMatch.Groups[1].Value;
      end;
      if LResText <> '' then begin
        Memo1.Lines.Add(LResText);
        LResText := TRegEx.Match(LResText, '[0-9 /]*').Value;
        Memo1.Lines.Add(LResText);
      end;
    except
    end;
    IdHTTP1.Disconnect;
  finally
    FreeAndNil(LHtmlCode);
  end;
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    WebBrowser1: TWebBrowser;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MSHTML;

{$R *.dfm}

//=============================================================================
//  TWebBrowserでYoutubeの動画を再生
//
//  TWebBrowser.Navigateメソッドを使用する例
//  引数のURLは埋め込みコードのURLを指定する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LWebPage : string;
begin
  LWebPage := 'https://www.youtube.com/embed/6tr2__Tv2I4';
  WebBrowser1.Navigate(LWebPage);
end;

//=============================================================================
//  TWebBrowserでYoutubeの動画を再生
//
//  HTMLコードを作成して,それをTWebBrowserで表示する例
//  usesにMSHTMLが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LHtmlCode  : string;
  LIEObject  : InternetExplorer;
  LIHTMLDoc2 : IHTMLDocument2;
begin
  //IEのオブジェクトを取得
  LIEObject := WebBrowser1.Application as InternetExplorer;

  //about:blankは表示のクリアとしても利用できる
  WebBrowser1.Navigate('about:blank');
  //準備完了まで待つ
  while LIEObject.ReadyState < READYSTATE_INTERACTIVE do begin
    Application.ProcessMessages;
  end;

  //HTMLコードを作成
  LHtmlCode := '<html>'
             + '<center>'
             + '<iframe width="100%" height="365" '
             + 'src="https://www.youtube.com/embed/6tr2__Tv2I4'
             + '?rel=0&showinfo=0" frameborder="0" '
             + 'allow="autoplay; encrypted-media" allowfullscreen></iframe>'
             + '</center>'
             + '</html>';

  if Assigned(LIEObject.Document) then begin
    //TWebBrowserに表示(IEオブジェクトに表示)
    LIHTMLDoc2 := LIEObject.Document as IHTMLDocument2;
    LIHTMLDoc2.body.innerHTML := LHtmlCode;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    EmbeddedWB1: TEmbeddedWB;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EmbeddedWB1NavigateComplete2(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フェーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'https://www.youtube.com/watch?v=Yq1Ip8IzR60';
  EmbeddedWB1.Navigate(Trim(Edit1.Text));
end;

//=============================================================================
//  Edit1のOnKeyDownイベント
//  [Enter]キーを押下したらEdit1のURLを表示
//=============================================================================
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    EmbeddedWB1.Navigate(Trim(Edit1.Text));
  end;
end;

//=============================================================================
//  ファイルに保存しているJavaScriptのコードを読み出して
//  表示中のウェブページに対してJavaScriptのコードをセットする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList : TStringList;
begin
  LStrList := TStringList.Create;
  try
    LStrList.LoadFromFile(ExpandFileName('.\Youtube_JS.txt'));
    EmbeddedWB1.ExecScript(LStrList.Text, 'javascript');
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  表示中のウェブページのURLをTEditに表示
//  他に適切なイベントがあるかも知れない
//=============================================================================
procedure TForm1.EmbeddedWB1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Edit1.Text := EmbeddedWB1.Doc2.url;
end;

end.

javascript:

var TempValue;

function conv_args(fmts) {
  TempValue = fmts;
}
function get_videoinfo () {
  return TempValue;
}

conv_args(ytplayer.config.args.url_encoded_fmt_stream_map);

conv_args(ytplayer.config.args.title);            動画のタイトル
conv_args(ytplayer.config.args.length_seconds);   再生時間(動画の長さ
conv_args(ytplayer.config.args.view_count);       再生回数

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    EmbeddedWB1: TEmbeddedWB;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure EmbeddedWB1NavigateComplete2(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormDestroy(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private 宣言 }
    FDownloadThread : TThread;
    function DownloadMovie(ADownloadURL, ASavePath: string): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  IdURI,
  WinInet;

{$R *.dfm}

//=============================================================================
//  フェーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'https://www.youtube.com/watch?v=Yq1Ip8IzR60';
  EmbeddedWB1.Navigate(Trim(Edit1.Text));
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FDownloadThread) then begin
    FDownloadThread.Terminate;
    FreeAndNil(FDownloadThread);
  end;
end;

//=============================================================================
//  Edit1のOnKeyDownイベント
//  [Enter]キーを押下したらEdit1のURLを表示
//=============================================================================
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    EmbeddedWB1.Navigate(Trim(Edit1.Text));
  end;
end;

//=============================================================================
//  表示中のウェブページに対してJavaScriptをセット
//  動画ダウンロード用のダイレクトURLを取得してダウンロード
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList   : TStringList;
  LText      : string;
  LLoopCnt   : Integer;
  LPos       : Integer;
  LDirectURL : string;
begin
  LStrList := TStringList.Create;
  try
    //JavaScriptのコードを読み込んでウェブブラウザにセット
    LStrList.LoadFromFile(ExpandFileName('.\Youtube_JS.txt'));
    EmbeddedWB1.ExecScript(LStrList.Text, 'javascript');

    //上のJavaScriptの実行結果をJavaScript内の関数で取得
    LText := EmbeddedWB1.ExecScriptEx('get_videoinfo', ['']);

    //JavaScriptから取得した文字列からurl=の部分を取り出す
    LStrList.Clear;
    LStrList.Delimiter := ',';
    LStrList.DelimitedText := TIdURI.URLDecode(LText);

    for LLoopCnt := 0 to LStrList.Count - 1 do begin
      LDirectURL := LStrList[LLoopCnt];
      LPos  := Pos('url=', LDirectURL);
      if LPos >= 1 then begin
        LDirectURL := Copy(LDirectURL, LPos + 4, Length(LDirectURL));
        break;
      end;
    end;

    //ダイレクトURLから動画ファイルをダウンロード
    if LStrList.Count >= 1 then begin
      DownloadMovie(LDirectURL, 'YoutubeMovie.flv');
    end;
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  表示中のウェブページのURLをTEditに表示
//  他に適切なイベントがあるかも知れない
//=============================================================================
procedure TForm1.EmbeddedWB1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Edit1.Text := EmbeddedWB1.Doc2.url;
end;

//-----------------------------------------------------------------------------
//  ダウンロード用の関数
//  別スレッドで実行
//
//  TEmbeddedWB.DownloadFileは内部でUrlDownloadToFile関数を実行している
//  UrlDownloadToFile関数はIEのキャッシュを優先してダウンロードするので
//  DeleteUrlCacheEntry関数であらかじめIEキャッシャ内の該当ファイルを削除
//  この関数の使用にはusesにWinInetが必要
//-----------------------------------------------------------------------------
function TForm1.DownloadMovie(ADownloadURL, ASavePath: string): Boolean;
var
  LDlgFlag : Cardinal;
  LResFlag : Boolean;
begin
  Result := True;
  Button1.Enabled := False;

  if Assigned(FDownloadThread) then begin
    FDownloadThread.Terminate;
    FreeAndNil(FDownloadThread);
  end;
  DeleteUrlCacheEntry(PChar(ADownloadURL));

  FDownloadThread := TThread.CreateAnonymousThread(
    procedure()
    begin
      LResFlag := EmbeddedWB1.DownloadFile(ADownloadURL, ASavePath);

      //上の処理が終了したら...
      TThread.Synchronize(TThread.CurrentThread,
        procedure
        begin
          Button1.Enabled := True;
          if LResFlag then begin
            LDlgFlag := MB_OK or MB_ICONINFORMATION or MB_TOPMOST;
            MessageBox(Handle, 'ダウンロード終了', '情報', LDlgFlag);
          end else begin
            LDlgFlag := MB_OK or MB_ICONWARNING or MB_TOPMOST;
            MessageBox(Handle, 'ダウンロード失敗', '情報', LDlgFlag);
          end;
        end
      );
    end
  );
  FDownloadThread.FreeOnTerminate := False;
  FDownloadThread.Start;
end;

end.

{"Name": "Panel1", "Caption": "OK", "Left": "100", "Top": "60", "Color": "clBlue"} 

javascript:

function conv_args(fmts) {
  return JSON.stringify(fmts);
}
function get_videoinfo () {
  return conv_args(ytplayer.config.args);
}

javascript:

function get_videoinfo () {
  return JSON.stringify(ytplayer.config.args);
}

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    EmbeddedWB1: TEmbeddedWB;
    Memo1: TMemo;
    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EmbeddedWB1NavigateComplete2(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  System.Json;

{$R *.dfm}

//=============================================================================
//  フェーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'https://www.youtube.com/watch?v=Yq1Ip8IzR60';
  EmbeddedWB1.Navigate(Trim(Edit1.Text));
end;

//=============================================================================
//  Edit1のOnKeyDownイベント
//  [Enter]キーを押下したらEdit1のURLを表示
//=============================================================================
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    EmbeddedWB1.Navigate(Trim(Edit1.Text));
    Memo1.Lines.Clear;
  end;
end;

//=============================================================================
//  表示中のウェブページに対してJavaScriptのコードをセットして
//  JavaScript内の関数を実行する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDataText   : string;
  LStrList    : TStringList;
  LJsonValue  : TJSONValue;
  LJsonObject : TJSONObject;
  LJsonPair   : TJSONPair;
  LPairName   : string;
  LPairValue  : string;
begin
  Memo1.Lines.Clear;

  LStrList := TStringList.Create;
  try
    //JavaScriptのコードを読み込んでセット
    LStrList.LoadFromFile(ExpandFileName('.\Youtube_JS.txt'));
    EmbeddedWB1.ExecScript(LStrList.Text, 'javascript');

    //JavaScript内の関数でJSON形式の文字列を取得
    LDataText := EmbeddedWB1.ExecScriptEx('get_videoinfo', ['']);

    LJsonValue := TJSONObject.ParseJSONValue(LDataText);
    if not Assigned(LJsonValue) then exit;

    LJSONObject := LJsonValue as TJSONObject;

    Memo1.Lines.BeginUpdate;
    for LJsonPair in LJsonObject do begin
      LPairName  := LJsonPair.JsonString.Value;
      LPairValue := LJsonPair.JsonValue.Value;
      LDataText := LPairName + '=' + LPairValue;

      Memo1.Lines.Add(LDataText);
    end;
    Memo1.Lines.EndUpdate;
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  表示中のウェブページのURLをTEditに表示
//  他に適切なイベントがあるかも知れない
//=============================================================================
procedure TForm1.EmbeddedWB1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Edit1.Text := EmbeddedWB1.Doc2.url;
end;

end.

javascript:

function conv_args(fmts) {
  return fmts;
}
function get_videoinfo () {
  return conv_args(ytplayer.config.args.url_encoded_fmt_stream_map);
}

//=============================================================================
//  ダウンロード用ボタンのクリックイベント
//
//  JavaScriptのコードをセットして、JavaScriptコード内の関数を実行
//  その関数の戻り値は動画のダイレクトURLのリスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList : TStringList;
  LJsFunc  : string;
begin
  LStrList := TStringList.Create;
  try
    //JavaScriptのコードをセット
    LStrList.LoadFromFile(ExpandFileName('.\Youtube_JS.txt'));
    Chromium1.ExecuteJavaScript(LStrList.Text, 'about:blank');

    //実行する関数名
    //OnConsoleMessageイベント内ではこの値で処理を分岐する
    FJSFuncName := 'get_videoinfo';
    //JavaScript内の関数を実行
    //戻り値の出力先はconsole.log(コンソール)
    LJsFunc := 'console.log(' + FJSFuncName + ' (""))';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsFunc, 'about:blank', 0);
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  Chromium1のOnConsoleMessageイベント処理
//  JavaScript内のの関数の実行結果をこのイベントで受け取る
//=============================================================================
procedure TForm1.Chromium1ConsoleMessage(Sender: TObject;
  const browser: ICefBrowser; level: Cardinal; const message, source: ustring;
  line: Integer; out Result: Boolean);
var
  LStrList   : TStringList;
  LLoopCnt   : Integer;
  LPos       : Integer;
  LTempURL   : string;
  LDirectURL : string;
begin
  if source = 'about:blank' then begin
    if FJSFuncName = 'get_videoinfo' then begin
      LStrList := TStringList.Create;
      try
        LStrList.Clear;
        LStrList.Delimiter := ',';
        LStrList.DelimitedText := TIdURI.URLDecode(message);

        LDirectURL := '';
        for LLoopCnt := 0 to LStrList.Count - 1 do begin
          LTempURL := LStrList[LLoopCnt];
          LPos     := Pos('url=', LTempURL);
          if (LPos >= 1) then begin
            LTempURL   := LStrList[LLoopCnt];
            LDirectURL := Copy(LTempURL, LPos + 4, Length(LTempURL));
            break;
          end;
        end;

        //ファイル名を指定してダウンロード開始
        if LDirectURL <> '' then begin
          Chromium1.StartDownload(LDirectURL);
        end;
      finally
        FreeAndNil(LStrList);
      end;
    end;
  end;
end;

//=============================================================================
//  Chromium1のOnBeforeDownloadイベント処理
//  このイベント内でコールバックのcallback.Contを実行しないとダウンロードしない
//
//  第2引数をTrueにすると保存ダイアログを表示する
//  第2引数をFalseにすると第1引数の場所に自動保存
//  パスのフォルダか存在しない時は保存しない
//
//  このイベントの使用にはusesにuCEFInterfaces, uCEFTypes, uCEFConstantsが必要
//=============================================================================
procedure TForm1.Chromium1BeforeDownload(Sender: TObject;
  const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
  const suggestedName: ustring;
  const callback: ICefBeforeDownloadCallback);
var
  LSaveFullPath : string;
begin
  if (downloadItem = nil) or not(downloadItem.IsValid) then exit;

  if FJSFuncName = 'get_videoinfo' then begin
    LSaveFullPath := 'd:\000\Youtube.mp4';
    //ダウンロード用のコールバック実行
    callback.Cont(LSaveFullPath, True);

    //実行した関数名をクリアしておく
    FJSFuncName := '';
  end else begin
    //Youtubeの動画のダウンロード以外の時のダウンロードの処理
    //具体的なコーディング方法はCEF4Delphiに添付のデモプログラムを参照
  end;
end;

//=============================================================================
//  Chromium1のOnDownloadUpdatedイベント処理
//  ダウンロード用のコールバック関数内で発生するイベント
//  ダウンロードの進捗状況の表示に使用
//
//  このイベントの使用にはusesにuCEFInterfaces, uCEFTypes, uCEFConstantsが必要
//=============================================================================
procedure TForm1.Chromium1DownloadUpdated(Sender: TObject;
  const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
  const callback: ICefDownloadItemCallback);
var
  TempString : string;
begin
  if downloadItem.IsComplete then begin
    StatusBar1.Panels[0].Text := downloadItem.FullPath + ' : completed';
  end else
  if downloadItem.IsCanceled then begin
    StatusBar1.Panels[0].Text := downloadItem.FullPath + ' : canceled';
  end else
  if downloadItem.IsInProgress then begin
    if (downloadItem.PercentComplete >= 0) then begin
      TempString := downloadItem.FullPath + ' : '
                  + IntToStr(downloadItem.PercentComplete) + ' %'
     end else begin
       TempString := downloadItem.FullPath + ' : '
                   + IntToStr(downloadItem.ReceivedBytes) + ' bytes received';
    end;
    StatusBar1.Panels[0].Text := TempString;
  end;
end;