TEdgeBroWserのブックマークの実装について

解決

Jhon 2022-10-28 17:22:07 No: 150647

お世話になります。
TEdgeブラウザでお気に入り登録（ブックマーク）を実装したいと思っています。
現状では、単純にComboBoxにURLのみを登録する形にしています。
起動時にURLテキストを読み込んで、終了時に書込みしています。
ページtitle（は抽出出来ています）とセットで登録したいと思っています。

GoogleChromeのブックマークのようなものは実装は可能なのでしょうか？
以上、よろしくお願いいたします。

あ 2022-10-29 10:47:23 No: 150649

可能です。
表示されたurlを保存するだけですので、それほど難しいことではありません。

あ 2022-10-29 10:58:12 No: 150650

コードエディタの補完ウィンドウで、tedgebrowserのプロパティやメソッドを表示させて、titleやurlといった単語を入力すると、それらしいプロパティが見つかるでしょう。
それを保存するだけです。

Jhon 2022-10-29 18:13:00 No: 150651

あ　さん
貴重なアドバイスありがとうございます。

EdgeBrowser1.DocumentTitle でTitleが取得出来ることを知らずに、

HTML分からTitle部分を自前で抽出していました。
    Option := [roIgnoreCase, roSingleLine];//改行対策、複数行も検索
    s := IdHTTP1.Get(ComboBox2.text);  //アドレスからHTMLを取得
    mm := TRegex.Match(s, '<title>(.*)</title>',Option); //title部分を抽出

Titleの取得はEdgeBrowser1.DocumentTitleを利用させていただきます。
URLは既にEdgeBrowser1.LocationURで利用をしていました。

ちょっと表現が足りなかったのですが、title　とURL　をComboBoxに記録させる方法については
出来ていますが、GoogleChromeのブックマークのようなブックマークを階層で記録し、
編集もしたいと思っています。私にはハードルが高いかもしれないのですが、
もし、ご存知でしたらご教授くださればありがたく存じます。

AAAAA 2022-10-30 08:36:51 No: 150652

EdgeBrowser　はお気に入り用に別に用意する

  TWEB_DATA = class
  public
    TITLE: String;
    URL: String;
    ICON: String;
  end;

//お気に入り表示
procedure TForm1.Button7Click(Sender: TObject);
var
    I: Integer;
    S: TStringList;
    LIST: TList;

    DATA: TWEB_DATA;
    S1,S2: String;
    ICON: TICON;
    SS: String;
begin
    SS := ExtractFilePath(ParamStr(0)) + 'IMG\';

LIST := TLIST.Create;

　   //仮データ
    DATA := TWEB_DATA.Create;　
    DATA.TITLE := 'Yahoo! JAPAN';
    DATA.URL   := 'https://www.yahoo.co.jp';
    DATA.ICON  := 'Yahoo! JAPAN.ico';
    LIST.Add(DATA);

    DATA := TWEB_DATA.Create;
    DATA.TITLE := 'YouTube';
    DATA.URL   := 'https://www.youtube.com/';
    DATA.ICON  := 'YouTube.ico';

LIST.Add(DATA);

S1 := 'onMouseover="this.style.backgroundColor=''#AAAAAA''" onMouseOut="this.style.backgroundColor=''#FFFFFF''" ';

    S := TStringList.Create;
    S.Add('<!DOCTYPE html>');
    S.Add('<html lang="ja">');
    S.Add('<head>');
    S.Add('<meta charset="SHIFT-JIS">');
    S.Add('<META http-equiv="Content-Script-Type" content="text/javascript">');
    S.Add('<script type="text/javascript">');
    S.Add('function visibility( $id )');
    S.Add('{');
    S.Add('  if ( document.getElementById( $id ).style.display == "none" )');
    S.Add('  {');
    S.Add('    document.getElementById( $id ).style.display="block";');
    S.Add('  }');
    S.Add('   else');
    S.Add('  {');
    S.Add('    document.getElementById( $id ).style.display="none";');
    S.Add('  }');
    S.Add('}');
    S.Add('</script>');
    S.Add('</head>');
    S.Add('');
    S.Add('<body>');

