Как узнать browser по умолчанию?

{
 First we create a temporary file and call the
 function FindExecutable to get the associated Application.
}


function GetAppName(Doc: string): string;
var
 FN, DN, RES: array[0..255] of char;
begin
 StrPCopy(FN, DOC);
 DN[0] := #0;
 RES[0] := #0;
 FindExecutable(FN, DN, RES);
 Result := StrPas(RES);
end;
function GetTempFile(const Extension: string): string;
var
 Buffer: array[0..MAX_PATH] of char;
 aFile: string;
begin
 GetTempPath(SizeOf(Buffer) - 1, Buffer);
 GetTempFileName(Buffer, 'TMP', 0, Buffer);
 SetString(aFile, Buffer, StrLen(Buffer));
 Result := ChangeFileExt(aFile, Extension);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 f: System.Text;
 temp: string;
begin
 // get a unique temporary file name
 // eine eindeutige Temporare Datei bekommen
 temp := GetTempFile('.htm');
 // Create the file
 // Datei erstellen
 AssignFile(f, temp);
 rewrite(f);
 closefile(f);
 // Show the path to the browser
 // Pfad + Programmname zum Browser anzeigen.
 ShowMessage(GetAppName(temp));
 // Finally delete the temporary file
 // Temporaare Datei wieder loschen
 Erase(f);
end;

//Using the Registry:
//************************************************
uses
 Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
 Reg: TRegistry;
 KeyName: string;
 ValueStr: string;
begin
 Reg := TRegistry.Create;
 try
  Reg.RootKey := HKEY_CLASSES_ROOT;
  KeyName := 'htmlfile\shell\open\command';
  if Reg.OpenKey(KeyName, False) then
  begin
  ValueStr := Reg.ReadString('');
  Reg.CloseKey;
  ShowMessage(ValueStr);
  end
  else
  ShowMessage('There is nоt a default browser');
 finally
  Reg.Free;
 end;
end;

//************************************************
{Copyright (c) by Code Central}
type
 TBrowserInformation = record
  Name: string;
  Path: string;
  Version: string;
 end;
function LongPathName(ShortPathName: string): string;
var
 PIDL: PItemIDList;
 Desktop: IShellFolder;
 WidePathName: WideString;
 AnsiPathName: AnsiString;
begin
 Result := ShortPathName;
 if Succeeded(SHGetDesktopFolder(Desktop)) then
 begin
  WidePathName := ShortPathName;
  if Succeeded(Desktop.ParseDisplayName(0, nil, PWideChar(WidePathName),
  ULONG(nil^), PIDL, ULONG(nil^))) then
  try
  SetLength(AnsiPathName, MAX_PATH);
  SHGetPathFromIDList(PIDL, PChar(AnsiPathName));
  Result := PChar(AnsiPathName);
  finally
  CoTaskMemFree(PIDL);
  end;
 end;
end;
function GetDefaultBrowser: TBrowserInformation;
var
 tmp: PChar;
 res: LPTSTR;
 Version: Pointer;
 VersionInformation: Pointer;
 VersionInformationSize: Integer;
 Dummy: DWORD;
begin
 tmp := StrAlloc(255);
 res := StrAlloc(255);
 Version := nil;
 try
  GetTempPath(255, tmp);
  if FileCreate(tmp + 'htmpl.htm') <> -1 then
  begin
  if FindExecutable('htmpl.htm', tmp, res) > 32 then
  begin
  Result.Name := ExtractFileName(res);
  Result.Path := LongPathName(ExtractFilePath(res));
  // Try to determine the Browser Version
  VersionInformationSize := GetFileVersionInfoSize(Res, Dummy);
  if VersionInformationSize > 0 then
  begin
  GetMem(VersionInformation, VersionInformationSize);
  GetFileVersionInfo(Res, 0, VersionInformationSize, VersionInformation);
  VerQueryValue(VersionInformation, ('StringFileInfo040904E4ProductVersion'),
  Pointer(Version), Dummy);
  if Version <> nil then
  Result.Version := PChar(Version);
  FreeMem(VersionInformation);
  end;
  end
  else
  ShowMessage('Cannot determine the executable.');
  SysUtils.DeleteFile(tmp + 'htmpl.htm');
  end
  else
  ShowMessage('Cannot create temporary file.');
 finally
  StrDispose(tmp);
  StrDispose(res);
 end;
end;

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...