前回の「TEdgeBrowserへの移行について(参考になれば)」で紹介しましたユニットにバグがありました。
前回のプログラムでは、「インストーラはダウンロード済み」「ランタイムはなしインストール」場合に、インストールをしません。
結果、一度ランタイムをインストールしてアンインストール場合の再インストールを実行しないで終了します。
前の続きでは長くなるので、新規で質問項目を起こしました。
以下をご利用ください。
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);
Result := False;
Exit;
end
end;
// インストールの実行をして終了を待つ
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
else // インストール中止
Result := False;
end;
end;
end.
とりあえずこの件につきましては、完 とします。
すみません。日本語が変でした。 読み返さずに送信してしまいました。
以下、訂正です。
前回の「TEdgeBrowserへの移行について(参考になれば)」で紹介しましたユニットにバグがありました。
前回のプログラムでは、「インストーラはダウンロード済み」「ランタイムはなし」の場合に、インストールをしません。
結果、一度ランタイムをインストールしてアンインストールした場合の再インストールを実行しないで終了します。
ツイート | ![]() |