S.Add('<div style="cursor:pointer;" ' + S1 + ' onClick="visibility(''bookmark'')"><img style="width:24px; height:24px" src="' + SS + 'directory.ico">ブックマーク</div>');
//ブックマーク</h3>');

    S.Add('<div id="bookmark">');
    S.Add('<table style="width:100%; border-spacing:0px;">');
    for I:=0 to LIST.Count -1 do
    begin
      DATA := LIST[I];
      ICON := TICON.Create;
      S2 := '';
      if FileExists('IMG\' + DATA.ICON) = True then
      begin
        S2 := '<img style="width:24px; height:24px;" src="' + SS + DATA.ICON + '">'
      end
      else
      begin
        S2 := '■';
      end;
      S.Add('<tr ' + S1 + '><td style="width:32px;"></td><td style="width:32px">' + S2 + '</td><td ' + S1 + '><a href="' + DATA.URL + ' ">' + DATA.TITLE + '</a></td><tr>');
      ICON.Free;
    end;

S.Add('</table>');
S.Add('</div>');

S.Add('</body>');
S.Add('</html>');

    for I:=0 to List.Count -1 do
    begin
      DATA := LIST[I];
      DATA.Free;
    end;

    //EdgeBrowser1.NavigateToString(S.TEXT);　//こっちだとイメージがブロックされる
    S.SaveToFile(FAV);
    EdgeBrowser2.Navigate(FAV);

LIST.Free;
S.Free;
end;

    OLDURL := TEdgeBrowser(SEnder).LocationURL;
    if OLDURL <> '' then
    begin
      if NEWURL <> '' then
      begin
        Args.ArgsInterface.Set_Cancel(1);
        EdgeBrowser1.Navigate(NEWURL);
      end;
    end;
end;

//アイコン取得
procedure TForm1.EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
  IsSuccess: Boolean; WebErrorStatus: TOleEnum);
var
    P: PWideChar;
    MemoryStream: TMemoryStream;
    ICON: TICON;
    TITLE: String;
    SS: String;
begin
    //WEB_URL   := TEdgeBrowser(SEnder).LocationURL;
    TITLE := TEdgeBrowser(SEnder).DocumentTitle;
    SS := ExtractFilePath(ParamStr(0)) + 'IMG\';

    //ICON 取得 (
    //<link rel=icon type=image/x-icon で設定されてい場合ソース解読かな？
    MemoryStream := TMemoryStream.Create;
    try
      IdHTTP1.Get(WEB_URL + '/favicon.ico',MemoryStream);
      if MemoryStream.Position <> 0 then
      begin
        ICON := TICON.Create;
        MemoryStream.Position := 0;
        ICON.LoadFromStream(MemoryStream);
        ICON.SaveToFile(SS + TITLE + '.ico');
        ICON.Free;
      end;
    except
    end;
    MemoryStream.Free;

end;

AAAAA 2022-10-30 12:24:37 No: 150653

ちょっと作り直し
---------------------------------------------------------------------------------------------
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.WebView2, Winapi.ActiveX,
  Vcl.Edge, Vcl.StdCtrls, Vcl.ComCtrls, System.NetEncoding,
  Vcl.OleCtrls, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL,
  IdSSLOpenSSL, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, Vcl.ToolWin, Vcl.ExtCtrls;

type
  TWEB_DATA = class
  public
    TITLE: String;
    URL: String;
    FAVICON: String;
  end;

  TForm1 = class(TForm)
    EdgeBrowser1: TEdgeBrowser;
    IdHTTP1: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    Panel1: TPanel;
    Edit1: TEdit;
    Button2: TButton;
    Button1: TButton;
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    EdgeBrowser2: TEdgeBrowser;
    procedure EdgeBrowser1NewWindowRequested(Sender: TCustomEdgeBrowser;
      Args: TNewWindowRequestedEventArgs);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
      IsSuccess: Boolean; WebErrorStatus: TOleEnum);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EdgeBrowser1ExecuteScript(Sender: TCustomEdgeBrowser;
      AResult: HRESULT; const AResultObjectAsJson: string);
    procedure EdgeBrowser2NavigationStarting(Sender: TCustomEdgeBrowser;
      Args: TNavigationStartingEventArgs);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    procedure ADD_favorite;
    procedure VIEW_favorite;
  end;

var
Form1: TForm1;

  WEB_TITLE: String;
  WEB_URL: String;
  WEB_FAVICON: String;
  WEB_ICON: String;
  IMG_DIR: String;
  TEMP_HTML: String;
   LIST: TList;

implementation

{$R *.dfm}

procedure TForm1.ADD_favorite;
var
    DATA: TWEB_DATA;
begin
    DATA := TWEB_DATA.Create;
    DATA.TITLE   := WEB_TITLE;
    DATA.URL     := WEB_URL;
    DATA.FAVICON := WEB_FAVICON;
    LIST.Add(DATA);
end;

procedure TForm1.VIEW_favorite;
var
I: Integer;
S: TStringList;

    DATA: TWEB_DATA;
    S1,S2: String;
    ICON: TICON;
