Delphi WebView2 во FMX: чиста иницијализација, изградба на JS-Bridge, контрола над преземањата и дебагирањето

unit WebView2Host;

interface

uses
  System.SysUtils, System.Classes, System.IOUtils, System.JSON,
  Winapi.Windows, Winapi.ActiveX,
  FMX.Types,
  WebView2, WebView2_TLB; // во зависност од подесувањето: WebView2.pas или Import-TLB

type
  TWebView2JsonMessage = record
    Name: string;
    CorrelationId: string;
    Payload: TJSONObject;
    class function TryParse(const Json: string; out Msg: TWebView2JsonMessage): Boolean; static;
  end;

  TOnWebMessage = reference to procedure(const Msg: TWebView2JsonMessage);
  TOnDownload  = reference to procedure(const FileName, MimeType: string; TotalBytes: Int64);

  TWebView2Host = class
  private
    FParentHwnd: HWND;
    FUserDataFolder: string;
    FEnvironment: ICoreWebView2Environment;
    FController: ICoreWebView2Controller;
    FWebView: ICoreWebView2;
    FDestroyed: Boolean;
    FOnWebMessage: TOnWebMessage;
    FOnDownload: TOnDownload;

    procedure EnsureNotDestroyed;
    function MakeUserDataFolder: string;

    // Event handler
    procedure HookEvents;
    procedure UnhookEvents;

    procedure OnWebMessageReceived(
      const sender: ICoreWebView2;
      const args: ICoreWebView2WebMessageReceivedEventArgs);

    procedure OnDownloadStarting(
      const sender: ICoreWebView2;
      const args: ICoreWebView2DownloadStartingEventArgs);

  public
    constructor Create(AParentHwnd: HWND; const AUserDataFolder: string = '');
    destructor Destroy; override;

    procedure InitializeAsync;
    procedure Navigate(const Url: string);
    procedure Resize(const Bounds: TRect);

    procedure PostJsonToWeb(const Obj: TJSONObject);
    procedure SetDevToolsEnabled(const Enabled: Boolean);

    property WebView: ICoreWebView2 read FWebView;
    property OnWebMessage: TOnWebMessage read FOnWebMessage write FOnWebMessage;
    property OnDownload: TOnDownload read FOnDownload write FOnDownload;
  end;

implementation

{ TWebView2JsonMessage }

class function TWebView2JsonMessage.TryParse(const Json: string; out Msg: TWebView2JsonMessage): Boolean;
var
  V: TJSONValue;
  O: TJSONObject;
begin
  Result := False;
  Msg.Name := '';
  Msg.CorrelationId := '';
  Msg.Payload := nil;

  V := TJSONObject.ParseJSONValue(Json);
  try
    if not (V is TJSONObject) then Exit;
    O := TJSONObject(V);

    Msg.Name := O.GetValue('name', '');
    Msg.CorrelationId := O.GetValue('cid', '');

    // Payload може да недостасува или да биде null
    if O.TryGetValue('payload', Msg.Payload) then
      Msg.Payload := TJSONObject(Msg.Payload.Clone)
    else
      Msg.Payload := TJSONObject.Create;

    Result := Msg.Name <> '';
  finally
    V.Free;
  end;
end;

{ TWebView2Host }

constructor TWebView2Host.Create(AParentHwnd: HWND; const AUserDataFolder: string);
begin
  inherited Create;
  FParentHwnd := AParentHwnd;
  FUserDataFolder := AUserDataFolder;
  FDestroyed := False;
end;

destructor TWebView2Host.Destroy;
begin
  FDestroyed := True;

  // Ослободување на настаните пред да се ослободат COM-објектите
  UnhookEvents;

  FWebView := nil;
  FController := nil;
  FEnvironment := nil;

  inherited;
end;

procedure TWebView2Host.EnsureNotDestroyed;
begin
  if FDestroyed then
    raise EInvalidOperation.Create('WebView2Host веќе е уништен.');
end;

function TWebView2Host.MakeUserDataFolder: string;
begin
  if FUserDataFolder <> '' then
    Exit(FUserDataFolder);

  // Практика: по апликација и по Windows-корисник, не во директориумот на програмата
  Result := TPath.Combine(TPath.GetHomePath, 'AppDataLocalMyCompanyMyAppWebView2');
  ForceDirectories(Result);
end;

procedure TWebView2Host.InitializeAsync;
var
  UserData: string;
  Opt: ICoreWebView2EnvironmentOptions;
begin
  EnsureNotDestroyed;

  UserData := MakeUserDataFolder;

  // Options: тука може да се додадат дополнителни аргументи за прелистувачот, н.пр. Remote-Debug
  Opt := TCoreWebView2EnvironmentOptions.Create;

  // Async CreateEnvironment
  OleCheck(CreateCoreWebView2EnvironmentWithOptions(
    nil, PWideChar(UserData), Opt,
    TCoreWebView2CreateCoreWebView2EnvironmentCompletedHandler.Create(
      procedure (errorCode: HRESULT; const createdEnvironment: ICoreWebView2Environment)
      begin
        if FDestroyed then Exit;
        OleCheck(errorCode);

        FEnvironment := createdEnvironment;

        // Controller an Parent HWND binden
        OleCheck(FEnvironment.CreateCoreWebView2Controller(
          FParentHwnd,
          TCoreWebView2CreateCoreWebView2ControllerCompletedHandler.Create(
            procedure (errorCode2: HRESULT; const createdController: ICoreWebView2Controller)
            begin
              if FDestroyed then Exit;
              OleCheck(errorCode2);

              FController := createdController;
              OleCheck(FController.get_CoreWebView2(FWebView));

              HookEvents;

              // Почетно прикажување
              FController.put_IsVisible(1);
            end)));
      end)));
