LclIntf: Fix OpenURL for file:// scheme with a local anchor (e.g. file://c:/foo.html#bar) on Windows. Issue #0030326.

git-svn-id: trunk@52606 -

lcl/include/sysenvapis.inc

@@ -1,43 +1,38 @@
 {%MainUnit ../lclintf.pas}
 
 // Locates the default browser associated in the system
-function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;
-
-  function Find(const ShortFilename: String; out ABrowser: String): Boolean; inline;
-  begin
-    ABrowser := SearchFileInPath(ShortFilename + GetExeExt, '',
-                      GetEnvironmentVariableUTF8('PATH'), PathSeparator,
-                      [sffDontSearchInBasePath]);
-    Result := ABrowser <> '';
-  end;
 
+function FindBrowserExecutable(const ShortFilename: String; out ABrowser: String): Boolean; inline;
 begin
-  {$IFDEF MSWindows}
+  ABrowser := SearchFileInPath(ShortFilename + GetExeExt, '',
-  Find('rundll32', ABrowser);
+                    GetEnvironmentVariableUTF8('PATH'), PathSeparator,
-  AParams := 'url.dll,FileProtocolHandler %s';
+                    [sffDontSearchInBasePath]);
-  {$ELSE}
+  Result := (ABrowser <> '');
-    {$IFDEF DARWIN}
-    // open command launches url in the appropriate browser under Mac OS X
-    Find('open', ABrowser);
-    AParams := '"%s"';
-    {$ELSE}
-      ABrowser := '';
-    {$ENDIF}
-  {$ENDIF}
-  if ABrowser = '' then
-  begin
-    AParams := '"%s"';
-    // Then search in path. Prefer open source ;)
-    if Find('xdg-open', ABrowser)  // Portland OSDL/FreeDesktop standard on Linux
-    or Find('htmlview', ABrowser)  // some redhat systems
-    or Find('firefox', ABrowser)
-    or Find('mozilla', ABrowser)
-    or Find('galeon', ABrowser)
-    or Find('konqueror', ABrowser)
-    or Find('safari', ABrowser)
-    or Find('netscape', ABrowser)
-    or Find('opera', ABrowser)
-    or Find('iexplore', ABrowser) then ;// some windows systems
-  end;
-  Result := ABrowser <> '';
 end;
+
+const
+  PredefinedBrowserStrings: array[1..10] of String = (
+    'xdg-open',
+    'htmlview',
+    'firefox',
+    'mozilla',
+    'galeon',
+    'konqueror',
+    'safari',
+    'netscape',
+    'opera',
+    'iexplore'
+  );
+
+function FindPredefinedBrowser(out ABrowser, AParams: String): Boolean;
+var
+  i: Integer;
+begin
+  ABrowser := '';
+  AParams := '"%s"';
+  for i := Low(PredefinedBrowserStrings) to High(PredefinedBrowserStrings) do
+    if FindBrowserExecutable(PredefinedBrowserStrings[i], ABrowser) then Break;
+  Result := (ABrowser <> '');
+end;
+
+

lcl/include/sysenvapis_mac.inc

@@ -1,5 +1,18 @@
 {%MainUnit ../lclintf.pas}
 
+
+function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;
+begin
+  // open command launches url in the appropriate browser under Mac OS X
+  FindBrowserExecutable('open', ABrowser);
+  AParams := '"%s"';
+  Result := (ABrowser <> '');
+  if not Result then
+  begin
+    Result := FindPredefinedBrowser(ABrowser, AParams);
+  end;
+end;
+
 // Open a given URL with the default browser
 function OpenURL(AURL: String): Boolean;
 var

lcl/include/sysenvapis_unix.inc

@@ -1,5 +1,11 @@
 {%MainUnit ../lclintf.pas}
 
+
+function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;
+begin
+  Result := FindPredefinedBrowser(ABrowser, AParams);
+end;
+
 // Open a given URL with the default browser
 function OpenURL(AURL: String): Boolean;
 var

lcl/include/sysenvapis_win.inc

@@ -1,6 +1,158 @@
 {%MainUnit ../lclintf.pas}
 