begin
    S1 := 'onMouseover="this.style.backgroundColor=''#AAAAAA''" onMouseOut="this.style.backgroundColor=''#FFFFFF''" ';

S.Add('<div style="cursor:pointer;" ' + S1 + ' onClick="visibility(''bookmark'')"><img style="width:24px; height:24px" src="' + IMG_DIR + 'directory.ico">ブックマーク</div>');
//ブックマーク</h3>');

    S.Add('<div id="bookmark">');
    S.Add('<table style="width:100%; border-spacing:0px;">');
    for I:=0 to LIST.Count -1 do
    begin
      DATA := LIST[I];
      S2 := '<img style="width:24px; height:24px;" src="' + DATA.FAVICON + '">';
      S.Add('<tr ' + S1 + '><td style="width:32px;"></td><td style="width:32px">' + S2 + '</td><td ' + S1 + '><a href="' + DATA.URL + ' ">' + DATA.TITLE + '</a></td><tr>');
      ICON.Free;
    end;

    S.Add('</table>');
    S.Add('</div>');
    S.Add('</body>');
    S.Add('</html>');

    //EdgeBrowser1.NavigateToString(S.TEXT);
    S.SaveToFile(TEMP_HTML);
    EdgeBrowser2.Navigate(TEMP_HTML);

S.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
EdgeBrowser1.Navigate(Edit1.Text);
end;

//お気に入り登録

procedure TForm1.Button2Click(Sender: TObject);
begin
    //EdgeBrowser1ExecuteScript 処理終了前に登録すると前のデータで登録される
    ADD_favorite;
    VIEW_favorite;
end;

procedure TForm1.EdgeBrowser1ExecuteScript(Sender: TCustomEdgeBrowser;
  AResult: HRESULT; const AResultObjectAsJson: string);
var
    I,I1,I2: Integer;
    S: String;
    B: Boolean;
    S1,S2: String;
    REL,HREF: String;
begin
   if AResultObjectAsJson <> 'null' then
   begin
     S := TNetEncoding.URL.Decode(AResultObjectAsJson).DeQuotedString('"');

     //HEAD取得
     I := Pos('<head>',S);
     S := Copy(S,I);
     I := Pos('</head>',S);
     S := Copy(S,1,I+6);

     //<link 取得
     B := True;
     while B = True do
     begin
       I := Pos('<link',S);
       if I <> 0 then
       begin
         S  := Copy(S,I);
         I  := Pos('>',S);
         S1 := Copy(S,1,I);

         I1 := Pos('rel=',S1);
         if I1 <> 0 then
         begin
           S1 := Copy(S1,I1+4); //rel=以降
           if S1[1] = '"' then
           begin
             S1  := Copy(S1,2);
             I2  := Pos('"',S1);
             REL := Copy(S1,I2-1);
           end
           else
           begin
             I2 := Pos(' ',S1);
             REL := Copy(S1,1,I2-1);
           end;

           I1 := Pos('href=',S1);
           if I1 <> 0 then
           begin
             S1 := Copy(S1,I1+5);      //<href=以降

             if S1[1] = '"' then
             begin
               S1 := Copy(S1,2);
               I2 := Pos('"',S1);
               S2 := Copy(S1,I2-1);
             end
             else
             begin
               HREF := '';
               I2 := Pos(' ',S1);
               if I2 <> 0 then HREF := Copy(S1,1,I2-1);
               if HREF = '' then
               begin
                 I2 := Pos('>',S1);
                 if I2 <> 0 then HREF := Copy(S1,1,I2-1);
               end;

               if (REL = 'icon') or (REL = 'shortcut icon') then
               begin
                 WEB_FAVICON := HREF;
               end;

             end;
           end
           else
           begin
             //href が存在しない
           end;
         end
         else
         begin
           //rel=が存在しない
         end;

         S := Copy(S,I);
       end
       else
       begin
         B := False;
       end;
     end;

end;
end;

procedure TForm1.EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
  IsSuccess: Boolean; WebErrorStatus: TOleEnum);
var
    P: PWideChar;
    MemoryStream: TMemoryStream;
begin
    WEB_URL   := TEdgeBrowser(SEnder).LocationURL;
    WEB_TITLE := TEdgeBrowser(SEnder).DocumentTitle;

    //ICON 取得
    MemoryStream := TMemoryStream.Create;
    try
      IdHTTP1.Get(WEB_URL + '/favicon.ico',MemoryStream);
      if MemoryStream.Position <> 0 then
      begin
        WEB_FAVICON := WEB_URL + 'favicon.ico';
      end;
      EdgeBrowser1.ExecuteScript('encodeURI(document.documentElement.innerHTML)');
    except
    end;
    MemoryStream.Free;
