RealICQClient/Client/Services/ChromeMessageService.pas

unit ChromeMessageService;

interface

uses
  ceflib, Forms, Dialogs, Classes, SysUtils, BaseScope; //其它

type
  TBrowserContext = class;

  TCustomRenderProcessHandler = class(TCefRenderProcessHandlerOwn)
  private
    FBrowserContexts: TStringList;
    function _CallBack(params, callback: string;
      ABrowserContext: TBrowserContext): Boolean;

  protected
    procedure OnWebKitInitialized; override;
    function OnProcessMessageReceived(const browser: ICefBrowser; sourceProcess: TCefProcessId; const message: ICefProcessMessage): Boolean; override;
    procedure OnBrowserCreated(const browser: ICefBrowser); override;
    procedure OnBrowserDestroyed(const browser: ICefBrowser); override;

  public
    constructor Create; override;
    destructor Destroy; override;
    function GetBrowerContext(ABrowser: ICefBrowser): TBrowserContext;
    procedure DeleteBrowerContext(ABrowser: ICefBrowser);
  end;

  TCefExtension = class(TCefv8HandlerOwn)
  private

  public  
    function Execute(const name: ustring; const obj: ICefv8Value; const arguments: TCefv8ValueArray; var retval: ICefv8Value; var exception: ustring): Boolean; override;
  end;

  TBrowserContext = class(TInterfacedObject)
  private
    FScopes,
    FCallBacks: TStringList;
    FBrowser: ICefBrowser;
  public
    constructor Create(const browser: ICefBrowser);
    destructor Destroy; override;

    function GetScope(AGuid: string): TBaseScope;
    function GetCallBack(AGuid: string): TBaseCallBack;
    function AddCallBack(ACallBack: ICefv8Value): string;
  
  end;

var
  ACefExtension: TCefExtension;

implementation


{ TCustomRenderProcessHandler }

var
  FCustomRenderProcessHandler: TCustomRenderProcessHandler;

constructor TCustomRenderProcessHandler.Create;
begin
  FBrowserContexts := TStringList.Create;
  inherited Create;
end;

procedure TCustomRenderProcessHandler.DeleteBrowerContext(
  ABrowser: ICefBrowser);
var
  iIndex: Integer;
begin
  if ABrowser = nil then
    Exit;
  iIndex := FBrowserContexts.IndexOf(IntToStr(ABrowser.Identifier));
  if iIndex > -1 then
    FBrowserContexts.Delete(iIndex);
end;

destructor TCustomRenderProcessHandler.Destroy;
begin
  FBrowserContexts.Clear;
  FreeAndNil(FBrowserContexts);
  inherited;
end;

function TCustomRenderProcessHandler.GetBrowerContext(
  ABrowser: ICefBrowser): TBrowserContext;
var
  iIndex: Integer;
begin
  Result := nil;
  if ABrowser = nil then
    Exit;
  iIndex := FBrowserContexts.IndexOf(IntToStr(ABrowser.Identifier));
  if iIndex > -1 then  
    Result := FBrowserContexts.Objects[iIndex] as TBrowserContext
  else
  begin
    Result := TBrowserContext.Create(ABrowser);
    FBrowserContexts.AddObject(IntToStr(ABrowser.Identifier), Result);
  end;
end;

procedure TCustomRenderProcessHandler.OnBrowserCreated(
  const browser: ICefBrowser);
begin
  inherited;
  GetBrowerContext(browser);
end;

procedure TCustomRenderProcessHandler.OnBrowserDestroyed(
  const browser: ICefBrowser);
begin
  inherited;
  DeleteBrowerContext(browser);
end;

function TCustomRenderProcessHandler._CallBack(params, callback: string; ABrowserContext: TBrowserContext): Boolean;
var
  AFun: ICefv8Value;
  ACallBack: TBaseCallBack;
  Argm: TCefv8ValueArray;
begin
  SetLength(Argm, 1);
  ACallBack := ABrowserContext.GetCallBack(callback);
  if (ACallBack = nil) and (ACallBack.CallBack = nil) then
    Exit;
  AFun := ACallBack.CallBack;
  if (AFun <> nil) and (AFun.IsFunction) then
    Exit;
  Argm[0] := TCefv8ValueRef.NewString(params);
  AFun.ExecuteFunction(nil, Argm);
end;

function TCustomRenderProcessHandler.OnProcessMessageReceived(const browser: ICefBrowser; sourceProcess: TCefProcessId; const message: ICefProcessMessage): Boolean;
var
  AScope: TBaseScope;
  Argm: TCefv8ValueArray;
  ACefv8Context: ICefv8Context;
  ABrowserContext: TBrowserContext;
  AFun: ICefv8Value;
  iCount: Integer;
begin
  iCount := message.ArgumentList.GetSize;

  if (iCount < 2) or (iCount > 3) then
    Exit;

  ABrowserContext := GetBrowerContext(browser);
  if ABrowserContext = nil then
    Exit;
  ACefv8Context := browser.MainFrame.GetV8Context;

  if (ACefv8Context = nil) or (not ACefv8Context.Enter) then
    Exit;
  try
    if message.ArgumentList.GetString(0) = '_CallBack' then
    begin
      _CallBack(message.ArgumentList.GetString(1), message.ArgumentList.GetString(2), ABrowserContext);
    end
    else
    begin
      AScope := ABrowserContext.GetScope(message.Name);
  //  ShowMessage(message.Name);
      if AScope = nil then
        Exit;

      AScope.Handle(message);
    end;
  finally
    ACefv8Context.Exit;
  end;
