TEdgeBrowserへの移行について(参考になれば) (ID：150213)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

TEdgeBrowserへの変更を加えたプログラムを、同時に5本の配布することになり、
全てに、「\bin\MicrosoftEdgeWebview2Setup.exe」を入れおくのはスマートでないと、
インストールをする必要がある場合に、MicrosoftEdgeWebview2Setup.exeをダウンロードすることにしました。
この方法だと、「\bin\MicrosoftEdgeWebview2Setup.exe」を同梱する必要はなくなりました。
以下、改修版 です。

//////  以下、Unit1本体  ///////
unit Unit1;

interface

uses Windows, SysUtils, Registry, Vcl.Dialogs, Vcl.Controls, Forms, UrlMon;

// UrlDownloadToFile関数を使いダウロード
function DownloadFile(SourceUrl, SaveFileName: string): Boolean;

// プログラムの実行をして、その終了を待つ
function WinExecAndWait32(FileName: string; Visibility: Integer): Longword;

// OSが32bitか64bitか
function Is64bitWindows: Boolean;
// レジストリーが存在するかどうか
function ExistRegKey(RegKey: String): Boolean;
// Microsoft WebView2 ランタイムのインストール
function InstallMicrosoftWebView2RunTime(): Boolean;

implementation

// UrlDownloadToFile関数を使いダウロード
// 成功:True 失敗:False
function DownloadFile(SourceUrl, SaveFileName: string): Boolean;
var
  Path: String;
begin
  Path := ExtractFilePath(SaveFileName);
  // フォルダがあるか確認
  // フォルダがない場合は作成
  if not DirectoryExists(Path) then
    ForceDirectories(Path);
  // ダウンロード
  try
    Result := UrlDownloadToFile(nil, PChar(SourceUrl), PChar(SaveFileName), 0,
      nil) = 0;
  except
    Result := False;
  end;
end;

// プログラムの実行をして、その終了を待つ
function WinExecAndWait32(FileName: string; Visibility: Integer): Longword;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;

if not CreateProcess(nil, PChar(FileName), // pointer to command line string
    nil, // pointer to process security attributes
    nil, // pointer to thread security attributes
    False, // handle inheritance flag
    CREATE_NEW_CONSOLE or // creation flags
    NORMAL_PRIORITY_CLASS, nil, // pointer to new environment block
    nil, // pointer to current directory name
    StartupInfo, // pointer to STARTUPINFO
    ProcessInfo) // pointer to PROCESS_INF
  then
    Result := WAIT_FAILED
  else
  begin
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end; { WinExecAndWait32 }

// OSが32bitか64bitか
function Is64bitWindows: Boolean;
var
  Wow64Proc: function(hProcess: THandle; var Wow64: BOOL): BOOL stdcall;
  RetFlag: LongBool;
begin
  // Windows Vista以上の場合
  @Wow64Proc := GetProcAddress(GetModuleHandle('Kernel32.dll'),
    'IsWow64Process');
  if @Wow64Proc <> nil then
  begin
    Wow64Proc(GetCurrentProcess, RetFlag);

if SizeOf(THandle) = 4 then
    begin
      Result := RetFlag;
    end
    else if SizeOf(THandle) = 8 then
    begin
      Result := True;
    end;
  end
  else
  begin
    // Windows XPの場合、64ビット版か
    Result := CheckWin32Version(5, 2);
  end;
end;

// レジストリーが存在し値が正常化どうか
// 検索する Rootkey は HKEY_LOCAL_MACHINE, HKEY_CURRENT_USER
function ExistRegKey(RegKey: String): Boolean;
var
  Reg: TRegistry;
  RegV: String;
begin
  Reg := TRegistry.Create;
  try
    Reg.Rootkey := HKEY_LOCAL_MACHINE;
    Result := Reg.OpenKey(RegKey, False);
    RegV := Reg.ReadString('pv');
    if Result = False then
    begin
      Reg.Rootkey := HKEY_CURRENT_USER;
      Result := Reg.OpenKey(RegKey, False);
      RegV := Reg.ReadString('pv');
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
    // pvが ''の場合は False
    // if RegV = '' then Result := False;
  end;
end;

// Microsoft WebView2 ランタイムのインストール
function InstallMicrosoftWebView2RunTime(): Boolean;
const
  RegKey1 = 'Software\Microsoft\EdgeUpdate\Clients\{F3017226-FE2A-4295-8BDF-00C3A9A7E4C5}';
  RegKey2 = 'SOFTWARE\WOW6432Node\Microsoft\EdgeUpdate\Clients\{F3017226-FE2A-4295-8BDF-00C3A9A7E4C5}';
var
  SourceUrl, PrgName, RegKey: String;
  function InstalledRunTime(): Boolean;
  var
    RegKey: String;
  begin
    if ExistRegKey(RegKey1) then
    begin
      Result := True;
    end
    else if ExistRegKey(RegKey2) then
    begin
      Result := True;
    end
    else
      Result := False;
  end;

begin
  // ラタイムがインストール済かどうか確認
  if InstalledRunTime() then
  begin
    Result := True;
    Exit;
  end
  else
  begin
    if MessageDlg('このプログラムでは、Webの表示に Microsoft WebView2 が必要です' + #13#10 +
      'Microsoft WebView2ランタイム をインストールをしてよろしいですか' + #13#10 + #13#10 + #13#10 +
      '管理者権限でないとインストールに失敗する場合があります' + #13#10 + '失敗した場合は、改めて管理者権限で実行してください',
      mtConfirmation, [mbYes, mbAbort], 0) = mrYes then
    begin
      PrgName := ExtractFilePath(Application.ExeName) +
        '\bin\MicrosoftEdgeWebview2Setup.exe';
      if not FileExists(PrgName) then
      begin
        // インストーラーをダウンロード
        SourceUrl := 'https://go.microsoft.com/fwlink/p/?LinkId=2124703';
        if not DownloadFile(SourceUrl, PrgName) then
        begin
          MessageDlg('ダウンロード失敗', mtWarning, [mbClose], 0);
          Exit;
        end
        else
        begin
          // インストールの実行をして終了を待つ
          WinExecAndWait32(PrgName, SW_SHOW);
          // インストールに成功したかどうか、レジストリーを確認
          if InstalledRunTime() then
          begin
            MessageDlg('インストール成功', mtInformation, [mbClose], 0);
            Result := True;
          end
          else
          begin
            MessageDlg('インストール失敗', mtWarning, [mbClose], 0);
            Result := False;
          end;
        end;
      end;
    end
    else // インストール中止
      Result := False;
  end;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る