end;

procedure TForm1.EdgeBrowser2NavigationStarting(Sender: TCustomEdgeBrowser;
  Args: TNavigationStartingEventArgs);
var
    OLDURL: String;
    NEWURL: PWideChar;
begin
    Args.ArgsInterface.Get_uri(NEWURL);
    OLDURL := TEdgeBrowser(SEnder).LocationURL;
    if OLDURL <> '' then
    begin
      if Copy(StrPas(NEWURL),1,5) <> 'file:' then
      begin
        Args.ArgsInterface.Set_Cancel(1);
        EdgeBrowser1.Navigate(NEWURL);
      end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//EdgeBrowser1 通常
//EdgeBrowser2 お気に入り

EdgeBrowser1.UserDataFolder := ExtractFileDir(Application.ExeName);
EdgeBrowser2.UserDataFolder := ExtractFileDir(Application.ExeName);

IMG_DIR := ExtractFilePath(ParamStr(0)) + 'IMG\';　　　　//IMG_DIRに directory.ico を作成しておく
TEMP_HTML := ExtractFilePath(ParamStr(0)) + 'TEMP.HTML';

EdgeBrowser1.CreateWebView;
EdgeBrowser2.CreateWebView;

LIST := TLIST.Create;

    try
      MkDir (IMG_DIR);
    except
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LIST.Free;
Exit;
end;

//------------------------------------------------------------------------------

Jhon 2022-10-30 20:50:44 No: 150654

AAAAAさん　
素晴らしいコードありがとうございます。
Javascriptを活用して作成するのですね。

一部エラー等が出たので変えました。
WinApi.WebView2　→WebView2
FV　→TEMP_HTML

EdgeBrowser1で表示されたものをButton2をクリックするとブックマークが表示されました。
Button3を押すと事前に登録していたYahoo,Youtube のブックマークが表示されました。

ただ、以下のような症状があります。
①EdgeBrowse1はComboBoxに最初に入力したアドレスを入れた以降、別のURLを
入れても、画面遷移は全くしません。原因は全く不明です。

②アイコンの取得が出来ていないようです。

③プログラムがフリーズしてしまいます。

ーーーーーーー
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, WebView2, Winapi.ActiveX,
  Vcl.Edge, Vcl.StdCtrls, Vcl.ComCtrls, System.NetEncoding,
  Vcl.OleCtrls, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL,
  IdSSLOpenSSL, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, Vcl.ToolWin, Vcl.ExtCtrls;

type
  TWEB_DATA = class
  public
    TITLE: String;
    URL: String;
    FAVICON: String;
    ICON: String;
  end;

    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
      IsSuccess: Boolean; WebErrorStatus: TOleEnum);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EdgeBrowser1ExecuteScript(Sender: TCustomEdgeBrowser;
      AResult: HRESULT; const AResultObjectAsJson: string);
    procedure EdgeBrowser2NavigationStarting(Sender: TCustomEdgeBrowser;
      Args: TNavigationStartingEventArgs);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure EdgeBrowser1NavigationStarting(Sender: TCustomEdgeBrowser;
      Args: TNavigationStartingEventArgs);
  private
    { Private 宣言 }
  public
    procedure ADD_favorite;
    procedure VIEW_favorite;

end;

var
Form1: TForm1;

  WEB_TITLE: String;
  WEB_URL: String;
  WEB_FAVICON: String;
  WEB_ICON: String;
  IMG_DIR: String;
  TEMP_HTML: String;
   LIST: TList;

implementation

{$R *.dfm}

procedure TForm1.VIEW_favorite;
var
I: Integer;
S: TStringList;

    DATA: TWEB_DATA;
    S1,S2: String;
    ICON: TICON;
begin
    S1 := 'onMouseover="this.style.backgroundColor=''#AAAAAA''" onMouseOut="this.style.backgroundColor=''#FFFFFF''" ';
    S := TStringList.Create;
    S.Add('<!DOCTYPE html>');
    S.Add('<html lang="ja">');
    S.Add('<head>');
    S.Add('<meta charset="SHIFT-JIS">');
    S.Add('<META http-equiv="Content-Script-Type" content="text/javascript">');
    S.Add('<script type="text/javascript">');
    S.Add('function visibility( $id )');
    S.Add('{');
    S.Add('  if ( document.getElementById( $id ).style.display == "none" )');
    S.Add('  {');
    S.Add('    document.getElementById( $id ).style.display="block";');
    S.Add('  }');
    S.Add('   else');
    S.Add('  {');
    S.Add('    document.getElementById( $id ).style.display="none";');
    S.Add('  }');
    S.Add('}');
    S.Add('</script>');
    S.Add('</head>');
    S.Add('');
    S.Add('<body>');

    S.Add('</table>');
    S.Add('</div>');
    S.Add('</body>');
    S.Add('</html>');

    //EdgeBrowser1.NavigateToString(S.TEXT);
    S.SaveToFile(TEMP_HTML);
    EdgeBrowser2.Navigate(TEMP_HTML);

