program Project1;

{$I cef.inc}

uses
  Forms,
  Windows,
  SysUtils,
  Dialogs,
  uCEFApplication,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}

var
  LLibDir  : string;
  LDirChar : array [0..MAX_PATH - 1] of Char;
  LRunFlag : Boolean;
begin
  GlobalCEFApp := TCefApplication.Create;


  //---------------------------------------------------------------------------
  //  DLL等のライブラリ等のパスの設定と言語とロケールの設定
  //  usesにSysUtils,Dialogsが必要
  //---------------------------------------------------------------------------
  LRunFlag := True;
  try
    LLibDir := '%LOCALAPPDATA%\CEF4Delphi';
    FillChar(LDirChar, SizeOf(LDirChar), #0);
    ExpandEnvironmentStrings(PChar(LLibDir), LDirChar, MAX_PATH);
    LLibDir := LDirChar;
    if not (DirectoryExists(LLibDir)) then begin
      MessageBox(0, 'ライブラリのフォルダが存在しません', '起動失敗', MB_ICONERROR);
      LRunFlag := False;
    end else begin
      GlobalCEFApp.FrameworkDirPath   := LLibDir;
      GlobalCEFApp.LocalesDirPath     := LLibDir + '\locales';
      GlobalCEFApp.ResourcesDirPath   := LLibDir;
      GlobalCEFApp.AcceptLanguageList := 'ja';
      GlobalCEFApp.LocalesRequired    := 'ja';
      GlobalCEFApp.Locale := 'ja';
    end;
  except
    LRunFlag := False;
  end;
  if not LRunFlag then begin
    GlobalCEFApp.Free;
    Exit;
  end;
  //---------------------------------------------------------------------------

  if GlobalCEFApp.StartMainProcess then begin
    Application.Initialize;
    Application.MainFormOnTaskbar := True;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;
  GlobalCEFApp.Free;
end.

  GlobalCEFApp := TCefApplication.Create;
  GlobalCEFApp.OnProcessMessageReceived := GlobalCEFApp_OnProcessMessageReceived;

unit Unit1;

{$I cef.inc}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, uCEFChromium, ComCtrls, uCEFWindowParent,
  uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFProcessMessage, uCEFDomVisitor;

type
  TForm1 = class(TForm)
    CEFWindowParent1: TCEFWindowParent;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    Edit1: TEdit;
    Button1: TButton;
    Chromium1: TChromium;
    Timer1: TTimer;

    Button2: TButton;    procedure FormCreate(Sender: TObject);
    procedure Chromium1AfterCreated(Sender: TObject;
      const browser: ICefBrowser);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser;
      out Result: Boolean);
    procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Chromium1AddressChange(Sender: TObject;
      const browser: ICefBrowser; const frame: ICefFrame; const url: ustring);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Chromium1ProcessMessageReceived(Sender: TObject;
      const browser: ICefBrowser; sourceProcess: TCefProcessId;
      const message: ICefProcessMessage; out Result: Boolean);
  private
    { Private 宣言 }
    FCanClose   : boolean;
    FClosing    : boolean;
    procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
    procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

procedure GlobalCEFApp_OnProcessMessageReceived(const browser: ICefBrowser;
  sourceProcess: TCefProcessId; const message: ICefProcessMessage;
  var aHandled: boolean);

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/index.htm';

  Chromium1.CreateBrowser(CEFWindowParent1, '');
  FCanClose := False;
  FClosing  := False;
end;

//-----------------------------------------------------------------------------
//  以下，フォームの生成時から終了までの関係処理
//  CEF4Delphi 3.3359.1768.g8e7c5d6 現在用
//
//  TTimerのプロパティは以下の値にしている
//  TTimer.Enabled := False;
//  TTimer.Interval := 300;
//
//  ICefBrowser等のインターフェイスの使用にはusesにuCEFInterfacesが必要
//  定数名の使用にはusesにuCEFConstantsが必要
//-----------------------------------------------------------------------------
procedure TForm1.Chromium1AfterCreated(Sender: TObject;
  const browser: ICefBrowser);
begin
  PostMessage(Handle, CEF_AFTERCREATED, 0, 0)
end;

