unit Browsers;
{
[Browsers] [1.1]
Delphi 2005
December 2005

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[browsers.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005 Martin Holmes 
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
 This unit written by Martin Holmes, September 2005.

 The main purpose of the unit is to find and identify the most recent versions of
 various Web browsers on Windows, so that files can be opened in them. This is
 required for (for example) preferentially opening a Web page in a Mozilla browser
 because it has better support for standards, ensuring an XML page can be opened
 in a browser that supports XSLT transformations, finding a browser with SVG support,
 and so on.

 These routines are based on common-sense and practical observations of data stored in
 the registry and elsewhere. It is rarely based on documentation of the target browsers,
 which is unreliable if it exists.
 
}
interface

uses Classes, SysUtils, Registry, Windows, WideStrUtils, ShellAPI, StrUtils,
OLEAuto, Variants, Dialogs;

function FindFirefox(var BrowserPath, FullVersionInfo: WideString): Single;
//returns a float with the version number (major + minor), or -1 if not found.

function FindFirefoxHTMLCommand(var FFCommand: string): Boolean;
//returns true if found

function MDHGetFileVersion(var MajMinVersion: Single; const FileName: WideString;
  const Fmt: string = '%d.%d.%d.%d'): string;
//General-purpose routine for getting version info for a file

function GetLongFileName(WShortName: WideString): WideString;
//finds the full file name based on a shortened 8.3 name
//Delphi doesn't provide this, although it provides the opposite in ExtractShortPathName.

procedure OpenInternetExplorer(wsURL : WideString);
//This function taken from an old Web tip here:
//http://www.chami.com/tips/delphi/110396D.html

implementation

function FindFirefox(var BrowserPath, FullVersionInfo: WideString): Single;
var
RegIni: TRegIniFile;
i: integer;
sgTemp: Single;

begin
  Result := -1; //default return
  BrowserPath := ''; //default
  FullVersionInfo := '0.0.0.0'; //default;
  RegIni := TRegIniFile.Create;
  try
//First, let's try reading from the HKEY_CURRENT_USER
    RegIni.RootKey := HKEY_CURRENT_USER;
    FullVersionInfo := RegIni.ReadString('Software\Mozilla\Mozilla Firefox', 'CurrentVersion', '');
    if FullVersionInfo <> '' then
      begin
        BrowserPath := RegIni.ReadString('Software\Mozilla\Mozilla Firefox\' + FullVersionInfo +
                                        '\' + 'Main',
                                        'PathToExe', '');
        if FileExists(BrowserPath) then
          begin
            Result := StrToFloatDef(Copy(FullVersionInfo, 1,
                                    PosEx('.', FullVersionInfo, Pos('.', FullVersionInfo))-1),
                                     0);
            FullVersionInfo := MDHGetFileVersion(sgTemp, BrowserPath, '%d.%d.%d.%d');
            if sgTemp > Result then
              Result := sgTemp;
            Exit;
          end;
      end;

//Try the root key
    RegIni.RootKey := HKEY_CLASSES_ROOT;
    BrowserPath := RegIni.ReadString('Applications\FIREFOX.EXE\shell\open\command', '', '');
    if Length(BrowserPath) > 1 then
      begin
        i := Pos('FIREFOX.EXE', WideUpperCase(BrowserPath));
//strip off the command line parameters
        BrowserPath := Copy(BrowserPath, 1, i+11);
        if FileExists(BrowserPath) then
          begin
            BrowserPath := GetLongFileName(BrowserPath);  //This setting is a short name in my experience
            Result := 0; //default meaning exe found but no version known yet
            FullVersionInfo := MDHGetFileVersion(sgTemp, BrowserPath, '%d.%d.%d.%d');
            if sgTemp > Result then
              Result := sgTemp;
            Exit;
          end;
      end;

//Finally, try local machine hive
    RegIni.RootKey := HKEY_LOCAL_MACHINE;
    BrowserPath := RegIni.ReadString('SOFTWARE\Applications\FIREFOX.EXE\shell\open\command', '', '');
    if Length(BrowserPath) > 1 then
      begin
        i := Pos('FIREFOX.EXE', WideUpperCase(BrowserPath));
//strip off the command line parameters
        BrowserPath := Copy(BrowserPath, 1, i+11);
        if FileExists(BrowserPath) then
          begin
            BrowserPath := GetLongFileName(BrowserPath);  //This setting is a short name in my experience
            Result := 0; //default meaning exe found but no version known yet
            FullVersionInfo := MDHGetFileVersion(sgTemp, BrowserPath, '%d.%d.%d.%d');
            if sgTemp > Result then
              Result := sgTemp;
            Exit;
          end;
      end;
  finally
    RegIni.Free;
  end;
end;

function FindFirefoxHTMLCommand(var FFCommand: string): Boolean;
var
RegIni: TRegIniFile;

  function TryRegLookup(TheRootKey: HKEY; Path: WideString): WideString;
  begin
    RegIni.RootKey := TheRootKey;
    Result := RegIni.ReadString(Path, '', '');
  end;

begin
  Result := False; //default
  RegIni:= TRegIniFile.Create(HKEY_CURRENT_USER);
  try
    FFCommand := TryRegLookup(HKEY_CLASSES_ROOT, 'Applications\FIREFOX.EXE\shell\open\command');
    if Length(FFCommand) < 1 then
      FFCommand := TryRegLookup(HKEY_CLASSES_ROOT, 'FirefoxHTML\shell\open\command');
    if Length(FFCommand) < 1 then
      FFCommand := TryRegLookup(HKEY_LOCAL_MACHINE, 'Software\Classes\Applications\FIREFOX.EXE\shell\open\command');
    if Length(FFCommand) < 1 then
      FFCommand := TryRegLookup(HKEY_LOCAL_MACHINE, 'Software\Classes\FirefoxHTML\shell\open\command');

    Result := (Length(FFCommand) > 0);
  finally
    RegIni.Free;
  end;
end;


function MDHGetFileVersion(var MajMinVersion: Single; const FileName: WideString;
                           const Fmt: string = '%d.%d.%d.%d'): string;
var
  iBufferSize: DWORD;
  iDummy: DWORD;
  pBuffer: Pointer;
  pFileInfo: Pointer;
  iVer: Array[1..4] of Word;
begin
  // set default value
  Result := '';
  MajMinVersion := 0; //default return
  // get size of version info (0 if no version info exists)
  iBufferSize := GetFileVersionInfoSize(PChar(FileName), iDummy);
  if (iBufferSize > 0) then
  begin
    GetMem(pBuffer, iBufferSize);
    try
    // get fixed file info
    GetFileVersionInfo(PChar(FileName), 0, iBufferSize, pBuffer);
    VerQueryValue(pBuffer, '\', pFileInfo, iDummy);
    // read version blocks
    iVer[1] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
    iVer[2] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
    iVer[3] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
    iVer[4] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
    finally
      FreeMem(pBuffer);
    end;
    MajMinVersion := iVer[1] + (iVer[2]/10);
    // format result string
    Result := Format(Fmt, [iVer[1], iVer[2], iVer[3], iVer[4]]);
  end;
end;

function GetLongFileName(WShortName: WideString): WideString;
var
ShortName: string;
LastSlash, PathPtr: PChar;

  function ExtractLongFileName(const FileName: string): string;
  var
    Info: TSHFileInfo;
  begin
    if SHGetFileInfo(PChar(FileName), 0, Info, Sizeof(Info), SHGFI_DISPLAYNAME) <> 0 then
      Result := string(Info.szDisplayName)
    else
      Result := FileName;
  end;

begin
  ShortName := string(WShortName);
  Result := '';
  PathPtr := PChar(ShortName);
  LastSlash := StrRScan(PathPtr, '\');
  while LastSlash <> nil do
    begin
      Result := '\' + ExtractLongFileName(PathPtr) + Result;
      if LastSlash <> nil then
        begin
          LastSlash^ := #0;
          LastSlash := StrRScan(PathPtr, '\');
        end;
    end;
  Result := PathPtr + Result;
end;

//This function taken from an old Web tip here:
//http://www.chami.com/tips/delphi/110396D.html
procedure OpenInternetExplorer(wsURL : WideString);
const
  csOLEObjName = 'InternetExplorer.Application';
var
IE: Variant;
WinHanlde: HWnd;
begin
  if (VarIsEmpty(IE)) then
    begin
      IE := CreateOleObject(csOLEObjName);
      IE.Visible := true;
      IE.Navigate(wsURL);
    end
  else
    begin
      WinHanlde := FindWIndow('IEFrame', nil);
      if (0 <> WinHanlde)then
        begin
          IE.Navigate(wsURL);
          SetForegroundWindow(WinHanlde);
        end
      else
        begin
          // handle error ...
        end;
    end;
end;

end.