paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-05 01:41:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCLIntf: OpenURL (Windows)

Browse Source 
- partially revert r52640 #491870c710, use Params as supplied by FindDefaultBrowser as is.
- always quote file:// if it contains spaces, even if MS IE tells us it it not needed (but it is)
- fix compilation for WinCE

git-svn-id: trunk@52642 -
This commit is contained in:
bart 2016-07-06 11:27:26 +00:00
parent 9a90869147
commit 5973a75d07
1 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lcl/include/sysenvapis_win.inc
View File

@ -185,9 +185,8 @@ begin
end; end;
end; end;
{$ENDIF WinCE}
function FindDefaultBrowserAndOpenUrl(AURL: String; IsFileURI: Boolean=False; IsLocalWithAnchor: Boolean=False): Boolean; function FindDefaultBrowserAndOpenUrl(AURL: String; IsFileURI: Boolean=False{; IsLocalWithAnchor: Boolean=False}): Boolean;
var var
ABrowser, AParams: WideString; ABrowser, AParams: WideString;
H: HINST; H: HINST;
@ -199,9 +198,13 @@ begin
begin begin
if (Pos('%s', AParams) > 0) then if (Pos('%s', AParams) > 0) then
begin begin
//MS IE returns quoted or unquoted %s, depending on version and OS
//file:// needs to be quoted if filename contains spaces
if (Pos('"%s"', AParams) = 0) and IsFileUri then
AURL := '"'+ AURL + '"';
//at least FireFox does not like -url -osint "%s" for local files, it wants "%s" //at least FireFox does not like -url -osint "%s" for local files, it wants "%s"
if IsFileUri and IsLocalWithAnchor then //if IsFileUri and IsLocalWithAnchor then
AParams := '"%s"'; // AParams := '"%s"';
{$IFnDEF ACP_RTL} {$IFnDEF ACP_RTL}
AParamsUtf8 := Utf16ToUtf8(AParams); AParamsUtf8 := Utf16ToUtf8(AParams);
{$ELSE} {$ELSE}
@ -215,13 +218,22 @@ begin
{$ENDIF ACP_RTL} {$ENDIF ACP_RTL}
end end
else else
begin
//file:// needs to be quoted if filename contains spaces
if IsFileURI and (Pos(#32, AURL) > 0) then
AURL := '"' + AURL + '"';
{$IFnDEF ACP_RTL} {$IFnDEF ACP_RTL}
AParams := Utf8ToUtf16(AURL); AParams := Utf8ToUtf16(AURL);
{$ELSE} {$ELSE}
AParams := WideString(AURL); AParams := WideString(AURL);
{$ENDIF ACP_RTL} {$ENDIF ACP_RTL}
end;
debugln('FindDefaultBrowserAndOpenUrl:');
debugln([' ABrowser = ',ABrowser]);
debugln([' AParams = ',AParams]);
H := ShellExecuteW(0, 'open', PWChar(ABrowser), PWChar(AParams), nil, SW_SHOWNORMAL); H := ShellExecuteW(0, 'open', PWChar(ABrowser), PWChar(AParams), nil, SW_SHOWNORMAL);
end end //FindDefaultBrowserWide
else else
begin begin
{$IFnDEF ACP_RTL} {$IFnDEF ACP_RTL}
@ -233,6 +245,7 @@ begin
end; end;
Result := (H > 32); Result := (H > 32);
end; end;
{$ENDIF WinCE}
// Open a given URL with whatever Windows thinks is appropriate // Open a given URL with whatever Windows thinks is appropriate
function OpenURL(AURL: String): Boolean; function OpenURL(AURL: String): Boolean;
@ -262,7 +275,7 @@ begin
//if FindDefaultBrowserWide returns 'rundll.exe' //if FindDefaultBrowserWide returns 'rundll.exe'
//See: issue #0030326 and related //See: issue #0030326 and related
if IsFileURI and IsHtmlWithAnchor(AURL) then if IsFileURI and IsHtmlWithAnchor(AURL) then
Result := FindDefaultBrowserAndOpenURL(AURL, True, True) Result := FindDefaultBrowserAndOpenURL(AURL, True{, True})
else else
begin begin
//Urls that start with file:// are allowed to contain spaces and should be quoted //Urls that start with file:// are allowed to contain spaces and should be quoted