//-----------------------------------------------------------------------------
procedure TForm1.BrowserCreatedMsg(var aMessage: TMessage);
begin
  CEFWindowParent1.UpdateSize;
  Chromium1.LoadURL(Trim(Edit1.Text));
end;

//-----------------------------------------------------------------------------
procedure TForm1.FormShow(Sender: TObject);
begin
  //('初期化中です');

  //  WebRTCのIPリーク回避
  //  詳細は https://www.browserleaks.com/webrtc 参照
  Chromium1.WebRTCIPHandlingPolicy := hpDisableNonProxiedUDP;
  Chromium1.WebRTCMultipleRoutes   := STATE_DISABLED;
  Chromium1.WebRTCNonproxiedUDP    := STATE_DISABLED;

  //初期化されていない場合はタイマーを使用して後でブラウザを生成する
  if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
end;

//-----------------------------------------------------------------------------
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := FCanClose;

  if not(FClosing) then begin
    FClosing := True;
    Visible  := False;
    Chromium1.CloseBrowser(True);
  end;
end;

//-----------------------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
//
end;

//-----------------------------------------------------------------------------
procedure TForm1.Chromium1BeforeClose(Sender: TObject;
  const browser: ICefBrowser);
begin
  if (Chromium1.BrowserId = 0) then begin
    FCanClose := True;
    PostMessage(Handle, WM_CLOSE, 0, 0);
  end;
end;

//-----------------------------------------------------------------------------
procedure TForm1.Chromium1Close(Sender: TObject; const browser: ICefBrowser;
  out Result: Boolean);
begin
  if (browser <> nil) and (Chromium1.BrowserId = browser.Identifier) then begin
    PostMessage(Handle, CEF_DESTROY, 0, 0);
    Result := True;
  end else begin
    Result := False;
  end;
end;

//-----------------------------------------------------------------------------
procedure TForm1.BrowserDestroyMsg(var aMessage: TMessage);
begin
  CEFWindowParent1.Free;
end;

//-----------------------------------------------------------------------------
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  if not(Chromium1.CreateBrowser(CEFWindowParent1, ''))
    and not(Chromium1.Initialized) then begin
    Timer1.Enabled := True;
  end;
end;
//-----------------------------------------------------------------------------
//  フォーム生成時と終了時の処理関係コード．ここまで
//-----------------------------------------------------------------------------


//=============================================================================
//  Chromium1のOnAddressChangeイベント処理
//  変更されたウェブページのアドレスをEdit1に表示
//=============================================================================
procedure TForm1.Chromium1AddressChange(Sender: TObject;
  const browser: ICefBrowser; const frame: ICefFrame; const url: ustring);
begin
  Edit1.Text := url;
end;

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

//=============================================================================
//  前のページに移動
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Chromium1.GoBack;
end;

//=============================================================================
//  DOM操作用のメッセージを生成して送信
//
//  プロジェクトのコード(DPRファイル)の
//  GlobalCEFApp.OnProcessMessageReceived
//  に設定したプロシージャーがメッセージを受信する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMsg : ICefProcessMessage;
begin
  LMsg := TCefProcessMessageRef.New('get_doctitle');
  Chromium1.SendProcessMessage(PID_RENDERER, LMsg);
end;

//=============================================================================
//  同上
//  選択テキストを取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LMsg : ICefProcessMessage;
begin
  LMsg := TCefProcessMessageRef.New('get_selecttext');
  Chromium1.SendProcessMessage(PID_RENDERER, LMsg);
end;

//=============================================================================
//  Chromium1のOnProcessMessageReceivedイベント処理
//  レンダラのプロセスからのメッセージを受信する
//  メッセージを受け取る必要がなければこのイベント処理は不要
//=============================================================================
procedure TForm1.Chromium1ProcessMessageReceived(Sender: TObject;
  const browser: ICefBrowser; sourceProcess: TCefProcessId;
  const message: ICefProcessMessage; out Result: Boolean);
var
  LText : ustring;
begin
  Result := False;
  if (message = nil) or (message.ArgumentList = nil) then Exit;

  if (message.Name = 'get_doctitle') then begin
    LText := message.ArgumentList.GetString(0);
    MessageBox(Handle, PChar(LText), '結果', MB_ICONINFORMATION);

    Result := True;
  end else
  if (message.Name = 'get_selecttext') then begin
    LText := message.ArgumentList.GetString(0);
    MessageBox(Handle, PChar(LText), '結果', MB_ICONINFORMATION);

    Result := True;
  end;
