Some tricks!

[donald7771]

I am a newbie at CEF4Delphi. I got some idea to share with all of you!

1.A neat and tidy DPR

Code: Select all

begin
  GlobalCEFApp.Initialize;
  if GlobalCEFApp.StartMainProcess then
  begin
    Application.Initialize;
    Application.MainFormOnTaskbar := True;
    Application.CreateForm(TBrowserAssistantFrm, BrowserAssistantFrm);
    Application.Run;
  end;
  GlobalCEFApp.Finalizate;
end.

2.My Cef4Delphi Helper: Cef library in CEF directory, ForgeCmdExe to ignore DOS box prompt on flash plug, TCefJSExt.SendVarToBrowser send Javascript result to Delphi in JSON.

Code: Select all

unit uCefUtils;

interface

uses
  Vcl.Forms, WinApi.Windows, System.SysUtils, System.IOUtils, uCEFConstants, uCEFTypes,
  uCEFInterfaces, uCEFApplication, uCEFProcessMessage, uCEFv8Context, uCEFv8Handler;

const
  CefJSExtObj='CefJSExt';
  CefJSExtMsg=CefJSExtObj+'.SendVarToBrowser';

type
  TCefJSExt=class
    class procedure SendVarToBrowser(const strMsgName:string;intVarID:Integer;const strVarType,strVarValue:string);
  end;

  TCefApp=class helper for TCefApplication
    private
      procedure ForgeCmdExe;
      procedure DemolishCmdExe;
      procedure SetCefLibPath;
      procedure RemoveCefDatPath;
    public
      procedure Initialize(strLocale:string='zh-CN';OnWebKitInitialized:TOnWebKitInitializedEvent=nil;OnProcessMessageReceived:TOnProcessMessageReceivedEvent=nil);
      procedure Finalizate;
  end;

implementation

{ TCefJSExt }

class procedure TCefJSExt.SendVarToBrowser(const strMsgName: string;
  intVarID: Integer; const strVarType, strVarValue: string);
var
  CefMsg:ICefProcessMessage;
begin
  CefMsg:=TCefProcessMessageRef.New(strMsgName);
  CefMsg.ArgumentList.SetInt(0,intVarID);
  CefMsg.ArgumentList.SetString(1,strVarType);
  CefMsg.ArgumentList.SetString(2,strVarValue);
  TCefv8ContextRef.Current.Browser.SendProcessMessage(PID_BROWSER,CefMsg);
end;

procedure GlobalCEFApp_OnWebKitInitialized;
begin
  TCefRTTIExtension.Register(CefJSExtObj,TCefJSExt);
end;

{ TCefApp }


const
  DummyCmdExe='cmd.exe';
  DatPath='Dat';

var
  strAppDir:string;

procedure TCefApp.Initialize(strLocale: string; OnWebKitInitialized: TOnWebKitInitializedEvent;
  OnProcessMessageReceived: TOnProcessMessageReceivedEvent);
begin
  ForgeCmdExe;
  GlobalCEFApp:=TCefApplication.Create;
  SetCefLibPath;
  GlobalCEFApp.Locale:=strLocale;
  GlobalCEFApp.AcceptLanguageList:=strLocale;
  GlobalCEFApp.SitePerProcess:=False;
  {$IFDEF DEBUG}
  GlobalCEFApp.RemoteDebuggingPort:=9000;
  GlobalCEFApp.LogFile:='debug.log';
  GlobalCEFApp.LogSeverity:=LOGSEVERITY_INFO;
  {$ENDIF}
  if Assigned(OnWebKitInitialized) then
    GlobalCEFApp.OnWebKitInitialized:=OnWebKitInitialized
  else
    GlobalCEFApp.OnWebKitInitialized:=GlobalCEFApp_OnWebKitInitialized;
  if Assigned(OnProcessMessageReceived) then
    GlobalCEFApp.OnProcessMessageReceived:=OnProcessMessageReceived;
end;

procedure TCefApp.ForgeCmdExe;
var
  EmptyCmdFile:TextFile;
begin
  if not TFile.Exists(strAppDir+DummyCmdExe) then
  begin
    AssignFile(EmptyCmdFile,strAppDir+DummyCmdExe);
    Rewrite(EmptyCmdFile);
    CloseFile(EmptyCmdFile);
  end;
  SetEnvironmentVariable(PChar('ComSpec'),PChar(strAppDir+DummyCmdExe));
end;

procedure TCefApp.Finalizate;
begin
  DestroyGlobalCEFApp;
  RemoveCefDatPath;
  DemolishCmdExe;
end;

procedure TCefApp.RemoveCefDatPath;
begin
  if TDirectory.Exists(strAppDir+DatPath) then
    TDirectory.Delete(strAppDir+DatPath,True);
end;

procedure TCefApp.DemolishCmdExe;
begin
  if TFile.Exists(strAppDir+DummyCmdExe) then
    TFile.Delete(strAppDir+DummyCmdExe);