S.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
EdgeBrowser1.Navigate(Edit1.Text);
end;

//お気に入り登録

procedure TForm1.Button2Click(Sender: TObject);
begin
    //EdgeBrowser1ExecuteScript 処理終了前に登録すると前のデータで登録される
    ADD_favorite;
    VIEW_favorite;
end;
///お気に入り表示
procedure TForm1.Button3Click(Sender: TObject);
var
    I: Integer;
    S: TStringList;
    LIST: TList;

    DATA: TWEB_DATA;
    S1,S2: String;
    ICON: TICON;
    SS: String;
begin
    SS := ExtractFilePath(ParamStr(0)) + 'IMG\';

LIST := TLIST.Create;

　   //仮データ
    DATA := TWEB_DATA.Create;　
    DATA.TITLE := 'Yahoo! JAPAN';
    DATA.URL   := 'https://www.yahoo.co.jp';
    DATA.ICON  := 'Yahoo! JAPAN.ico';
    LIST.Add(DATA);

    DATA := TWEB_DATA.Create;
    DATA.TITLE := 'YouTube';
    DATA.URL   := 'https://www.youtube.com/';
    DATA.ICON  := 'YouTube.ico';

LIST.Add(DATA);

S1 := 'onMouseover="this.style.backgroundColor=''#AAAAAA''" onMouseOut="this.style.backgroundColor=''#FFFFFF''" ';

S.Add('</table>');
S.Add('</div>');

S.Add('</body>');
S.Add('</html>');

    for I:=0 to List.Count -1 do
    begin
      DATA := LIST[I];
      DATA.Free;
    end;

    //EdgeBrowser1.NavigateToString(S.TEXT);　//こっちだとイメージがブロックされる
//    S.SaveToFile(FAV);
//    EdgeBrowser2.Navigate(FAV);
        S.SaveToFile(TEMP_HTML);
    EdgeBrowser2.Navigate(TEMP_HTML);

LIST.Free;
S.Free;
end;

     //HEAD取得
     I := Pos('<head>',S);
     S := Copy(S,I);
     I := Pos('</head>',S);
     S := Copy(S,1,I+6);

           I1 := Pos('href=',S1);
           if I1 <> 0 then
           begin
             S1 := Copy(S1,I1+5);      //<href=以降

               if (REL = 'icon') or (REL = 'shortcut icon') then
               begin
                 WEB_FAVICON := HREF;
               end;

             end;
           end
           else
           begin
             //href が存在しない
           end;
         end
         else
         begin
           //rel=が存在しない
         end;

         S := Copy(S,I);
       end
       else
       begin
         B := False;
       end;
     end;

end;
end;

procedure TForm1.EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
  IsSuccess: Boolean; WebErrorStatus: TOleEnum);
var
    P: PWideChar;
    MemoryStream: TMemoryStream;
begin
    WEB_URL   := TEdgeBrowser(Sender).LocationURL;
    WEB_TITLE := TEdgeBrowser(Sender).DocumentTitle;

procedure TForm1.EdgeBrowser1NavigationStarting(Sender: TCustomEdgeBrowser;
  Args: TNavigationStartingEventArgs);
var
    OLDURL: String;
    NEWURL: PWideChar;
begin
    Args.ArgsInterface.Get_uri(NEWURL);

procedure TForm1.FormCreate(Sender: TObject);
begin
//EdgeBrowser1 通常
//EdgeBrowser2 お気に入り

EdgeBrowser1.UserDataFolder := ExtractFileDir(Application.ExeName);
EdgeBrowser2.UserDataFolder := ExtractFileDir(Application.ExeName);

IMG_DIR := ExtractFilePath(ParamStr(0)) + 'IMG\';　　　　//IMG_DIRに directory.ico を作成しておく
TEMP_HTML := ExtractFilePath(ParamStr(0)) + 'TEMP.HTML';

EdgeBrowser1.CreateWebView;
EdgeBrowser2.CreateWebView;

LIST := TLIST.Create;

    try
      MkDir (IMG_DIR);
    except
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LIST.Free;
Exit;
end;
end.

