解决 Delphi 程序在不同操作系统中 ShellExecute 调用 Chrome.exe 偶尔无效的问题:
//需var 一个temp变量,用来接收打开外部程序的结果
temp := ShellExecute(handle, 'open', 'chrome.exe',
PChar(OpenUrl + SessionID), nil, SW_SHOWNORMAL);
//若结果小于32则说明打开失败
if temp <= 32 then
begin
// 使用注册表
openDic := GetSOFTWAREClasses;
if openDic.Length > 0 then
begin
temp := ShellExecute(handle, 'open', PWideChar(openDic),
PChar(OpenUrl + SessionID), nil, SW_SHOWNORMAL);
end;
end;
if temp <= 32 then
begin
//使用Application路径
temp := ShellExecute(handle, 'open',
PWideChar(GetEnvironmentVariable('USERPROFILE') +
'\Local Settings\Application Data\Google\Chrome\Application\chrome.exe'),
PChar(OpenUrl + SessionID), nil, SW_SHOWNORMAL);
end;
if temp <= 32 then
begin
//使用win7-win10-Application路径
temp := ShellExecute(handle, 'open',
PWideChar(GetEnvironmentVariable('USERPROFILE') +
'\AppData\Local\Google\Chrome\Application\chrome.exe'),
PChar(OpenUrl + SessionID), nil, SW_SHOWNORMAL);
end;
if temp <= 32 then
begin
//最后实在打不开了就使用默认浏览器打开
ShellExecute(handle, nil, PChar(OpenUrl + SessionID), nil, nil,
SW_SHOWNORMAL);
end;
GetSOFTWAREClasses 方法:
function GetSOFTWAREClasses: String;
var
list, softList: TStringList;
Reg: TRegistry;
FPath, FKey, SubString, str: String;
i: integer;
match: TMatch;
begin
FPath := 'SOFTWARE\Classes';
FKey := '';
list := TStringList.Create;
softList := TStringList.Create;
Reg := TRegistry.Create;
str := '';
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
If Reg.OpenKey(FPath, False) then
Reg.GetKeyNames(list);
list.Sort;
list.BeginUpdate;
Reg.CloseKey;
// If Reg.OpenKey(FPath, False) then
// Form1.Memo1.Lines.Add(list[0]);
// Edit1.Text := Reg.ReadString('DriverDesc');
Reg.CloseKey;
for i := 0 to list.Count - 1 do
begin
if Pos('ChromeHTML', list[i]) > 0 then
begin
FPath := 'SOFTWARE\Classes\' + list[i] + '\shell\open\command';
if (Reg.OpenKey(FPath, False)) and (Reg.ReadString(FKey) <> '') then
begin;
match := TRegEx.match(Reg.ReadString(FKey),
'(?<=").*?(?<=.chrome.exe)');
if match.Success then
begin
str := match.Value;
end;
end;
Reg.CloseKey;
break;
end;
end;
finally
Reg.Free;
end;
Result := str;
end;
其中注册表需引用 Registry, 正则需引用 RegularExpressions 。
相关阅读 >>
Delphi tnethttpclient https忽略证书验证
Delphi 如何解决在dll的入口函数中创建或结束线程时卡死
更多相关阅读请进入《Delphi》频道 >>