end;

//-----------------------------------------------------------------------------
//  TCefApplicationのOnProcessMessageReceivedの処理
//  メインプロセスから受信したメッセージを処理するレンダラ
//
//  プロジェクトファイル(DPR)でこのプロシージャーを指定しておく
//
//  レンダラは別プロセスで実行されるので，この部分にメインスレッドにある
//  コントロール等の操作を行わないこと
//
//  usesにuCEFDomVisitorが必要
//-----------------------------------------------------------------------------
procedure GlobalCEFApp_OnProcessMessageReceived(const browser: ICefBrowser;
  sourceProcess: TCefProcessId; const message: ICefProcessMessage;
  var aHandled: boolean);
var
  LIFrame : ICefFrame;
begin
  aHandled := False;
  if browser = nil then Exit;
  LIFrame := browser.MainFrame;
  if (LIFrame = nil) then Exit;

  if (message.Name = 'get_doctitle') then begin
    LIFrame.VisitDomProc(
    procedure(const doc: ICefDomDocument)
    var
      LMsg  : ICefProcessMessage;
      LText : ustring;
    begin
      //メインプロセスに送信するメッセージの文字列
      //ここでは受け取った値と同じにしている
      LMsg := TCefProcessMessageRef.New(message.Name);

      LText := doc.Title;
      //送信内容のセット(ここでは文字列)
      LMsg.ArgumentList.SetString(0, LText);
      //送信(メインプロセスで受け取る必要がなければ不要)
      browser.SendProcessMessage(PID_BROWSER, LMsg);
    end
    );
    aHandled := True;
  end else
  if (message.Name = 'get_selecttext') then begin
    LIFrame.VisitDomProc(
    procedure(const doc: ICefDomDocument)
    var
      LMsg  : ICefProcessMessage;
      LText : ustring;
    begin
      LMsg := TCefProcessMessageRef.New(message.Name);

      LText := doc.SelectionAsText;
      LMsg.ArgumentList.SetString(0, LText);
      browser.SendProcessMessage(PID_BROWSER, LMsg);
    end
    );
    aHandled := True;
  end;
end;

end.

  GlobalCEFApp := TCefApplication.Create;
  GlobalCEFApp.OnWebKitInitialized := GlobalCEFApp_OnWebKitInitialized;

type
  TTestExtension = class
    class procedure mouseover(const data: string);
  end;

//-----------------------------------------------------------------------------
//  TTestExtensionクラスの登録
//  プロジェクトのコード(DPR)で以下のレンダラの設定をしておくと
//  TTestExtensionがメッセージをメインプロセスに送信できるようになる
//  GlobalCEFApp.OnWebKitInitialized := GlobalCEFApp_OnWebKitInitialized;
//
//  usesにuCEFv8Handlerが必要
//-----------------------------------------------------------------------------
procedure GlobalCEFApp_OnWebKitInitialized;
begin
  TCefRTTIExtension.Register('myextension', TTestExtension);
end;

//=============================================================================
//  マウスのイベントリスナーをJavaScriptで登録する
//  マウスカーソル位置のタグ名またはリンク先を取得
//  フレームには未対応のコード
//  実行結果はTChromium.OnProcessMessageReceivedイベントで受け取る
//  表示ページが変わったら再度登録が必要
//
//  自動的に登録するには，例えばTChromium.OnLoadEndイベント等で実行する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LScriptText : string;
begin
  if (Chromium1.Browser = nil) or (Chromium1.Browser.MainFrame = nil) then exit;

  LScriptText := 'document.body.addEventListener("mouseover", function(evt){'
               + 'function getpath(n){'
               + '  if (n.nodeName === "A") {'
               + '    return n.href }'
               + '    else {'
               + '    return "<" + n.nodeName + ">"'
               + '  };'
               +'};'
               + 'myextension.mouseover(getpath(evt.target))'
               +'}'
               + ')';

  //JavaScriptの実行
  Chromium1.Browser.MainFrame.ExecuteJavaScript(LScriptText, 'about:blank', 0);
end;