AAAAA 2022-10-31 00:10:52 No: 150655

作り直したやつに作り直す前の Button3 追加しちゃうと Button3 で　LIst.Free しているからおかしくなる

さらに作り直したやつ
----------------
unit Unit1;

interface

type
  TWEB_DATA = class
  public
    TITLE: String;
    URL: String;
    FAVICON: String;
  end;

  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    FavoriteButton1: TButton;
    GoBackButton1: TButton;
    UpdateButton1: TButton;
    Panel1: TPanel;
    EdgeBrowser1: TEdgeBrowser;
    EdgeBrowser2: TEdgeBrowser;
    StatusBar1: TStatusBar;
    IdHTTP1: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    procedure FavoriteButton1Click(Sender: TObject);
     procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EdgeBrowser1NavigationStarting(Sender: TCustomEdgeBrowser;
      Args: TNavigationStartingEventArgs);
    procedure EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
      IsSuccess: Boolean; WebErrorStatus: TOleEnum);
    procedure EdgeBrowser1ExecuteScript(Sender: TCustomEdgeBrowser;
      AResult: HRESULT; const AResultObjectAsJson: string);
    procedure EdgeBrowser2NavigationStarting(Sender: TCustomEdgeBrowser;
      Args: TNavigationStartingEventArgs);
    procedure ComboBox1Select(Sender: TObject);
    procedure ComboBox1CloseUp(Sender: TObject);
    procedure EdgeBrowser1DocumentTitleChanged(Sender: TCustomEdgeBrowser;
      const ADocumentTitle: string);
    procedure EdgeBrowser1SourceChanged(Sender: TCustomEdgeBrowser;
      IsNewDocument: Boolean);
    procedure GoBackButton1Click(Sender: TObject);
    procedure UpdateButton1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    procedure ADD_favorite;
    procedure VIEW_favorite;
  end;

var
Form1: TForm1;

  WEB_TITLE: String;
  WEB_URL: String;
  WEB_FAVICON: String;
  WEB_ICON: String;
  IMG_DIR: String;
  TEMP_HTML: String;
  LIST: TList;
  CloseUp: Boolean;

implementation

{$R *.dfm}

procedure TForm1.ADD_favorite;
var
DATA: TWEB_DATA;
I,J: Integer;
begin

    if (WEB_TITLE <> '') and (WEB_URL <> '') then
    begin
      J := -1;
      for I:=0 to LIST.Count -1 do
      begin
        DATA := LIST[I];
        if DATA.URL = WEB_URL then
        begin
          J := I;
        end;
      end;

      if J = -1 then
      begin
        DATA := TWEB_DATA.Create;
        DATA.TITLE   := WEB_TITLE;
        DATA.URL     := WEB_URL;
        DATA.FAVICON := WEB_FAVICON;
        LIST.Add(DATA);
      end
      else
      begin
        DATA := LIST[J];
        DATA.TITLE   := WEB_TITLE;
        DATA.FAVICON := WEB_FAVICON;
      end;

end;
end;

procedure TForm1.VIEW_favorite;
var
I: Integer;
S: TStringList;

    DATA: TWEB_DATA;
    S1,S2: String;
    ICON: TICON;
begin
    S1 := 'onMouseover="this.style.backgroundColor=''#AAAAAA''" onMouseOut="this.style.backgroundColor=''#FFFFFF''" ';

    S.Add('</table>');
    S.Add('</div>');
    S.Add('</body>');
    S.Add('</html>');

    //EdgeBrowser1.NavigateToString(S.TEXT);
    S.SaveToFile(TEMP_HTML);
    EdgeBrowser2.Navigate(TEMP_HTML);

S.Free;
end;

//戻る
procedure TForm1.GoBackButton1Click(Sender: TObject);
begin
EdgeBrowser1.GoBack;
end;

//更新
procedure TForm1.UpdateButton1Click(Sender: TObject);
begin
EdgeBrowser1.Navigate(EdgeBrowser1.LocationURL);
end;

//お気に入り登録
procedure TForm1.FavoriteButton1Click(Sender: TObject);
begin
ADD_favorite;
VIEW_favorite;
end;

procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
var
    I: Integer;
begin
    if Key = Char(13) then
    begin
      I := ComboBox1.Items.IndexOf(ComboBox1.Text);
      if I = -1 then ComboBox1.Items.Add(ComboBox1.Text);
      EdgeBrowser1.Navigate(ComboBox1.Text);
    end;
end;

