解决 Delphi 程序在不同操作系统中 ShellExecute 调用 Chrome.exe 偶尔无效的问题

解决 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 。


欢迎分享,(木庄网络博客交流QQ群:562366239

打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论