//=============================================================================
//  Chromium1のOnProcessMessageReceivedイベント処理
//  レンダラからメッセージを受け取る
//=============================================================================
procedure TForm1.Chromium1ProcessMessageReceived(Sender: TObject;
  const browser: ICefBrowser; sourceProcess: TCefProcessId;
  const message: ICefProcessMessage; out Result: Boolean);
begin
  Result := False;
  if (message = nil) or (message.ArgumentList = nil) then Exit;

  if (message.Name = 'mouseover') then begin
    Label1.Caption := message.ArgumentList.GetString(0);
    Result := True;
  end;
end;

{ TTestExtension }

//-----------------------------------------------------------------------------
//  レンダラのメッセージをメインプロセスに送信する
//  TCefv8ContextRef.CurrentはJavascriptを実行しているフレームのv8コンテキスト
//
//  usesにuCEFv8Context,uCEFProcessMessageが必要
//  定数名の使用にはusesにuCEFConstantsが必要
//-----------------------------------------------------------------------------
class procedure TTestExtension.mouseover(const data: string);
var
  LMsg: ICefProcessMessage;
begin
  LMsg := TCefProcessMessageRef.New('mouseover');
  LMsg.ArgumentList.SetString(0, data);

  TCefv8ContextRef.Current.Browser.SendProcessMessage(PID_BROWSER, LMsg);
end;

//=============================================================================
//  GetSourceProcを使用したHTMLソースコードの取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList : TStringList;
begin
  Chromium1.Browser.MainFrame.GetSourceProc(
    procedure(const str: ustring)
    begin
      LStrlist := TStringList.Create;
      try
        LStrList.Text := str;
        LStrList.SaveToFile(ExpandFileName('.\000.html'));
      finally
        FreeAndNil(LStrList);
      end;
    end
  );
end;

//=============================================================================
//  Chromium1のOnContextMenuCommandイベント処理
//  コンテキストメニューで[ページのソースを表示]を選択した時の動作を変更
//=============================================================================
procedure TForm1.Chromium1ContextMenuCommand(Sender: TObject;
  const browser: ICefBrowser; const frame: ICefFrame;
  const params: ICefContextMenuParams; commandId: Integer; eventFlags: Cardinal;
  out Result: Boolean);
var
  LStrList      : TStringList;
  LSaveFilePath : string;
begin
  Result := False;

  if commandId = MENU_ID_VIEW_SOURCE then begin
    Chromium1.Browser.MainFrame.GetSourceProc(
      procedure(const str: ustring)
      begin
        LSaveFilePath := ExpandFileName('.\000.txt');
        LStrlist := TStringList.Create;
        try
          LStrList.Text := str;

          //HTMLのソースコードを取得したら保存
          //保存したテキストファイルを既定のテキストエディタで表示
          //CEF3では%TEMP%の階層下にファイルを保存して表示している
          LStrList.SaveToFile(LSaveFilePath);
          ShellExecute(Handle, '', PChar(LSaveFilePath), nil, nil, SW_SHOWNA);
        finally
          FreeAndNil(LStrList);
        end;
      end
    );
    //コマンドを処理したことにする
    //本来のコマンドを実行させない
    Result := True;
  end;
end;

//=============================================================================
//  RetrieveHTMLを使用したHTMLソースコードの取得
//  RetrieveHTMLの引数を省略するとメインフレームのHTMLソースコードの取得となる
//  結果はOnTextResultAvailableイベントで受け取る
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Chromium1.RetrieveHTML;
end;

//=============================================================================
//  Chromium1のOnTextResultAvailableイベント処理
//  TChromium.RetrieveHTMLメソッドの結果を受け取る
//
//  usesにClipbrdが必要
//=============================================================================
procedure TForm1.Chromium1TextResultAvailable(Sender: TObject;
  const aText: string);
begin
  //aTextがHTMLのソースコードの文字列
  clipboard.AsText := aText;
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
  LSaveDir      : string;
  LSaveFullPath : string;
  LTempName     : string;