procedure TForm1.ComboBox1CloseUp(Sender: TObject);
begin
CloseUp := True;
end;

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
if CloseUp = True then EdgeBrowser1.Navigate(ComboBox1.Text);
CloseUp := False;
end;

     //HEAD取得
     I := Pos('<head>',S);
     S := Copy(S,I);
     I := Pos('</head>',S);
     S := Copy(S,1,I+6);

           I1 := Pos('href=',S1);
           if I1 <> 0 then
           begin
             S1 := Copy(S1,I1+5);      //<href=以降

               if (REL = 'icon') or (REL = 'shortcut icon') then
               begin
                 WEB_FAVICON := HREF;
               end;

             end;
           end
           else
           begin
             //href が存在しない
           end;
         end
         else
         begin
           //rel=が存在しない
         end;

         S := Copy(S,I);
       end
       else
       begin
         B := False;
       end;
     end;
   end;
   FavoriteButton1.Enabled := True;
end;

procedure TForm1.EdgeBrowser1DocumentTitleChanged(Sender: TCustomEdgeBrowser;
  const ADocumentTitle: string);
begin
    WEB_TITLE := TEdgeBrowser(SEnder).DocumentTitle;
    Caption := WEB_TITLE;
end;

procedure TForm1.EdgeBrowser1SourceChanged(Sender: TCustomEdgeBrowser;
IsNewDocument: Boolean);
begin
WEB_URL := TEdgeBrowser(SEnder).LocationURL;
end;

procedure TForm1.EdgeBrowser1NavigationStarting(Sender: TCustomEdgeBrowser;
  Args: TNavigationStartingEventArgs);
var
    P:PWideChar;
begin
    WEB_TITLE := TEdgeBrowser(SEnder).DocumentTitle;
    FavoriteButton1.Enabled := False;
    Args.ArgsInterface.Get_uri(P);
    WEB_URL := StrPas(P);
    ComboBox1.Text := WEB_URL;
end;

procedure TForm1.EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
  IsSuccess: Boolean; WebErrorStatus: TOleEnum);
var
    P: PWideChar;
    MemoryStream: TMemoryStream;
begin
    WEB_TITLE := TEdgeBrowser(SEnder).DocumentTitle;
    Caption := WEB_TITLE;

procedure TForm1.FormCreate(Sender: TObject);
var
    Buffer: array[0..255] of Char;
    I,J: Integer;
    INI: String;
    DATA: TWEB_DATA;
begin

    //EdgeBrowser1  通常
    //EdgeBrowser2  お気に入り
    IMG_DIR   := ExtractFilePath(ParamStr(0)) + 'IMG\';　　　　//IMG_DIRに directory.ico を作成しておく
    TEMP_HTML := ExtractFilePath(ParamStr(0)) + 'favorite.html';

    IdHTTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
    IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := sslvSSLv23;
    IdSSLIOHandlerSocketOpenSSL1.SSLOptions.SSLVersions := [sslvSSLv2,sslvSSLv3,sslvTLSv1,sslvTLSv1_1,sslvTLSv1_2];
    EdgeBrowser1.OnExecuteScript       := EdgeBrowser1ExecuteScript;
    EdgeBrowser1.OnNavigationStarting  := EdgeBrowser1NavigationStarting;
    EdgeBrowser1.OnNavigationCompleted := EdgeBrowser1NavigationCompleted;
    EdgeBrowser2.OnNavigationStarting  := EdgeBrowser2NavigationStarting;
    ComboBox1.OnKeyPress               := ComboBox1KeyPress;

    EdgeBrowser2.Align := alRight;
    EdgeBrowser2.Width := 300;
    EdgeBrowser1.Align := alClient;

EdgeBrowser1.UserDataFolder := ExtractFileDir(Application.ExeName);
EdgeBrowser2.UserDataFolder := ExtractFileDir(Application.ExeName);

EdgeBrowser1.CreateWebView;
EdgeBrowser2.CreateWebView;

    try
      MkDir (IMG_DIR);
    except
    end;

    INI := ChangeFileExt(ParamStr(0),'.ini');
    LIST := TLIST.Create;
    J := GetPrivateProFileInt('SYS','COUNT',0,PWideChar(INI));
    for I:=0 to J-1 do
    begin
      DATA := TWEB_DATA.Create;
      GetPrivateProFileString(PWideChar(IntToStr(I)),'TITLE'  ,'',Buffer,SizeOf(Buffer),PWideChar(INI));
      DATA.TITLE   := StrPas(Buffer);
      GetPrivateProFileString(PWideChar(IntToStr(I)),'URL'    ,'',Buffer,SizeOf(Buffer),PWideChar(INI));
      DATA.URL     := StrPas(Buffer);
      GetPrivateProFileString(PWideChar(IntToStr(I)),'FAVICON','',Buffer,SizeOf(Buffer),PWideChar(INI));
      DATA.FAVICON := StrPas(Buffer);
      LIST.Add(DATA);
    end;