end;

procedure TCustomRenderProcessHandler.OnWebKitInitialized;
var
  AName, ACode: TCefString;
begin
  AName := CefString('v8/lxtalkClient');
  ACode := CefString('var lxtalkClient = {}; (function() {lxtalkClient.Invoke = function(guid, method, params, obj) {native function Invoke(guid, method, params, obj);return Invoke(guid, method, params, obj);};})();');
  cef_register_extension(@AName, @ACode, CefGetData(ACefExtension));
end;

{ TCefExtension }

function TCefExtension.Execute(const name: ustring; const obj: ICefv8Value; const arguments: TCefv8ValueArray; var retval: ICefv8Value; var exception: ustring): Boolean;
var
  msg: ICefProcessMessage;
  guid, method: string;
  g:TGUID;
  AScope: TBaseScope;
  ABrowser: ICefBrowser;
  ABrowserContext: TBrowserContext;
begin
  if (Length(arguments) < 2) and (not arguments[0].IsString) and (not arguments[1].IsString)  then
  begin
    exception := '参数不合法';
    Result := false;
    Exit;
  end;

  
  if SameText(arguments[1].GetStringValue, '_Register') and (Length(arguments) <> 4) and (not arguments[3].IsObject) then
  begin
    exception := '_Register 参数不合法';
    Result := false;
    Exit;
  end;

  ABrowser := TCefv8ContextRef.Current.Browser;
  ABrowserContext := FCustomRenderProcessHandler.GetBrowerContext(ABrowser);
  if ABrowserContext = nil then
    Exit;

  msg := TCefProcessMessageRef.New(arguments[0].GetStringValue);

  if SameText(arguments[1].GetStringValue, '_Register') then
  begin
    AScope := ABrowserContext.GetScope(arguments[0].GetStringValue);
    if AScope = nil then
    begin
      exception := '没有找到对应组件';
      Result := false;
      Exit;
    end;
    AScope.Scope := arguments[3];

    msg.ArgumentList.SetString(0, arguments[1].GetStringValue);
    msg.ArgumentList.SetString(1, arguments[2].GetStringValue);
  end
  else
  begin           
    case Length(arguments) of
      2:
      begin
        msg.ArgumentList.SetString(0, arguments[1].GetStringValue);
      end;
      3:
      begin
        msg.ArgumentList.SetString(0, arguments[1].GetStringValue);
        if arguments[2].IsObject then
        begin
          msg.ArgumentList.SetString(1, '');
          msg.ArgumentList.SetString(2, ABrowserContext.AddCallBack(arguments[2]));
        end
        else
        if arguments[2].IsString then
          msg.ArgumentList.SetString(1, arguments[2].GetStringValue);
      end;
      4:
      begin
        msg.ArgumentList.SetString(0, arguments[1].GetStringValue);
        msg.ArgumentList.SetString(1, arguments[2].GetStringValue);
        msg.ArgumentList.SetString(2, ABrowserContext.AddCallBack(arguments[3]));
      end;
    end;
  end;

  TCefv8ContextRef.Current.Browser.SendProcessMessage(PID_BROWSER, msg);
  Result := true;
end;

{ TBrowserContext }

function TBrowserContext.AddCallBack(ACallBack: ICefv8Value): string;
var
  ABaseCallBack: TBaseCallBack;
begin
  ABaseCallBack := TBaseCallBack.Create(ACallBack);
  FCallBacks.AddObject(ABaseCallBack.ID, ABaseCallBack);
  Result := ABaseCallBack.ID;
end;

constructor TBrowserContext.Create(const browser: ICefBrowser);
begin
  FBrowser := browser;
  FScopes := TStringList.Create;
  FCallBacks := TStringList.Create;
  inherited Create();
end;

destructor TBrowserContext.Destroy;
begin
  FScopes.Clear;
  FCallBacks.Clear;
  FreeAndNil(FScopes);
  FreeAndNil(FCallBacks);
  inherited;
end;

function TBrowserContext.GetCallBack(AGuid: string): TBaseCallBack;
var
  iIndex: Integer;
begin
  Result := nil;
  if AGuid = '' then
    Exit;
  iIndex := FCallBacks.IndexOf(AGuid);
  if iIndex > -1 then
  begin
    Result := FCallBacks.Objects[iIndex] as TBaseCallBack;
    FCallBacks.Delete(iIndex);
  end;
end;

function TBrowserContext.GetScope(AGuid: string): TBaseScope;
var
  i: Integer;
  AClass: TBaseScopeClass;
begin
  Result := nil;

  i := FScopes.Indexof(AGuid);
  if i > -1 then
  begin
    Result :=  FScopes.Objects[i] as TBaseScope;
    Exit;
  end;                 

  AClass := TScopeFactory.Current.GetScopeClass(AGuid);
  if AClass = nil then
    Exit;


  Result := AClass.Create;
  FScopes.AddObject(AGuid, Result);
end;

initialization
  CefRemoteDebuggingPort := 9000;
  FCustomRenderProcessHandler := TCustomRenderProcessHandler.Create;
  CefRenderProcessHandler := FCustomRenderProcessHandler;
  CefBrowserProcessHandler := TCefBrowserProcessHandlerOwn.Create;
  ACefExtension := TCefExtension.Create;

finalization

end.