end;

procedure TCefApp.SetCefLibPath;
var
  strCefPath:string;
begin
  strAppDir:=IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName));
  {$IFDEF WIN32}
    strCefPath:=strAppDir+'Cef\Lib32';
  {$ENDIF}
  {$IFDEF WIN64}
    strCefPath:=strAppDir+'Cef\Lib64';
  {$ENDIF}
  GlobalCEFApp.FrameworkDirPath:=strCefPath;
  GlobalCEFApp.ResourcesDirPath:=strCefPath;
  GlobalCEFApp.LocalesDirPath:=strCefPath+'\locales';
  strCefPath:=strAppDir+DatPath+'\cache';
  if not TDirectory.Exists(strCefPath) then
    TDirectory.CreateDirectory(strCefPath);
  GlobalCEFApp.cache:=strCefPath;
  strCefPath:=strAppDir+DatPath+'\cookies';
  if not TDirectory.Exists(strCefPath) then
    TDirectory.CreateDirectory(strCefPath);
  GlobalCEFApp.cookies:=strCefPath;
  strCefPath:=strAppDir+DatPath+'\User Data';
  if not TDirectory.Exists(strCefPath) then
    TDirectory.CreateDirectory(strCefPath);
  GlobalCEFApp.UserDataPath:=strCefPath;
  GlobalCEFApp.SetCurrentDir:=True;
end;

end.

3.MainForm

Code: Select all

unit uBrowserAssistant;

interface

uses
  ...
  qjson, //QDAC opensource project--svn://www.qdac.cc/QDAC3  git://www.qdac.cc/QDAC3.git
  ...;

type
  TBrowserAssistantFrm = class(TForm)
    ...
  end;

var
  BrowserAssistantFrm: TBrowserAssistantFrm;

implementation

type
  TJSVarId = (jsviBtnEnclosure_getBoundingClientRect = 1);

procedure TBrowserAssistantFrm.N31Click(Sender: TObject);
begin
  Chromium1.Browser.MainFrame.ExecuteJavaScript(Format('var __=document.querySelector("#SWFUpload_0").getBoundingClientRect();'
    + '%s(%s,%d,typeof(__),JSON.stringify(__));', [CefJSExtMsg, QuotedStr(CefJSExtMsg),
    Ord(jsviBtnEnclosure_getBoundingClientRect)]), 'about:blank', 0);
end;

//getBoundingClientRect of element in javascript, then trigger a right click without javascript!
procedure TBrowserAssistantFrm.Chromium1ProcessMessageReceived(Sender: TObject;
  const browser: ICefBrowser; sourceProcess: TCefProcessId; const message:
  ICefProcessMessage; out Result: Boolean);
const
  EventOffSet = 5;
var
  JSResult: TQJson;
  CefRect: TCefRect;
  MouseEvent: TCefMouseEvent;
begin
  Result := False;
  if Assigned(message) and Assigned(message.ArgumentList) then begin
    if (message.Name = CefJSExtMsg) then begin
      case TJSVarId(message.ArgumentList.GetInt(0)) of
        jsviBtnEnclosure_getBoundingClientRect:
          begin
            if (message.ArgumentList.GetString(1) = 'object') then begin
              JSResult := TQJson.Create;
              try
                JSResult.Parse(message.ArgumentList.GetString(2));
                JSResult.ToRecord<TCefRect>(CefRect);
                MouseEvent.x := CefRect.x + EventOffSet;
                MouseEvent.y := CefRect.y + EventOffSet;
                BrowserAssistantFrm.Chromium1.Browser.Host.SendFocusEvent(true);
                BrowserAssistantFrm.Chromium1.Browser.Host.SendMouseClickEvent(PCefMouseEvent
                  (@MouseEvent), MBT_RIGHT, false, 1);
                BrowserAssistantFrm.Chromium1.Browser.Host.SendMouseClickEvent(PCefMouseEvent
                  (@MouseEvent), MBT_RIGHT, true, 1);
              finally
                FreeAndNil(JSResult);
              end;
              Result := True;
            end;
          end;
      end;
    end;
  end;
end;

//invoke a command in ContextMenu without display it!
procedure TBrowserAssistantFrm.Chromium1RunContextMenu(Sender: TObject; const
  browser: ICefBrowser; const frame: ICefFrame; const params:
  ICefContextMenuParams; const model: ICefMenuModel; const callback:
  ICefRunContextMenuCallback; var aResult: Boolean);
begin
  if ((model.GetCommandIdAt(2) = 221) and (model.GetLabelAt(2) = 'run this plug') and
    model.IsEnabledAt(2)) then begin
    callback.Cont(model.GetCommandIdAt(2), EVENTFLAG_NONE);
    aResult := True;
  end
  else
    aResult := False;
end;

end.

[salvadordf]

Nice trick to fix the DOS window created by the flash plugin.

Thanks for sharing this information!