INI := ChangeFileExt(ParamStr(0),'.txt');
if FileExists(INI) = True then ComboBox1.Items.LoadFromFile(INI);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
    I: Integer;
    DATA: TWEB_DATA;
    INI: String;
begin
    INI := ChangeFileExt(ParamStr(0),'.ini');

    WritePrivateProFileString('SYS','COUNT',PWideChar(IntToStr(LIST.Count)),PWideChar(INI));
    for I:=0 to LIST.Count -1 do
    begin
      DATA := LIST[I];
      WritePrivateProFileString(PWideChar(IntToStr(I)),'TITLE'  ,PWideChar(DATA.TITLE)  ,PWideChar(INI));
      WritePrivateProFileString(PWideChar(IntToStr(I)),'URL'    ,PWideChar(DATA.URL)    ,PWideChar(INI));
      WritePrivateProFileString(PWideChar(IntToStr(I)),'FAVICON',PWideChar(DATA.FAVICON),PWideChar(INI));
      DATA.Free;
    end;
    LIST.Free;

    INI := ChangeFileExt(ParamStr(0),'.txt');
    ComboBox1.Items.SaveToFile(INI);
    Exit;
end;

end.

Jhon 2022-10-31 17:13:52 No: 150656

AAAAA様
度々ありがとうございます。

再度、上記コードで再構築しました。
初回起動時：エラーもなくコンパイルができ、ブックマークの登録もできました。
２回目の起動：でFavorite.Buttonを押すと、「アドレスFEC3F7F1でアドレスFEC3F7F1の読み取り違反がおきました」と出ました。
Edge１の方で画面遷移は出来ますが、ページによって画面の読込完了してもFavaritte.Buttonボタンはグレー表記（FavoriteButton1.Enabled := False;）のまま。
FavoriteButton1.Enabled := True;となるページを見つけてFavorite.Buttonを押すと、今度は「読み取り違反が置きました」と出ます。
その後、再度、コンパイルをするがコンパイルはそのままエラーも出ず完了しますが、
今度はフォームが表示されなくなるという不思議な症状が出ています。試しに別のプロジェクトを起動し、コンパイルすると正常に表示されます。
Ctrl+Alt+DELでタスクマネージャーを起動してみますが、このアプリの起動はされていない状況です。

Jhon 2022-10-31 17:32:16 No: 150657

上記の内容は、無視してください。(^_^;)
プログラムで使用する関連ファイル等を開いたままにしていたことが原因でした。

改めて、EXEの削除,iniファイル、Favorite.html等を削除して
再度コンパイルは出来るようにはなりましたが、引き続き以下の症状が出ます。

初回起動ページから遷移する際に、モジュール　FvBmark.exeのアドレス　006D09F9 でアドレス0000000に対する読み取り違反がおきました。
その後、ページ遷移が出来なくなります。
２回目のコンパイル起動、新しいURLをブックマーク登録しようとすると「無効なポインタ操作」と出て、Favaritte.ButtonはHideとなり
ボタンが表示されなくなりました。
３回目のコンパイル起動、２回目と同じです。

AAAAA 2022-11-01 16:59:35 No: 150658

procedure TForm1.EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
  IsSuccess: Boolean; WebErrorStatus: TOleEnum);
var
    P: PWideChar;
    MemoryStream: TMemoryStream;
begin
    WEB_TITLE := TEdgeBrowser(SEnder).DocumentTitle;
    Caption := WEB_TITLE;

EdgeBrowser1.ExecuteScript('encodeURI(document.documentElement.innerHTML)');
を try - except の外へ

Jhon 2022-11-01 17:44:20 No: 150659

AAAAAさん
ありがとうございます。
コードを更新してコンパイルは完了していますが、フォームが表示されないという不思議な症状が出ています。
これ以上の追求は私のレベルでは難しいので、
別途簡易的なブックマークで完成させようと思います。
一旦、解決とさせていただきます。
AAAAAさん、重ねてのアドバイスありがとうございました。

AAAAA 2022-11-05 09:35:43 No: 150668

右側に出るブックマークブラウザー表示にしたけど

Google Chromeは
右側に出るブックマークはWinコントロールで作ってる（作るなら ListBox かな)
こっちのポップアップは Window からはみ出す

chrome://bookmarks/ で出るブックマークはブラウザーで表示してる
こっちのポップアップはポップアップ上で右クリックすると webページ上で表示されるポップアップが表示される