lcl: add FindDefaultBrowser and OpenURL functions to LCLProc

git-svn-id: trunk@22017 -

lcl/lazhelphtml.pas

@@ -382,56 +382,20 @@ begin
   end;
 end;
 
-procedure THTMLBrowserHelpViewer.FindDefaultBrowser(var Browser,
-  Params: string);
-
-  function Find(const ShortFilename: string): boolean;
-  var
-    Filename: String;
-  begin
-    Filename:=SearchFileInPath(ShortFilename+GetExeExt,'',
-                      GetEnvironmentVariableUTF8('PATH'),PathSeparator,
-                      [sffDontSearchInBasePath]);
-    Result:=Filename<>'';
-    if Result then begin
-      FDefaultBrowser:=Filename;
-      FDefaultBrowserParams:='%s';
-    end;
-  end;
-
+procedure THTMLBrowserHelpViewer.FindDefaultBrowser(var Browser, Params: string);
 begin
-  if FDefaultBrowser='' then begin
+  if FDefaultBrowser='' then
+  begin
     if Assigned(OnFindDefaultBrowser) then
       OnFindDefaultBrowser(FDefaultBrowser, FDefaultBrowserParams);
   end;
-  if FDefaultBrowser='' then begin
-    {$IFDEF MSWindows}
-    FDefaultBrowser:= SearchFileInPath('rundll32.exe','',
-                             GetEnvironmentVariableUTF8('PATH'),';',
-                             [sffDontSearchInBasePath]);
-    FDefaultBrowserParams:='url.dll,FileProtocolHandler %s';
-    {$ENDIF}
-    {$IFDEF DARWIN}
-    // open command launches url in the appropriate browser under Mac OS X
-    Find('open');
-    {$ENDIF}
-  end;
-  if FDefaultBrowser='' then begin
-    // Then search in path. Prefer open source ;)
-    if Find('xdg-open')  // Portland OSDL/FreeDesktop standard on Linux
-    or Find('htmlview')  // some redhat systems
-    or Find('firefox')
-    or Find('mozilla')
-    or Find('galeon')
-    or Find('konqueror')
-    or Find('safari')
-    or Find('netscape')
-    or Find('opera')
-    or Find('iexplore') then ;// some windows systems
-  end;
-  Browser:=FDefaultBrowser;
-  Params:=FDefaultBrowserParams;
-  DebugLn('THTMLBrowserHelpViewer.FindDefaultBrowser Browser=',Browser,' Params=',Params);
+  if FDefaultBrowser = '' then
+    LCLProc.FindDefaultBrowser(FDefaultBrowser, FDefaultBrowserParams);
+
+  Browser := FDefaultBrowser;
+  Params := FDefaultBrowserParams;
+
+  //DebugLn('THTMLBrowserHelpViewer.FindDefaultBrowser Browser=',Browser,' Params=',Params);
 end;
 
 procedure THTMLBrowserHelpViewer.Assign(Source: TPersistent);

lcl/lclproc.pas

@@ -31,7 +31,7 @@ interface
 
 uses
   {$IFDEF Darwin}MacOSAll, {$ENDIF}
-  Classes, SysUtils, Math, TypInfo, Types, FPCAdds, AvgLvlTree, FileUtil,
+  Classes, SysUtils, Math, TypInfo, Types, FPCAdds, AvgLvlTree, FileUtil, UTF8Process,
   LCLStrConsts, LCLType, WSReferences
   {$IFNDEF DisableCWString}{$ifdef unix}{$ifndef DisableIconv}, cwstring{$endif}{$endif}{$ENDIF}
   ;
@@ -353,6 +353,9 @@ procedure LCLGetLanguageIDs(var Lang, FallbackLang: String);
 function CreateFirstIdentifier(const Identifier: string): string;
 function CreateNextIdentifier(const Identifier: string): string;
 
+// URL opening
+function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;
+function OpenURL(AURL: String): Boolean;
 
 implementation
 
@@ -4294,6 +4297,66 @@ begin
           +IntToStr(1+StrToIntDef(copy(Identifier,p+1,length(Identifier)-p),0));
 end;
 
+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;
+
+begin
+  {$IFDEF MSWindows}
+  Find('rundll32', ABrowser);
+  AParams := 'url.dll,FileProtocolHandler %s';
+  {$ELSE}
+    {$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;
+
+function OpenURL(AURL: String): Boolean;
+var
+  ABrowser, AParams: String;
+  BrowserProcess: TProcessUTF8;
+begin
+  Result := FindDefaultBrowser(ABrowser, AParams) and FileExistsUTF8(ABrowser) and FileIsExecutable(ABrowser);
+  if not Result then
+    Exit;
+
+  // run
+  BrowserProcess := TProcessUTF8.Create(nil);
+  try
+    BrowserProcess.CommandLine := ABrowser + ' ' + Format(AParams, [AURL]);
+    BrowserProcess.Execute;
+  finally
+    BrowserProcess.Free;
+  end;
+end;
+
 
 procedure FreeLineInfoCache;
 var

lcl/utf8process.pp

@@ -28,7 +28,7 @@ unit UTF8Process;
 interface
 
 uses
-  Classes, SysUtils, Process, LCLProc, FileUtil;
+  Classes, SysUtils, Process, FileUtil;
 
 type
   { TProcessUTF8 }