begin
  if not(Chromium1.IsSameBrowser(browser))
    or (downloadItem = nil) or not(downloadItem.IsValid) then Exit;

  LSaveDir := ExtractFileDir(Application.ExeName);

  if (Length(suggestedName) > 0) then begin
    LTempName := suggestedName;
  end else begin
    LTempName := 'DownloadedFile';
  end;

  if (length(LSaveDir) > 0) then begin
    LSaveFullPath := IncludeTrailingPathDelimiter(LSaveDir) + LTempName;
  end else begin
    LSaveFullPath := LTempName;
  end;

  //ダウンロード用のコールバック実行
  callback.cont(LSaveFullPath, True);
end;

//=============================================================================
//  Chromium1のOnDownloadUpdatedイベント処理
//  ダウンロード用のコールバック関数内で発生するイベント
//  ダウンロードの進捗状況の表示に使用できる
//
//  このイベントの使用にはusesにuCEFInterfaces, uCEFTypes, uCEFConstantsが必要
//=============================================================================
procedure TForm1.Chromium1DownloadUpdated(Sender: TObject;
  const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
  const callback: ICefDownloadItemCallback);
var
  LTempString : string;
begin
  if not(Chromium1.IsSameBrowser(browser)) then Exit;

  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
      LTempString := downloadItem.FullPath
                   + ' : ' + inttostr(downloadItem.PercentComplete) + '%'
    end else begin
      LTempString := downloadItem.FullPath + ' : '
                   + inttostr(downloadItem.ReceivedBytes) + ' bytes received';
    end;
    StatusBar1.Panels[0].Text := LTempString;
  end;
end;

//=============================================================================
//  JavaScriptの実行
//  FJSFuncNameはグローバル変数
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LScriptText : string;
  LJsFunc     : string;
  LParam1     : string;
  LParam2     : string;
begin
  LScriptText := 'javascript: '
               + ''
               + 'function add_values(a, b) {'
               + '  var ret = "計算結果 : " + String(a + b);'
               + '  return ret;'
               +'}';

  //JavaScriptのコードをセット
  Chromium1.ExecuteJavaScript(LScriptText, 'about:blank');

  //実行する関数名
  //OnConsoleMessageイベント内ではこの値で処理を分岐する
  FJSFuncName := 'add_values';

  //JavaScript内の関数を実行
  //戻り値の出力先はconsole.log
  LParam1 := IntToStr(100);
  LParam2 := IntToStr(350);
  LJsFunc := 'console.log(' + FJSFuncName + ' ( ' + LParam1 + ',' + LParam2 + '))';
  Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsFunc, 'about:blank', 0);
end;

//=============================================================================
//  Chromium1のOnConsoleMessageイベント処理
//  JavaScript内のの関数の実行結果をこのイベントで受け取る
//=============================================================================
procedure TForm1.Chromium1ConsoleMessage(Sender: TObject;
  const browser: ICefBrowser; level: Cardinal; const message, source: ustring;
  line: Integer; out Result: Boolean);
var
  LRetText : string;
begin
  if source = 'about:blank' then begin
    if FJSFuncName = 'add_values' then begin
      LRetText := message;
      MessageBox(Handle, PChar(LRetText), '結果', MB_ICONINFORMATION);
    end;
  end;

  FJSFuncName := '';
end;

// =============================================================================
// JavaScriptの実行
// FJSFuncNameはグローバル変数
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LScriptText: string;
  LJsFunc    : string;
begin
  LScriptText := 'javascript: '
               + ''
               + 'function get_htmlcode() {'
               + '  return document.getElementsByTagName("html")[0].innerHTML;'
               + '}';

  // JavaScriptのコードをセット
  Chromium1.ExecuteJavaScript(LScriptText, 'about:blank');

  // 実行する関数名
  // OnConsoleMessageイベント内ではこの値で処理を分岐する
  FJSFuncName := 'get_htmlcode';

  // JavaScript内の関数を実行
  LJsFunc := 'console.log(' + FJSFuncName + ' (""))';
  Chromium1.browser.MainFrame.ExecuteJavaScript(LJsFunc, 'about:blank', 0);
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;
begin
  if source = 'about:blank' then begin
    if FJSFuncName = 'get_htmlcode' then begin
      LStrList := TStringList.Create;
      try
        LStrList.Text := message;
        LStrList.SaveToFile('000.html');
      finally
        FreeAndNil(LStrList);
      end;
    end;
  end;

  FJSFuncName := '';
end;

