RAD Studio My sample to RUN your Browser favorite to open your webpage in RAD Studio Delphi

emailx45

BANNED
Регистрация
5 Май 2008
Сообщения
3,582
Реакции
2,451
Credits
578
My sample to RUN your Browser favorite to open your webpage in RAD Studio Delphi
by Emailx45
  • Scenary:
    • MSWIndows 10 Enterprise, build 1909
    • RAD Studio 10.3.3. Arch
    • VCL project for tests
[SHOWTOGROUPS=4,20,22]
Run-My-Browser-001.png


Код:
unit uFormMain;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btnRUN_my_Browser: TButton;
    ListBox1: TListBox;
    btnHow_Many_Browsers_I_Have: TButton;
    Memo1: TMemo;
    procedure btnRUN_my_BrowserClick(Sender: TObject);
    procedure btnHow_Many_Browsers_I_HaveClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Winapi.ShellApi,
  System.Win.Registry;

// ReportMemoryLeaksOnShutdown on DPR for "memory leaks test"

{ Open command:
  Computador\HKEY_LOCAL_MACHINE\SOFTWARE\Clients\StartMenuInternet\Chrome\shell\open
  default param -> "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
}

const
  lMyKeyRoot: string     = '\SOFTWARE\Clients\StartMenuInternet'; // where the browser "save" your install references
  lMyOpenCommand: string = '\shell\open\command';

var
  lMyStringsCommand: TStrings;
  lRunMyBrowser    : PChar;
  lOpenWebPage     : PChar;

procedure TForm1.btnRUN_my_BrowserClick(Sender: TObject);
begin
  // lOpenWebPage := PChar('microsoft-edge:www.uol.com.br'); // using protocols!
  //
  lOpenWebPage := PChar('https://community.idera.com/developer-tools/programming-languages/f/delphi-language');
  //
  if not(Trim(lRunMyBrowser) = '') then
  begin
    ShellExecute(handle, 'open', lRunMyBrowser, lOpenWebPage, nil, SW_SHOWNORMAL);
  end
  else
    ShowMessage('The path of Browser not defined');
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
  //
  if (lMyStringsCommand.Count >= ListBox1.ItemIndex) then
  begin
    lRunMyBrowser := PChar(lMyStringsCommand[ListBox1.ItemIndex]);
    Memo1.Lines.Add(lMyStringsCommand[ListBox1.ItemIndex]);
  end;
end;

procedure prcMyBrowsersInstalled(lMyBrowsers: TStrings);
var
  lMyReg   : TRegistry;
  lRKeyInfo: TRegKeyInfo;
  i        : Integer;
  lTextTmp : string;
begin
  lMyReg        := TRegistry.Create;
  lMyReg.Access := KEY_READ;
  //
  try
    lMyReg.RootKey := HKEY_LOCAL_MACHINE; // where the browser "save" your install references
    //
    if lMyReg.KeyExists(lMyKeyRoot) then
    begin
      try
        if not lMyReg.OpenKey(lMyKeyRoot, false) then
          raise Exception.Create('ListRegisteredBrowsers: Could not open registry key.');
        //
        if not lMyReg.GetKeyInfo(lRKeyInfo) then // maybe, need Admin user privilegies!
          raise Exception.Create('ListRegisteredBrowsers: Could not obtain registry key information.');
        //
        lMyReg.GetKeyNames(lMyBrowsers); // this it's enough to "catch" the KeyNames
        //
        lMyStringsCommand.Clear;
        //
        for i := 0 to Pred(lMyBrowsers.Count) do // lRKeyInfo.NumSubKeys = how many browsers?
        begin
          if lMyReg.OpenKey(lMyKeyRoot + '\' + lMyBrowsers[i] + lMyOpenCommand, false) then
          begin
            lTextTmp := StringReplace(lMyReg.GetDataAsString('', false), '"', '', [rfReplaceAll]).Trim;
            // lTextTmp := lMyReg.CurrentPath + '=' + lTextTmp;
            //
            lMyStringsCommand.Add(lTextTmp);
          end;
        end;
      except
        on E: Exception do
          ShowMessage('My Error: ' + sLineBreak + E.Message);
      end;
    end;
  finally
    lMyReg.CloseKey;
    lMyReg.Free;
  end;
end;

procedure TForm1.btnHow_Many_Browsers_I_HaveClick(Sender: TObject);
begin
  ListBox1.Items.Clear;
  //
  prcMyBrowsersInstalled(ListBox1.Items);
end;

initialization

lMyStringsCommand := TStringList.Create;

finalization

lMyStringsCommand.Free;

end.
[/SHOWTOGROUPS]