end;

procedure TWebView2Host.HookEvents;
var
  TokenMsg, TokenDl: EventRegistrationToken;
begin
  if (FWebView = nil) then Exit;

  // WebMessageReceived (JS->Delphi)
  TokenMsg.value := 0;
  OleCheck(FWebView.add_WebMessageReceived(
    TCoreWebView2WebMessageReceivedEventHandler.Create(
      procedure(const sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs)
      begin
        if FDestroyed then Exit;
        OnWebMessageReceived(sender, args);
      end), TokenMsg));

  // DownloadStarting
  TokenDl.value := 0;
  OleCheck(FWebView.add_DownloadStarting(
    TCoreWebView2DownloadStartingEventHandler.Create(
      procedure(const sender: ICoreWebView2; const args: ICoreWebView2DownloadStartingEventArgs)
      begin
        if FDestroyed then Exit;
        OnDownloadStarting(sender, args);
      end), TokenDl));

  // Напомена: За робусно откачување треба да ги зачувате токените.
  // Во многу проекти тоа е доволно ако хостот постои само во рамките на животниот век на формата.
end;

procedure TWebView2Host.UnhookEvents;
begin
  // Робустна варијанта: запомнете ги токените и повикајте remove_*.
  // Овде како коментар, бидејќи поставката на import-единицата и управувањето со токените варираат во зависност од wrapper-от.
end;

procedure TWebView2Host.OnWebMessageReceived(
  const sender: ICoreWebView2;
  const args: ICoreWebView2WebMessageReceivedEventArgs);
var
  Json: PWideChar;
  S: string;
  Msg: TWebView2JsonMessage;
begin
  Json := nil;
  OleCheck(args.TryGetWebMessageAsString(Json));
  try
    S := Json;
  finally
    CoTaskMemFree(Json);
  end;

  if Assigned(FOnWebMessage) and TWebView2JsonMessage.TryParse(S, Msg) then
  begin
    try
      FOnWebMessage(Msg);
    finally
      Msg.Payload.Free;
    end;
  end;
end;

procedure TWebView2Host.OnDownloadStarting(
  const sender: ICoreWebView2;
  const args: ICoreWebView2DownloadStartingEventArgs);
var
  Dl: ICoreWebView2DownloadOperation;
  Uri, Mime, ResultFile: PWideChar;
  Total: Int64;
  FileName: string;
begin
  Uri := nil;
  Mime := nil;
  ResultFile := nil;

  OleCheck(args.get_DownloadOperation(Dl));
  OleCheck(Dl.get_TotalBytesToReceive(Total));

  // Во пракса: ResultFileName првично празен, зависно од изворот.
  OleCheck(Dl.get_ResultFilePath(ResultFile));
  OleCheck(Dl.get_MimeType(Mime));
  OleCheck(Dl.get_Uri(Uri));

  try
    FileName := ExtractFileName(string(ResultFile));
    if FileName = '' then
      FileName := 'download.bin';

    if Assigned(FOnDownload) then
      FOnDownload(FileName, string(Mime), Total);

    // Опционално: сопствен UI за преземање, тогаш поставете Handled
    // args.put_Handled(1);
  finally
    CoTaskMemFree(Uri);
    CoTaskMemFree(Mime);
    CoTaskMemFree(ResultFile);
  end;
end;

procedure TWebView2Host.Navigate(const Url: string);
begin
  EnsureNotDestroyed;
  if FWebView = nil then
    raise EInvalidOperation.Create('WebView2 уште не е иницијализиран.');

  OleCheck(FWebView.Navigate(PWideChar(Url)));
end;

procedure TWebView2Host.Resize(const Bounds: TRect);
var
  R: tagRECT;
begin
  if FController = nil then Exit;
  R.Left := Bounds.Left;
  R.Top := Bounds.Top;
  R.Right := Bounds.Right;
  R.Bottom := Bounds.Bottom;
  OleCheck(FController.put_Bounds(R));
end;

procedure TWebView2Host.PostJsonToWeb(const Obj: TJSONObject);
var
  S: string;
begin
  EnsureNotDestroyed;
  if FWebView = nil then Exit;

  S := Obj.ToJSON;
  OleCheck(FWebView.PostWebMessageAsString(PWideChar(S)));
end;

procedure TWebView2Host.SetDevToolsEnabled(const Enabled: Boolean);
var
  Settings: ICoreWebView2Settings;
begin
  if (FWebView = nil) then Exit;
  OleCheck(FWebView.get_Settings(Settings));
  OleCheck(Settings.put_AreDevToolsEnabled(Ord(Enabled)));
end;

end.