//=============================================================================
//  JavaScriptの実行
//  FJSFuncNameはグローバル変数
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LScriptText : string;
  LJsFunc     : string;
begin
  LScriptText := 'javascript: '
               + ''
               + 'function get_imglist () {'
               + '  var list = new Array();'
               + '  var doccollection = document.getElementsByTagName("img");'
               + '  for (var i = 0; i < doccollection.length; ++i){'
               + '    list.push(doccollection[i].src);'
               + '  }'
               + ' return list;'
               +'}';

  //JavaScriptのコードをセット
  Chromium1.ExecuteJavaScript(LScriptText, 'about:blank');

  //実行する関数名
  //OnConsoleMessageイベント内ではこの値で処理を分岐する
  FJSFuncName := 'get_imglist';

  //JavaScript内の関数を実行
  //戻り値の出力先はconsole.log
  LJsFunc := 'console.log(' + FJSFuncName + ' (""))';
  Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsFunc, 'about:blank', 0);
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;
begin
  if source = 'about:blank' then begin
    if FJSFuncName = 'get_imglist' then begin
      LStrList := TStringList.Create;
      try
        LStrList.Delimiter := ',';
        LStrList.StrictDelimiter := True;
        LStrList.DelimitedText := message;

        //リストを保存
        LStrList.SaveToFile(ExpandFileName('.\ImagesrcList.txt'));
      finally
        FreeAndNil(LStrList);
      end;
    end;
  end;

  FJSFuncName := '';
end;

//=============================================================================
//  JavaScriptの実行
//  FJSFuncNameはグローバル変数
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LScriptText : string;
begin
  FJSFuncName := 'get_imglist';
  LScriptText := 'javascript: '
               + ''
               + 'var list = new Array();'
               + 'var doccollection = document.getElementsByTagName("img");'
               + 'for (var i = 0; i < doccollection.length; ++i){'
               + '  list.push(doccollection[i].src);'
               + '}'
               + 'console.log(list)';

  //JavaScriptのコードをセット
  Chromium1.ExecuteJavaScript(LScriptText, 'about:blank');
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;
begin
  if source = 'about:blank' then begin
    if FJSFuncName = 'get_imglist' then begin
      LStrList := TStringList.Create;
      try
        LStrList.Delimiter := ',';
        LStrList.StrictDelimiter := True;
        LStrList.DelimitedText := message;

        //リストを保存
        LStrList.SaveToFile(ExpandFileName('.\ImagesrcList.txt'));
      finally
        FreeAndNil(LStrList);
      end;
    end;
  end;

  FJSFuncName := '';

end;

javascript: 

function get_array () {
  var list = new Array();
  list.push("東京都");
  list.push("大,阪,府");
  list.push("京都府");
  return list;
}

javascript: 

function get_array () {
  var list = new Array();
  list.push("\"東京都\"");
  list.push("\"大,阪,府\"");
  list.push("\'京都府\'");
  return list;
}

var
  LCode    : string;
  LJsFunc  : string;
begin
  LCode := 'javascript:'
         + ''
         + 'function get_array () {'
         + 'var list = new Array();'
         + 'list.push(' + Chr(39) + '東京都' + Chr(39) + ');'
         + 'list.push("\"大,阪,府\"");'
         + 'list.push("\' + Chr(39) + '京都府\' + Chr(39) +'");'
         + 'return list;'
         + '}';
  //JavaScriptのコードをセット
  Chromium1.ExecuteJavaScript(LCode, 'about:blank');

var
  LCode    : string;
  LJsFunc  : string;
begin
  LCode := 'javascript:'
         + ''
         + 'function get_array () {'
         + 'var list = new Array();'
         + 'list.push(' + Chr(39) + '東京都' + Chr(39) + ');'
         + 'list.push("\"大,阪,府\"");'
         + 'list.push("\' + #39 + '京都府\' + #39 +'");'
         + 'return list;'
         + '}';
  //JavaScriptのコードをセット
  Chromium1.ExecuteJavaScript(LCode, 'about:blank');

var
  LCode    : string;
  LJsFunc  : string;
begin
  LCode := 'javascript:'
         + ''
         + 'function get_array () {'
         + 'var list = new Array();'
         + 'list.push(''東京都'');'
         + 'list.push("\"大,阪,府\"");'
         + 'list.push("''京都府''");'
         + 'return list;'
         + '}';
  //JavaScriptのコードをセット
  Chromium1.ExecuteJavaScript(LCode, 'about:blank');