-// Open a given URL with the default browser
+{$I ../../components/lazutils/lazutils_defines.inc} //LCL depends on LazUtils, so this is OK
+
+{$IFnDEF WinCE}
+function AssocQueryStringW(Flags: Integer; Str: Integer; pszAssoc, pszExtra, pszOut: PWChar;
+  var pcchOut: DWORD): HRESULT; stdcall; external 'shlwapi.dll' name 'AssocQueryStringW';
+
+function AssocQueryStringA(Flags: Integer; Str: Integer; pszAssoc, pszExtra, pszOut: PChar;
+  var pcchOut: DWORD): HRESULT; stdcall; external 'shlwapi.dll' name 'AssocQueryStringA';
+
+function GetDefaultBrowserWide: WideString;
+const
+  ASSOCF_NOTRUNCATE = $00000020;
+  ASSOCSTR_EXECUTABLE = 2;
+  Extension = '.htm';
+var
+  BufSize: DWORD;
+begin
+  BufSize := MAX_PATH;
+  SetLength(Result, BufSize);
+  if AssocQueryStringW(ASSOCF_NOTRUNCATE, ASSOCSTR_EXECUTABLE, PWChar(Extension), 'open', PWChar(Result), BufSize) = S_OK then
+    SetLength(Result, BufSize - 1)
+  else
+    Result := '';
+end;
+
+function GetDefaultBrowserAnsi: AnsiString;
+const
+  ASSOCF_NOTRUNCATE = $00000020;
+  ASSOCSTR_EXECUTABLE = 2;
+  Extension = '.htm';
+var
+  BufSize: DWORD;
+begin
+  BufSize := MAX_PATH;
+  SetLength(Result, BufSize);
+  if AssocQueryStringA(ASSOCF_NOTRUNCATE, ASSOCSTR_EXECUTABLE, PChar(Extension), 'open', PChar(Result), BufSize) = S_OK then
+    SetLength(Result, BufSize - 1)
+  else
+    Result := '';
+end;
+{$ENDIF WinCE}
+
+function FindDefaultBrowserAnsi(out ABrowser, AParams: String): Boolean;
+begin
+  ABrowser := '';
+  {$IFnDEF WinCE}
+  ABrowser := GetDefaultBrowserAnsi;
+  AParams := '"%s"';
+  if (ABrowser = '') then
+  begin
+    if FindBrowserExecutable('rundll32', ABrowser) then
+      AParams := 'url.dll,FileProtocolHandler %s';
+  end;
+  {$ENDIF}
+  Result := (ABrowser <> '');
+  if not Result then
+  begin
+    Result := FindPredefinedBrowser(ABrowser, AParams);
+  end;
+end;
+
+function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;
+begin
+  Result := FindDefaultBrowserAnsi(ABrowser, AParams);
+end;
+
+function FindDefaultBrowserWide(out ABrowser, AParams: WideString): Boolean;
+var
+  AnsiBrowser, AnsiParams: String;
+begin
+  ABrowser := '';
+  {$IFnDEF WinCE}
+  ABrowser := GetDefaultBrowserWide;
+  AParams := '"%s"';
+  if (ABrowser = '') then
+  begin
+    if FindBrowserExecutable('rundll32', AnsiBrowser) then
+    begin
+      AParams := 'url.dll,FileProtocolHandler %s';
+      {$IFnDEF ACP_RTL}
+      ABrowser := Utf8ToUTF16(AnsiBrowser);
+      {$else}
+      ABrowser := WideString(AnsiBrowser);
+      {$ENDIF ACP_RTL}
+    end;
+  end;
+  {$ENDIF}
+  Result := (ABrowser <> '');
+  if not Result then
+  begin
+    Result := FindPredefinedBrowser(AnsiBrowser, AnsiParams);
+    if Result then
+    begin
+      {$IFnDEF ACP_RTL}
+      ABrowser := Utf8ToUtf16(AnsiBrowser);
+      AParams := Utf8ToUtf16(AnsiParams);
+      {$else}
+      ABrowser := WideString(AnsiBrowser);
+      AParams := WideString(AnsiParams);
+      {$ENDIF ACP_RTL}
+    end;
+  end;
+end;
+
+
+function FindDefaultBrowserAndOpenUrl(AURL: String): Boolean;
+var
+  ABrowser, AParams: WideString;
+  H: HINST;
+  AParamsUtf8: String;
+begin
+  Result := False;
+  if AURL = '' then Exit;
+  if FindDefaultBrowserWide(ABrowser, AParams)then
+  begin
+    if (Pos('%s', AParams) > 0) then
+    begin
+      {$IFnDEF ACP_RTL}
+      AParamsUtf8 := Utf16ToUtf8(AParams);
+      {$ELSE}
+      AParamsUtf8 := AParams;
+      {$ENDIF ACP_RTL}
+      AParamsUtf8 := Format(AParamsUtf8,[AURL]);
+      {$IFnDEF ACP_RTL}
+      AParams := Utf8ToUtf16(AParamsUtf8);
+      {$ELSE}
+      AParams := WideString(AParamsUtf8);
+      {$ENDIF ACP_RTL}
+    end
+    else
+      {$IFnDEF ACP_RTL}
+      AParams := Utf8ToUtf16(AURL);
+      {$ELSE}
+      AParams := WideString(AURL);
+      {$ENDIF ACP_RTL}
+    //this happens if ABrowser is rundll.exe
+    if (Pos(#32, AParams) > 0) and (AParams[1] <> '"')
+      then AParams := '"' + AParams + '"';
+    H := ShellExecuteW(0, 'open', PWChar(ABrowser), PWChar(AParams), nil, SW_SHOWNORMAL);
+  end
+  else
+  begin
+    {$IFnDEF ACP_RTL}
+    AParams := Utf8ToUtf16(AURL);
+    {$ELSE}
+    AParams := WideString(AURL);
+    {$ENDIF ACP_RTL}
+    H := ShellExecuteW(0, nil, PWideChar(AParams), nil, nil, SW_SHOWNORMAL) ;
+  end;
+  Result := (H > 32);
+end;
+
+// Open a given URL with whatever Windows thinks is appropriate
 function OpenURL(AURL: String): Boolean;
 var
 {$IFDEF WinCE}
@@ -8,9 +160,26 @@ var
 {$ELSE}
   ws: WideString;
   ans: AnsiString;
-  IsFileUriWithSpaces: Boolean;
+  IsFileUriWithSpaces, IsFileURI: Boolean;
 const
   FileURIScheme = 'file://';
+
+  function IsHtmlWithAnchor(S: String): Boolean;
+  var
+    AnchorPos, HtmlPos: SizeInt;
+  begin
+    Result := False;
+    //Anchor will be defined by last '#' in AURL;
+    AnchorPos := Length(AURL);
+    while (AnchorPos < 0) and (S[AnchorPos] <> '#') do Dec(AnchorPos);
+    if (AnchorPos > 0) then
+    begin
+      S := UpperCase(S); //don't care about UTF8
+      HtmlPos := Pos('.HTM', S);
+      if (HtmlPos = 0) then HtmlPos := Pos('.HTML', S);
+      Result := (HtmlPos > 0) and (AnchorPos > HtmlPos);
+    end;
+  end;
 {$ENDIF}
 begin
   Result := False;
@@ -23,20 +192,22 @@ begin
   Info.lpFile := PWideChar(UTF8Decode(AURL));
   Result := ShellExecuteEx(@Info);
   {$ELSE}
-  if Win32Platform = VER_PLATFORM_WIN32_NT then
+  IsFileURI := (CompareText(Copy(AURL,1,Length(FileURIScheme)), FileURIScheme) = 0);
+  //Html FileURI's that have a local anchor cannot be opened via a direct call to ShellExecute,
+  //in that case we need to find the actual default browser and execute that.
+  //Notice that this will still fail to open the html at the correct anchor
+  //if FindDefaultBrowserWide returns 'rundll.exe'
+  //See: issue #0030326 and related
+  if IsFileURI and IsHtmlWithAnchor(AURL) then
+    Result := FindDefaultBrowserAndOpenURL(AURL)
+  else
   begin
-    //Urls that start with file:// are allowed to contain spaces and should be quoted on NT platform,
+    //Urls that start with file:// are allowed to contain spaces and should be quoted
-    //but on Win9x quoting it fails
     //Since on Windows filenames cannot contain the " character, we need not care about it and simply enclose the AURL
-    IsFileUriWithSpaces := (Pos(#32,AURL) > 0) and (CompareText(Copy(AURL,1,Length(FileURIScheme)), FileURIScheme) = 0);
+    IsFileUriWithSpaces := IsFileURI and (Pos(#32,AURL) > 0);
     if IsFileUriWithSpaces then AURL := '"' + AURL + '"';
     ws := UTF8Decode(AURL);
     Result := ShellExecuteW(0, nil, PWideChar(ws), nil, nil, SW_SHOWNORMAL) > 32;
-  end
-  else
-  begin
-    ans := Utf8ToAnsi(AURL); // utf8 must be converted to Windows Ansi-codepage
-    Result := ShellExecute(0, nil, PAnsiChar(ans), nil, nil, SW_SHOWNORMAL) > 32;
   end;
   {$ENDIF}
 end;