//=============================================================================
//  Chromium1のOnKeyEventイベント処理
//
//  このイベント内ででメインプロセスのコントロールに対して操作しないこと
//  メインプロセスのコントロールに対して操作するとハングアップする
//=============================================================================
procedure TForm1.Chromium1KeyEvent(Sender: TObject; const browser: ICefBrowser;
  const event: PCefKeyEvent; osEvent: PMsg; out Result: Boolean);
var
  LMsg : TMsg;
begin
  Result := False;

  if not(Chromium1.IsSameBrowser(browser)) then exit;
  if (event = nil) or (osEvent = nil) then Exit;

  if osEvent.Message = WM_KEYDOWN then begin
    LMsg := osEvent^;
    //メインのプロセスにメッセージを送信
    //本サンプルではこのメッセージをTApplicationEvents.OnMessageで受け取る
    PostMessage(Handle, CHROMIUM_KEYDOWN, LMsg.wParam, LMsg.lParam);

    Result := True;
  end;
end;

//=============================================================================
//  ApplicationEvents1のOnMessageイベント処理
//  Chromium1のOnKeyEventイベントからのメッセージを受け取って処理する
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  LKeyState : TKeyboardState;
  LIsCtrl   : Boolean;
  LIsShift  : Boolean;
begin
  if (Msg.message = CHROMIUM_KEYDOWN) or (Msg.message = WM_KEYDOWN) then begin
    LIsCtrl := False;
    if GetKeyboardState(LKeyState) then begin
      LIsCtrl  := LKeyState[VK_CONTROL] and $80 <> 0;
      LIsShift := LKeyState[VK_SHIFT] and $80 <> 0;
    end;
    //[Ctrl]キーが含まれていたら検索操作用のTPanelを表示して検索開始
    if (Msg.wParam = Ord('F')) and LIsCtrl then begin
      Panel2.Visible := True;
      SpeedButton3Click(nil);
      Edit2.SetFocus;
    end else
    if (Msg.wParam = VK_F3) and (Panel2.Visible) and LIsShift then begin
      SpeedButton2Click(nil);
    end else
    if (Msg.wParam = VK_F3) and (Panel2.Visible) then begin
      SpeedButton3Click(nil);
    end;
  end;
end;

//=============================================================================
//  検索用の文字列を入力するTEditのOnKeyDownイベント処理
//  [Enter]キーで検索開始
//=============================================================================
procedure TForm1.Edit2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    SpeedButton3Click(nil);
  end;
end;

//=============================================================================
//  前(上方向に)検索
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  Chromium1.Find(1, Edit2.Text, False, False, True);
end;

//=============================================================================
//  次(下方向に)検索
//=============================================================================
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  if Trim(Edit2.Text) = '' then begin
    Label1.Caption := '';
    SpeedButton2.Enabled := False;
    SpeedButton3.Enabled := False;
  end else begin
    Chromium1.Find(1, Edit2.Text, True, False, False);
  end;
end;

//=============================================================================
//  検索操作終了
//=============================================================================
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  Chromium1.StopFinding(True);
  //検索操作用のTPanelを非表示にする
  Panel2.Visible := False;
end;

//=============================================================================
//  Chromium1のOnFindResultイベント処理
//  検索の結果，ヒットした件数等を表示
//=============================================================================
procedure TForm1.Chromium1FindResult(Sender: TObject;
  const browser: ICefBrowser; identifier, count: Integer;
  const selectionRect: PCefRect; activeMatchOrdinal: Integer;
  finalUpdate: Boolean);
begin
  Label1.Caption := IntToStr(count) + ' 件中 ' + IntToStr(activeMatchOrdinal) + ' 件目';
  SpeedButton2.Enabled := count >= 1;
  SpeedButton3.Enabled := count >= 1;
end;

//=============================================================================
//  designMode開始
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Chromium1.ExecuteJavaScript('document.designMode = "on";', 'about:blank');
end;

//=============================================================================
//  designMode終了
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Chromium1.ExecuteJavaScript('document.designMode = "off";', 'about:blank');
end;