View Issue Details

IDProjectCategoryView StatusLast Update
0035659LazarusOtherpublic2020-01-12 14:28
Reporterjamie philbrookAssigned Towp 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version2.0.2Product Build 
Target VersionFixed in Version 
Summary0035659: HtmlHelp example fails to load MicrosoftEdge as the viewer
DescriptionTrying implement a HTML help system, so first trying the
"HtmlHelp" example in the examples folder of Lazarus.
I get this in a Error fault dialog

shell:AppsFolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge

I traced the path all the way to where it gets the file attributes and it returns -1 for this
file name, which then fails of course.
--
If I Null the return string in the function GetDefaultBrowserWideByAppID: WideString; it loads Edge, or
if I trim back the string up to the "_" but not including, it also loads Edge.

Some help here is needed because this HTML help isn't going to work on my Windows 10 the way it is now unless I
devise my own method to locate the default browner or edit the files like I showed you to make it work.
TagsNo tags attached.
Fixed in Revision62387
LazTarget2.0.8
Widgetset
Attached Files
  • lazhelphtml.pas (15,236 bytes)
    {
     *****************************************************************************
      This file is part of the Lazarus Component Library (LCL)
    
      See the file COPYING.modifiedLGPL.txt, included in this distribution,
      for details about the license.
     *****************************************************************************
    
      Author: Mattias Gaertner
    
      Abstract:
        Methods and types for simple HTML help.
    }
    unit LazHelpHTML;
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      {$IFDEF Windows}Windows,ShellApi, {$IFEND}Classes, SysUtils,
      // LazUtils
      LazFileUtils, UTF8Process, LazUTF8, LazConfigStorage,
      // LCL
      LCLProc, LCLIntf, LCLStrConsts, HelpIntfs, LazHelpIntf;
    
    type
      { THTMLHelpDatabase
    
        KeywordPrefix: if set, then the database will handle all Keywords
          beginning with this value. And when the path is created by replacing
          the prefix with the BaseURL.
          For example:
            Put a THTMLHelpDatabase on a form.
            Set AutoRegister to true.
            Set KeywordPrefix to 'MyHelp/'
            Set BaseURL to 'file://'
            
            Put a THTMLBrowserHelpViewer on the form.
            Set AutoRegister to true.
            Set BrowserPath to '/usr/bin/mozilla'
    
            Put a TEdit on a form.
            Set HelpType to htKeyword
            Set HelpKeyword to 'MyHelp/page.html'
            
            Run the program.
            Focus the edit field and press F1. The page 'page.html' will be shown.
            }
    
      THTMLHelpDatabase = class(THelpDatabase)
      private
        FBaseURL: string;
        FDefaultBaseURL: string;
        FKeywordPrefix: string;
        FKeywordPrefixNode: THelpNode;
        function IsBaseURLStored: boolean;
        procedure SetBaseURL(const AValue: string);
        procedure SetBuiltInBaseURL(const AValue: string);
        procedure SetDefaultBaseURL(const AValue: string);
      public
        constructor Create(TheOwner: TComponent); override;
        destructor Destroy; override;
        function ShowURL(const URL, Title: string;
                         var ErrMsg: string): TShowHelpResult; virtual;
        function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
                          QueryItem: THelpQueryItem;
                          var ErrMsg: string): TShowHelpResult; override;
        function GetNodesForKeyword(const HelpKeyword: string;
                                    var ListOfNodes: THelpNodeQueryList;
                                    var ErrMsg: string): TShowHelpResult; override;
        function GetEffectiveBaseURL: string;
        procedure Load(Storage: TConfigStorage); override;
        procedure Save(Storage: TConfigStorage); override;
        property DefaultBaseURL: string read FDefaultBaseURL write SetDefaultBaseURL;// used, if BaseURL is empty
      published
        property BuiltInBaseURL: string read FDefaultBaseURL write SetBuiltInBaseURL;// read only, shown in the IDE help options
        property BaseURL: string read FBaseURL write SetBaseURL stored IsBaseURLStored;
        property AutoRegister;
        property KeywordPrefix: string read FKeywordPrefix write FKeywordPrefix;// see above
      end;
      
      
      { THTMLBrowserHelpViewer
    
        If no browser is specified it searches for a common browser. }
      
      TOnFindDefaultBrowser = procedure(var DefaultBrowser, Params: string) of object;
    
      THTMLBrowserHelpViewer = class(THelpViewer)
      private
        FBrowserParams: string;
        FBrowserPath: string;
        FDefaultBrowser: string;
        FDefaultBrowserParams: string;
        FOnFindDefaultBrowser: TOnFindDefaultBrowser;
        procedure SetBrowserParams(const AValue: string);
        procedure SetBrowserPath(const AValue: string);
      public
        constructor Create(TheOwner: TComponent); override;
        function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; override;
        procedure FindDefaultBrowser(out Browser, Params: string); virtual;
        procedure Assign(Source: TPersistent); override;
        procedure Load(Storage: TConfigStorage); override;
        procedure Save(Storage: TConfigStorage); override;
        function GetLocalizedName: string; override;
        property OnFindDefaultBrowser: TOnFindDefaultBrowser
                   read FOnFindDefaultBrowser write FOnFindDefaultBrowser;
      published
        property BrowserPath: string read FBrowserPath write SetBrowserPath;
        property BrowserParams: string read FBrowserParams write SetBrowserParams;
        property AutoRegister;
      end;
      
    
    procedure Register;
      
    implementation
    
    procedure Register;
    begin
      RegisterComponents('System',[THTMLHelpDatabase,THTMLBrowserHelpViewer]);
    end;
    
    { THTMLHelpDatabase }
    
    procedure THTMLHelpDatabase.SetBaseURL(const AValue: string);
    begin
      if FBaseURL=AValue then exit;
      //debugln('THTMLHelpDatabase.SetBaseURL ',dbgsName(Self),' ',AValue);
      if AValue=DefaultBaseURL then
        FBaseURL:=''
      else
        FBaseURL:=AValue;
    end;
    
    procedure THTMLHelpDatabase.SetBuiltInBaseURL(const AValue: string);
    begin
      if AValue=BuiltInBaseURL then exit;
      raise Exception.Create(rsTheBuiltInURLIsReadOnlyChangeTheBaseURLInstead);
    end;
    
    procedure THTMLHelpDatabase.SetDefaultBaseURL(const AValue: string);
    begin
      if FDefaultBaseURL=AValue then exit;
      if (FBaseURL='') or (FBaseURL=FDefaultBaseURL) then
        FBaseURL:=FDefaultBaseURL;
      FDefaultBaseURL:=AValue;
    end;
    
    function THTMLHelpDatabase.IsBaseURLStored: boolean;
    begin
      Result:=FBaseURL<>DefaultBaseURL;
    end;
    
    constructor THTMLHelpDatabase.Create(TheOwner: TComponent);
    begin
      inherited Create(TheOwner);
      AddSupportedMimeType('text/html');
    end;
    
    destructor THTMLHelpDatabase.Destroy;
    begin
      FreeAndNil(FKeywordPrefixNode);
      inherited Destroy;
    end;
    
    function THTMLHelpDatabase.ShowURL(const URL, Title: string; var ErrMsg: string
      ): TShowHelpResult;
    var
      URLType, URLPath, URLParams: string;
      BaseURLType, BaseURLPath, BaseURLParams: string;
      Viewer: THelpViewer;
      EffBaseURL: String;
      Node: THelpNode;
      FullURL: String;
    begin
      //DebugLn('THTMLHelpDatabase.ShowURL A URL="',URL,'" Title="',Title,'"');
    
      // find HTML viewer
      Result:=FindViewer('text/html',ErrMsg,Viewer);
      if Result<>shrSuccess then exit;
    
      // make URL absolute
      SplitURL(URL,URLType,URLPath,URLParams);
      //debugln('THTMLHelpDatabase.ShowURL A NewNode.URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
    
      if URLType='file' then begin
        if not URLFilenameIsAbsolute(URLPath) then begin
          EffBaseURL:=GetEffectiveBaseURL;
          //DebugLn('THTMLHelpDatabase.ShowURL file relative, making absolute... EffBaseURL="',EffBaseURL,'"');
          if EffBaseURL<>'' then begin
            SplitURL(EffBaseURL,BaseURLType,BaseURLPath,BaseURLParams);
            if (BaseURLPath<>'') then
              URLPath:=BaseURLPath+URLPath;
            URLType:=BaseURLType;
          end;
        end;
        if (URLType='file') and (not URLFilenameIsAbsolute(URLPath)) then
          URLPath:=FilenameToURLPath(TrimFilename(GetCurrentDirUTF8+PathDelim))+URLPath;
        
        if (URLType='file') and (not FileExistsUTF8(URLPath)) then begin
          Result:=shrContextNotFound;
          ErrMsg:=Format(hhsHelpTheHelpDatabaseWasUnableToFindFile, [ID, URLPath]);
          exit;
        end;
      end;
      FullURL:=CombineURL(URLType,URLPath,URLParams);
      {$IFNDEF DisableChecks}
        debugln('THTMLHelpDatabase.ShowURL B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
      {$ENDIF}
    
      // call viewer
      Node:=nil;
      try
        Node:=THelpNode.CreateURL(Self,Title,FullURL);
        Result:=Viewer.ShowNode(Node,ErrMsg);
      finally
        Node.Free;
      end;
    end;
    
    function THTMLHelpDatabase.ShowHelp(Query: THelpQuery;
      BaseNode, NewNode: THelpNode; QueryItem: THelpQueryItem;
      var ErrMsg: string): TShowHelpResult;
    begin
      ErrMsg:='';
      Result:=shrContextNotFound;
      if NewNode.URLValid then begin
        Result:=ShowURL(NewNode.URL,NewNode.Title,ErrMsg);
      end else begin
        Result:=shrContextNotFound;
        ErrMsg:='THTMLHelpDatabase.ShowHelp Node.URLValid=false Node.URL="'+NewNode.URL+'"';
      end;
    end;
    
    function THTMLHelpDatabase.GetNodesForKeyword(const HelpKeyword: string;
      var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
    var
      Path: String;
    begin
      Result:=inherited GetNodesForKeyword(HelpKeyword, ListOfNodes, ErrMsg);
      if Result<>shrSuccess then exit;
    
      if not (csDesigning in ComponentState)
      and (KeywordPrefix<>'')
      and (LeftStr(HelpKeyword,length(KeywordPrefix))=KeywordPrefix) then begin
        // HelpKeyword starts with KeywordPrefix -> add default node
        if FKeywordPrefixNode=nil then
          FKeywordPrefixNode:=THelpNode.CreateURL(Self,'','');
        Path:=copy(HelpKeyword,length(KeywordPrefix)+1,length(HelpKeyword));
        FKeywordPrefixNode.Title:='Show page '+Path;
        FKeywordPrefixNode.URL:='file://'+Path;
        CreateNodeQueryListAndAdd(FKeywordPrefixNode,nil,ListOfNodes,true);
      end;
    end;
    
    function THTMLHelpDatabase.GetEffectiveBaseURL: string;
    begin
      Result:='';
      if BaseURL<>'' then begin
        Result:=BaseURL;
        if (Databases<>nil) then begin
          Databases.SubstituteMacros(Result);
          Result:=FilenameToURLPath(Result);
        end;
        //debugln('THTMLHelpDatabase.GetEffectiveBaseURL using BaseURL="',Result,'"');
      end else if (BasePathObject<>nil) and (Databases<>nil) then begin
        Result:=Databases.GetBaseURLForBasePathObject(BasePathObject);
        //debugln('THTMLHelpDatabase.GetEffectiveBaseURL using BasePathObject="',Result,'"');
      end;
      if (Result='') and (DefaultBaseURL<>'') then begin
        Result:=DefaultBaseURL;
        if (Databases<>nil) then begin
          Databases.SubstituteMacros(Result);
          Result:=FilenameToURLPath(Result);
        end;
        //debugln('THTMLHelpDatabase.GetEffectiveBaseURL using DefaultBaseURL="',Result,'"');
      end;
      Result:=AppendURLPathDelim(Result);
    end;
    
    procedure THTMLHelpDatabase.Load(Storage: TConfigStorage);
    begin
      inherited Load(Storage);
      BaseURL:=Storage.GetValue('BaseURL/Value',DefaultBaseURL);
    end;
    
    procedure THTMLHelpDatabase.Save(Storage: TConfigStorage);
    begin
      inherited Save(Storage);
      Storage.SetDeleteValue('BaseURL/Value',BaseURL,DefaultBaseURL);
    end;
    
    { THTMLBrowserHelpViewer }
    
    procedure THTMLBrowserHelpViewer.SetBrowserParams(const AValue: string);
    begin
      if FBrowserParams=AValue then exit;
      FBrowserParams:=AValue;
    end;
    
    procedure THTMLBrowserHelpViewer.SetBrowserPath(const AValue: string);
    begin
      if FBrowserPath=AValue then exit;
      FBrowserPath:=AValue;
    end;
    
    constructor THTMLBrowserHelpViewer.Create(TheOwner: TComponent);
    begin
      inherited Create(TheOwner);
      AddSupportedMimeType('text/html');
      FBrowserParams:='%s';
      ParameterHelp:=hhsHelpTheMacroSInBrowserParamsWillBeReplacedByTheURL;
    end;
    
    function THTMLBrowserHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
      ): TShowHelpResult;
    var
      URLMacroPos: LongInt;
      BrowserProcess: TProcessUTF8;
      Executable, ParamsStr: String;
      IsShellStr:Boolean = false; // added
    begin
      Result:=shrViewerError;
      ErrMsg:='';
      if (not Node.URLValid) then begin
        ErrMsg:='THTMLBrowserHelpViewer.ShowNode Node.URLValid=false';
        exit;
      end;
      if (Node.URL='') then begin
        ErrMsg:='THTMLBrowserHelpViewer.ShowNode Node.URL empty';
        exit;
      end;
    
      // check browser path
      Executable:=BrowserPath;
      ParamsStr:=BrowserParams;
      if Executable='' then
        FindDefaultBrowser(Executable, ParamsStr);
      if Executable='' then begin
        if (HelpDatabases<>nil)
        and (CompareText(HelpDatabases.ClassName,'TIDEHelpDatabases')=0) then
          ErrMsg:=Format(hhsHelpNoHTMLBrowserFoundPleaseDefineOne,[LineEnding])
        else
          ErrMsg:=hhsHelpNoHTMLBrowserFound;
        exit;
      end;
      {$ifdef windows}
      //The result of FindDefaultBrowser may or may not be quoted on Windows
      //Since on Windows, a filename cannot contain a double quote, we simply remove them
      //otherwise FileExistsUf8 and FileIsExecutable fail. Issue #0030502
      if (Length(Executable) > 1) and (Executable[1] = '"') and (Executable[Length(Executable)] = '"') then
        Executable := Copy(Executable, 2, Length(Executable)-2);
      {$endif windows}
      IsShellStr := UpperCase(LeftStr(Executable,Pos(':',Executable)))='SHELL:'; //Added
      if Not IsShellStr Then  //Added
      Begin
      if (not FileExistsUTF8(Executable)) then begin
        ErrMsg:=Format(hhsHelpBrowserNotFound, [Executable]);
        exit;
      end;
      if (not FileIsExecutable(Executable)) then begin
        ErrMsg:=Format(hhsHelpBrowserNotExecutable, [Executable]);
        exit;
      end;
      End; //added
      //debugln('THTMLBrowserHelpViewer.ShowNode Node.URL=',Node.URL);
    
      // create params and replace %ParamsStr for URL
      URLMacroPos:=Pos('%s',ParamsStr);
      if URLMacroPos>=1 then
        ReplaceSubstring(ParamsStr,URLMacroPos,2,Node.URL)
      else begin
        if ParamsStr<>'' then
          ParamsStr:=ParamsStr+' ';
        ParamsStr:=ParamsStr+Node.URL;
      end;
    
      {$IFNDEF DisableChecks}
      debugln('THTMLBrowserHelpViewer.ShowNode Executable="',Executable,'" Params="',ParamsStr,'"');
      {$ENDIF}
    
      // run
    {$IFDEF Windows}  //Added
     If IsShellStr Then
      Begin
        If ShellExecute(0,'open',Pchar(Executable),Pchar(ParamsStr),'',SW_SHOWNORMAL)<=32 Then
         ErrMsg := Format(hhsHelpErrorWhileExecuting,[Executable+' ',ParamsStr, LineEnding, 'ShellExecute']) else
        Result := shrSuccess;
      end else
      {$IFEND} //Added
      try
        BrowserProcess:=TProcessUTF8.Create(nil);
        try
          BrowserProcess.InheritHandles:=false;
          BrowserProcess.Executable:=Executable;
          SplitCmdLineParams(ParamsStr,BrowserProcess.Parameters);
          BrowserProcess.Execute;
        finally
          BrowserProcess.Free;
        end;
        Result:=shrSuccess;
      except
        on E: Exception do begin
          ErrMsg:=Format(hhsHelpErrorWhileExecuting, [Executable+' '+ParamsStr, LineEnding, E.Message]);
        end;
      end;
    end;
    
    procedure THTMLBrowserHelpViewer.FindDefaultBrowser(out Browser, Params: string);
    begin
      if FDefaultBrowser='' then
      begin
        if Assigned(OnFindDefaultBrowser) then
          OnFindDefaultBrowser(FDefaultBrowser, FDefaultBrowserParams);
      end;
      if FDefaultBrowser = '' then
        LCLIntf.FindDefaultBrowser(FDefaultBrowser, FDefaultBrowserParams);
    
      Browser := FDefaultBrowser;
      Params := FDefaultBrowserParams;
    
      //DebugLn('THTMLBrowserHelpViewer.FindDefaultBrowser Browser=',Browser,' Params=',Params);
    end;
    
    procedure THTMLBrowserHelpViewer.Assign(Source: TPersistent);
    var
      Viewer: THTMLBrowserHelpViewer;
    begin
      if Source is THTMLBrowserHelpViewer then begin
        Viewer:=THTMLBrowserHelpViewer(Source);
        BrowserPath:=Viewer.BrowserPath;
        BrowserParams:=Viewer.BrowserParams;
      end;
      inherited Assign(Source);
    end;
    
    procedure THTMLBrowserHelpViewer.Load(Storage: TConfigStorage);
    begin
      BrowserPath:=Storage.GetValue('Browser/Path','');
      BrowserParams:=Storage.GetValue('Browser/Params','%s');
    end;
    
    procedure THTMLBrowserHelpViewer.Save(Storage: TConfigStorage);
    begin
      Storage.SetDeleteValue('Browser/Path',BrowserPath,'');
      Storage.SetDeleteValue('Browser/Params',BrowserParams,'%s');
    end;
    
    function THTMLBrowserHelpViewer.GetLocalizedName: string;
    begin
      Result:='HTML Browser';
    end;
    
    end.
    
    
    lazhelphtml.pas (15,236 bytes)
  • lazhelphtml.pas.patch (2,089 bytes)
    Index: lcl/lazhelphtml.pas
    ===================================================================
    --- lcl/lazhelphtml.pas	(revision 62380)
    +++ lcl/lazhelphtml.pas	(working copy)
    @@ -18,7 +18,7 @@
     interface
     
     uses
    -  Classes, SysUtils,
    +  {$IFDEF Windows}Windows,ShellApi, {$IFEND}Classes, SysUtils,
       // LazUtils
       LazFileUtils, UTF8Process, LazUTF8, LazConfigStorage,
       // LCL
    @@ -207,7 +207,7 @@
       end;
       FullURL:=CombineURL(URLType,URLPath,URLParams);
       {$IFNDEF DisableChecks}
    -  debugln('THTMLHelpDatabase.ShowURL B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
    +    debugln('THTMLHelpDatabase.ShowURL B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
       {$ENDIF}
     
       // call viewer
    @@ -320,6 +320,7 @@
       URLMacroPos: LongInt;
       BrowserProcess: TProcessUTF8;
       Executable, ParamsStr: String;
    +  IsShellStr:Boolean = false; // added
     begin
       Result:=shrViewerError;
       ErrMsg:='';
    @@ -352,6 +353,9 @@
       if (Length(Executable) > 1) and (Executable[1] = '"') and (Executable[Length(Executable)] = '"') then
         Executable := Copy(Executable, 2, Length(Executable)-2);
       {$endif windows}
    +  IsShellStr := UpperCase(LeftStr(Executable,Pos(':',Executable)))='SHELL:'; //Added
    +  if Not IsShellStr Then  //Added
    +  Begin
       if (not FileExistsUTF8(Executable)) then begin
         ErrMsg:=Format(hhsHelpBrowserNotFound, [Executable]);
         exit;
    @@ -360,7 +364,7 @@
         ErrMsg:=Format(hhsHelpBrowserNotExecutable, [Executable]);
         exit;
       end;
    -
    +  End; //added
       //debugln('THTMLBrowserHelpViewer.ShowNode Node.URL=',Node.URL);
     
       // create params and replace %ParamsStr for URL
    @@ -378,6 +382,14 @@
       {$ENDIF}
     
       // run
    +{$IFDEF Windows}  //Added
    + If IsShellStr Then
    +  Begin
    +    If ShellExecute(0,'open',Pchar(Executable),Pchar(ParamsStr),'',SW_SHOWNORMAL)<=32 Then
    +     ErrMsg := Format(hhsHelpErrorWhileExecuting,[Executable+' ',ParamsStr, LineEnding, 'ShellExecute']) else
    +    Result := shrSuccess;
    +  end else
    +  {$IFEND} //Added
       try
         BrowserProcess:=TProcessUTF8.Create(nil);
         try
    
    lazhelphtml.pas.patch (2,089 bytes)

Relationships

related to 0036558 resolvedwp Commit 62400 breaks building wince-arm and wince-i386 

Activities

jamie philbrook

2019-06-02 01:11

reporter   ~0116524

Last edited: 2019-06-02 01:24

View 2 revisions

I made a change to the file "sysenvapis_win_inc" At line 0000096:0000078

function GetDefaultBrowserWideByAppID: WideString;
const
  Extension = '.htm';
var
  BufSize: DWORD;
begin
  BufSize := MAX_PATH;
  Setlength(Result, BufSize);
  if AssocQueryStringW(ASSOCF_NOTRUNCATE, ASSOCSTR_APPID, PWChar(Extension), 'open', PWChar(Result), BufSize) = S_OK then
   SetLength(Result, BufSize - 1)
  else
    Result := '';
  if (Result <> '') then
    Result := 'shell:AppsFolder\' + Result;
  If (Result <> '') and (Not FileExistsUTF8(Result)) then Result := ''; {This line was added to test if it actually exists on the system under this name}
end;

On my system Windows 10 recent update, The return is the same as the author of the file indicated but my system fails to detect it.
So I could ether trim back the name before the "_" or just put in a check like this. The trimming back also works.

I have recompiled and everyone seems to happy..
Please consider this change, I need this so I can implement a HTML help using the browser.

P.S. I tested this on W2k and a Vista machine, it still works.

A post was made in the forums on this issue
https://forum.lazarus.freepascal.org/index.php/topic,45569.0.html

jamie philbrook

2019-06-02 01:57

reporter   ~0116525

Last edited: 2019-06-02 01:58

View 2 revisions

Ok, I found out the real reason why this is failing out of the box, A WideString is being returned but farther down the source code it using
a FileExistUtf8(WideFileName) and fails to locate the file.
 
When using the Windows.GetFileAtrributeW(WideFileName) it does report as a valid file so mystery solved there.

Basically what I am saying is the UTF8 converted string is failing in the Windows.GetFileAttributeA function..

so what is the best way to fix this ? If I do what I did as above it still works, I get my browser.. maybe not everyone has a non UTF8 entry file name
for MicrosoftEdge, on my there isn't any.


 I can't say why but since this string is a WIDESTRING being returned from the system my guess would be there is no UTF8 file name counter part
in my system.

jamie philbrook

2019-06-02 02:26

reporter   ~0116526

Last edited: 2019-06-02 04:07

View 3 revisions

Ok, I got it now ….
The code converts the UTF8 back to WideString or In this case a UnicodeString.
In this function
//LazUtils, File winLazFileUtils.inc
 function FileGetAttrUtf8(const FileName: String): Longint;
begin
  Result:=Integer(Windows.GetFileAttributesW(PWideChar(UTF8Decode(FileName))));
end;
a UTF8 comes in, the UTF8Decode(rawBytestring):Unicodestring puts it back to a WideString.

I don't know which end the issue is on, ether going from UTF8 back to WideString or the other way round but
the file name is getting changed from what originally was returned.
The debugger for some reason does not display a WidesString so its hard to say.


This is where it's failing because the conversion back to WideString is not the original Widestring fetched from the OS.

So we have a conversion issue From UTF8 to WideString.

If I directly do this:

Windows.GetFileAttributesW(The_WideString_Directly_fom_The_Query); It does confirm the file existing .

But after it gets converted to UTF8 and back, it no longer passes the test.

I really would love to get some traction on this, because I am sure this type of error is popping up elsewhere in other code.

jamie philbrook

2019-06-03 05:06

reporter   ~0116543

Please consider applying my First post on the change I made in the file stated
I have spent hours of hacking and It finally comes down to that fact that my Windows 10 does not have Microsoft Edge setup to be launched
even though the QueryStringW returns that as the browser of choice when looking for a WideString browser.

  I added the line at the end of the code to verify the file is loadable and if not clear the return string, the rest of the code follows through using
other methods to locate the browser which work ok on my system.. This change I made works on everything I tried, W2k,Xp, Vista, My Win10 etc.

Thank You.

Bart Broersma

2019-10-18 19:24

reporter   ~0118668

Is Edge your default browser?
Does a simple OpenUrl('https://bugs.freepascal.org/view.php?id=35659') open in Edge (or in any other browser)?

FileExists('shell:AppsFolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge') returns false on my system, but

C:\Users\Bart\LazarusProjecten>start shell:AppsFolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge

starts up Edge browser nontheless.

So querying with FileExists() is useless in this case.

jamie philbrook

2019-10-18 22:49

reporter   ~0118673

Openurl seems to work on my system but it does not bring up Edge, instead it adds a tab to my already opened IE browser.

In another Win10 where there is no IE, OpenURL will start Edge because that is the only browser there.

The code use in the LazHtml is looking for a WIDE version of a browser so it's targeting Edge, but fails.
If I nullify that code it then follows through using the OpenUrl code which works.

 If I directly propagate over to the Shell folder and attempt to execute it via the Windows browser it also fails.

This may have worked at one time in Windows 10's life but it does not any more.

 I have three PC's in the house with 10 on it and two at work, they all fail if edge is installed on the PC.

 My suggestion is the nullify the function for now, at least it works for me with all PCs I have. Make it return nothing or a fail so that the default method will be used.

jamie philbrook

2019-10-18 23:47

reporter   ~0118674

function GetDefaultBrowserWideByAppID: WideString;
const
  Extension= '.htm';
var
  BufSize: DWORD;
begin
  BufSize := MAX_PATH;
  SetLength(Result, BufSize);
  if AssocQueryStringW(ASSOCF_NOTRUNCATE, ASSOCSTR_APPID, PWChar(Extension), 'open', PWChar(Result), BufSize) = S_OK then
    SetLength(Result, BufSize - 1)
  else
    Result := '';
  if (Result <> '') then
    Result := 'shell:AppsFolder\' + Result;
   Result := ''; // This does not work Void it for now jamie 8/9/19
end;

Following is a next function that is looking for it as a CMD.
// This gets executed after the first function fails but it seems this one is successful

function GetDefaultBrowserWideByCmd: WideString;
const
  Extension = '.htm';
var
  BufSize: DWORD;
begin
  BufSize := MAX_PATH;
  SetLength(Result, BufSize);
  if AssocQueryStringW(ASSOCF_NOTRUNCATE, ASSOCSTR_COMMAND, PWChar(Extension), 'open', PWChar(Result), BufSize) = S_OK then
    SetLength(Result, BufSize - 1)
  else
    Result := '';
end;

So in the end, all of the WIDE functions are getting called even though I nullified the AppID version.

Bart Broersma

2019-10-18 23:57

reporter   ~0118675

The wide here just means the resulting string is WideString, not Ansi or UTF8.
It is not specifically targeting Edge.

jamie philbrook

2019-10-19 01:20

reporter   ~0118676

Last edited: 2019-10-19 01:21

View 2 revisions

If you look deeper in the code it is looking for it.
  //List of WinAppBrwosers (Win 10) that are capable of handling local filenames with anchors
  //Strings must be in uppercase
  //The string must be the "easy part" that can be detected in a AppUserModelID like
  //shell:AppsFolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge
  //Currently Edge is the only one that can handle this, but others may follow
  CapableWinAppBrowsers: Array[1..1] of WideString = (
    'MICROSOFTEDGE'
    );

----
//not every AppUserModelID we retrieve using GetDefaultBrowserWideByAppID
//accepts paramters (e.g. the URL)
function LaunchWinAppBrowserCanHandleParams(ABrowser: WideString): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := Low(CapableWinAppBrowsers) to High(CapableWinAppBrowsers) do
    if (Pos(CapableWinAppBrowsers[i], WideUpperCase(ABrowser)) > 0) then Exit(True);
end;
                                 
As you can see, the code frag for the Wide Version is targeting Edge.

jamie philbrook

2019-10-19 01:54

reporter   ~0118677

Last edited: 2019-10-19 03:32

View 2 revisions

Please take note of this site.
https://superuser.com/questions/1338811/how-to-start-edge-by-calling-c-windows-systemapps-microsoft-microsoftedge-8weky
--
Apparently the LazHelp code is expecting a EXE file type and is using The TProcessUTF8 to execute a shell: name string. So at best I think the ShellExecuteW call is needed for this case.

  $MS apparently has changed the way Edge is seen in the system with one of the recent windows updates. It will no longer load as a EXE file but only as a Protocol launch.
 Personally I think doing what I did for the in term is good enough because it does load Edge if that is your default browser with nullifying the function AppID as I did.

 Otherwise a rewrite of a large chunk of code is needed to work around this.

 I know there is a coming release very soon and I don't want to be one to hold it up, please do as you wish, I will put the hack in there so it works for me.
I am sure there is software out there that is using this method and most likely now failing on recent Windows 10 updates.

jamie philbrook

2019-10-19 19:52

reporter   ~0118711

This loads MicrosoftEdge on my Windows 10..
----
procedure TForm1.Button1Click(Sender: TObject);
Type
  pWChar = ^Wchar;
Var
  UrlName:WideString='shell:Appsfolder\Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdge';
begin
  ShellExecuteW(0,'open',PWChar(Urlname),'http://google.com','',SW_SHOWNORMAL);
end;

The morrow of the story is, a ShellExecute needs to be done for this case instead of the TProcessUTF8 as it being done now.

So testing for the "Shell:" at the start of the string should be enough to detour the code over to a ShellExecuteW instead.

jamie philbrook

2019-10-19 23:31

reporter   ~0118718

I have what I think fixed the issue but I had to add some code to the LazHelpHTML file.

I can attached the file here, its from 2.0.4 build but it should be the same for newer versions.

I worked around the difference between platform with compiler switches so it should still compile for other targets.
Please review this file.
Located in the LCL, replace yours and recompile. please save your existing one and try out the HtmlHelp Example.

lazhelphtml.pas (15,236 bytes)
{
 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************

  Author: Mattias Gaertner

  Abstract:
    Methods and types for simple HTML help.
}
unit LazHelpHTML;

{$mode objfpc}{$H+}

interface

uses
  {$IFDEF Windows}Windows,ShellApi, {$IFEND}Classes, SysUtils,
  // LazUtils
  LazFileUtils, UTF8Process, LazUTF8, LazConfigStorage,
  // LCL
  LCLProc, LCLIntf, LCLStrConsts, HelpIntfs, LazHelpIntf;

type
  { THTMLHelpDatabase

    KeywordPrefix: if set, then the database will handle all Keywords
      beginning with this value. And when the path is created by replacing
      the prefix with the BaseURL.
      For example:
        Put a THTMLHelpDatabase on a form.
        Set AutoRegister to true.
        Set KeywordPrefix to 'MyHelp/'
        Set BaseURL to 'file://'
        
        Put a THTMLBrowserHelpViewer on the form.
        Set AutoRegister to true.
        Set BrowserPath to '/usr/bin/mozilla'

        Put a TEdit on a form.
        Set HelpType to htKeyword
        Set HelpKeyword to 'MyHelp/page.html'
        
        Run the program.
        Focus the edit field and press F1. The page 'page.html' will be shown.
        }

  THTMLHelpDatabase = class(THelpDatabase)
  private
    FBaseURL: string;
    FDefaultBaseURL: string;
    FKeywordPrefix: string;
    FKeywordPrefixNode: THelpNode;
    function IsBaseURLStored: boolean;
    procedure SetBaseURL(const AValue: string);
    procedure SetBuiltInBaseURL(const AValue: string);
    procedure SetDefaultBaseURL(const AValue: string);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    function ShowURL(const URL, Title: string;
                     var ErrMsg: string): TShowHelpResult; virtual;
    function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
                      QueryItem: THelpQueryItem;
                      var ErrMsg: string): TShowHelpResult; override;
    function GetNodesForKeyword(const HelpKeyword: string;
                                var ListOfNodes: THelpNodeQueryList;
                                var ErrMsg: string): TShowHelpResult; override;
    function GetEffectiveBaseURL: string;
    procedure Load(Storage: TConfigStorage); override;
    procedure Save(Storage: TConfigStorage); override;
    property DefaultBaseURL: string read FDefaultBaseURL write SetDefaultBaseURL;// used, if BaseURL is empty
  published
    property BuiltInBaseURL: string read FDefaultBaseURL write SetBuiltInBaseURL;// read only, shown in the IDE help options
    property BaseURL: string read FBaseURL write SetBaseURL stored IsBaseURLStored;
    property AutoRegister;
    property KeywordPrefix: string read FKeywordPrefix write FKeywordPrefix;// see above
  end;
  
  
  { THTMLBrowserHelpViewer

    If no browser is specified it searches for a common browser. }
  
  TOnFindDefaultBrowser = procedure(var DefaultBrowser, Params: string) of object;

  THTMLBrowserHelpViewer = class(THelpViewer)
  private
    FBrowserParams: string;
    FBrowserPath: string;
    FDefaultBrowser: string;
    FDefaultBrowserParams: string;
    FOnFindDefaultBrowser: TOnFindDefaultBrowser;
    procedure SetBrowserParams(const AValue: string);
    procedure SetBrowserPath(const AValue: string);
  public
    constructor Create(TheOwner: TComponent); override;
    function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; override;
    procedure FindDefaultBrowser(out Browser, Params: string); virtual;
    procedure Assign(Source: TPersistent); override;
    procedure Load(Storage: TConfigStorage); override;
    procedure Save(Storage: TConfigStorage); override;
    function GetLocalizedName: string; override;
    property OnFindDefaultBrowser: TOnFindDefaultBrowser
               read FOnFindDefaultBrowser write FOnFindDefaultBrowser;
  published
    property BrowserPath: string read FBrowserPath write SetBrowserPath;
    property BrowserParams: string read FBrowserParams write SetBrowserParams;
    property AutoRegister;
  end;
  

procedure Register;
  
implementation

procedure Register;
begin
  RegisterComponents('System',[THTMLHelpDatabase,THTMLBrowserHelpViewer]);
end;

{ THTMLHelpDatabase }

procedure THTMLHelpDatabase.SetBaseURL(const AValue: string);
begin
  if FBaseURL=AValue then exit;
  //debugln('THTMLHelpDatabase.SetBaseURL ',dbgsName(Self),' ',AValue);
  if AValue=DefaultBaseURL then
    FBaseURL:=''
  else
    FBaseURL:=AValue;
end;

procedure THTMLHelpDatabase.SetBuiltInBaseURL(const AValue: string);
begin
  if AValue=BuiltInBaseURL then exit;
  raise Exception.Create(rsTheBuiltInURLIsReadOnlyChangeTheBaseURLInstead);
end;

procedure THTMLHelpDatabase.SetDefaultBaseURL(const AValue: string);
begin
  if FDefaultBaseURL=AValue then exit;
  if (FBaseURL='') or (FBaseURL=FDefaultBaseURL) then
    FBaseURL:=FDefaultBaseURL;
  FDefaultBaseURL:=AValue;
end;

function THTMLHelpDatabase.IsBaseURLStored: boolean;
begin
  Result:=FBaseURL<>DefaultBaseURL;
end;

constructor THTMLHelpDatabase.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  AddSupportedMimeType('text/html');
end;

destructor THTMLHelpDatabase.Destroy;
begin
  FreeAndNil(FKeywordPrefixNode);
  inherited Destroy;
end;

function THTMLHelpDatabase.ShowURL(const URL, Title: string; var ErrMsg: string
  ): TShowHelpResult;
var
  URLType, URLPath, URLParams: string;
  BaseURLType, BaseURLPath, BaseURLParams: string;
  Viewer: THelpViewer;
  EffBaseURL: String;
  Node: THelpNode;
  FullURL: String;
begin
  //DebugLn('THTMLHelpDatabase.ShowURL A URL="',URL,'" Title="',Title,'"');

  // find HTML viewer
  Result:=FindViewer('text/html',ErrMsg,Viewer);
  if Result<>shrSuccess then exit;

  // make URL absolute
  SplitURL(URL,URLType,URLPath,URLParams);
  //debugln('THTMLHelpDatabase.ShowURL A NewNode.URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);

  if URLType='file' then begin
    if not URLFilenameIsAbsolute(URLPath) then begin
      EffBaseURL:=GetEffectiveBaseURL;
      //DebugLn('THTMLHelpDatabase.ShowURL file relative, making absolute... EffBaseURL="',EffBaseURL,'"');
      if EffBaseURL<>'' then begin
        SplitURL(EffBaseURL,BaseURLType,BaseURLPath,BaseURLParams);
        if (BaseURLPath<>'') then
          URLPath:=BaseURLPath+URLPath;
        URLType:=BaseURLType;
      end;
    end;
    if (URLType='file') and (not URLFilenameIsAbsolute(URLPath)) then
      URLPath:=FilenameToURLPath(TrimFilename(GetCurrentDirUTF8+PathDelim))+URLPath;
    
    if (URLType='file') and (not FileExistsUTF8(URLPath)) then begin
      Result:=shrContextNotFound;
      ErrMsg:=Format(hhsHelpTheHelpDatabaseWasUnableToFindFile, [ID, URLPath]);
      exit;
    end;
  end;
  FullURL:=CombineURL(URLType,URLPath,URLParams);
  {$IFNDEF DisableChecks}
    debugln('THTMLHelpDatabase.ShowURL B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
  {$ENDIF}

  // call viewer
  Node:=nil;
  try
    Node:=THelpNode.CreateURL(Self,Title,FullURL);
    Result:=Viewer.ShowNode(Node,ErrMsg);
  finally
    Node.Free;
  end;
end;

function THTMLHelpDatabase.ShowHelp(Query: THelpQuery;
  BaseNode, NewNode: THelpNode; QueryItem: THelpQueryItem;
  var ErrMsg: string): TShowHelpResult;
begin
  ErrMsg:='';
  Result:=shrContextNotFound;
  if NewNode.URLValid then begin
    Result:=ShowURL(NewNode.URL,NewNode.Title,ErrMsg);
  end else begin
    Result:=shrContextNotFound;
    ErrMsg:='THTMLHelpDatabase.ShowHelp Node.URLValid=false Node.URL="'+NewNode.URL+'"';
  end;
end;

function THTMLHelpDatabase.GetNodesForKeyword(const HelpKeyword: string;
  var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
var
  Path: String;
begin
  Result:=inherited GetNodesForKeyword(HelpKeyword, ListOfNodes, ErrMsg);
  if Result<>shrSuccess then exit;

  if not (csDesigning in ComponentState)
  and (KeywordPrefix<>'')
  and (LeftStr(HelpKeyword,length(KeywordPrefix))=KeywordPrefix) then begin
    // HelpKeyword starts with KeywordPrefix -> add default node
    if FKeywordPrefixNode=nil then
      FKeywordPrefixNode:=THelpNode.CreateURL(Self,'','');
    Path:=copy(HelpKeyword,length(KeywordPrefix)+1,length(HelpKeyword));
    FKeywordPrefixNode.Title:='Show page '+Path;
    FKeywordPrefixNode.URL:='file://'+Path;
    CreateNodeQueryListAndAdd(FKeywordPrefixNode,nil,ListOfNodes,true);
  end;
end;

function THTMLHelpDatabase.GetEffectiveBaseURL: string;
begin
  Result:='';
  if BaseURL<>'' then begin
    Result:=BaseURL;
    if (Databases<>nil) then begin
      Databases.SubstituteMacros(Result);
      Result:=FilenameToURLPath(Result);
    end;
    //debugln('THTMLHelpDatabase.GetEffectiveBaseURL using BaseURL="',Result,'"');
  end else if (BasePathObject<>nil) and (Databases<>nil) then begin
    Result:=Databases.GetBaseURLForBasePathObject(BasePathObject);
    //debugln('THTMLHelpDatabase.GetEffectiveBaseURL using BasePathObject="',Result,'"');
  end;
  if (Result='') and (DefaultBaseURL<>'') then begin
    Result:=DefaultBaseURL;
    if (Databases<>nil) then begin
      Databases.SubstituteMacros(Result);
      Result:=FilenameToURLPath(Result);
    end;
    //debugln('THTMLHelpDatabase.GetEffectiveBaseURL using DefaultBaseURL="',Result,'"');
  end;
  Result:=AppendURLPathDelim(Result);
end;

procedure THTMLHelpDatabase.Load(Storage: TConfigStorage);
begin
  inherited Load(Storage);
  BaseURL:=Storage.GetValue('BaseURL/Value',DefaultBaseURL);
end;

procedure THTMLHelpDatabase.Save(Storage: TConfigStorage);
begin
  inherited Save(Storage);
  Storage.SetDeleteValue('BaseURL/Value',BaseURL,DefaultBaseURL);
end;

{ THTMLBrowserHelpViewer }

procedure THTMLBrowserHelpViewer.SetBrowserParams(const AValue: string);
begin
  if FBrowserParams=AValue then exit;
  FBrowserParams:=AValue;
end;

procedure THTMLBrowserHelpViewer.SetBrowserPath(const AValue: string);
begin
  if FBrowserPath=AValue then exit;
  FBrowserPath:=AValue;
end;

constructor THTMLBrowserHelpViewer.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  AddSupportedMimeType('text/html');
  FBrowserParams:='%s';
  ParameterHelp:=hhsHelpTheMacroSInBrowserParamsWillBeReplacedByTheURL;
end;

function THTMLBrowserHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
  ): TShowHelpResult;
var
  URLMacroPos: LongInt;
  BrowserProcess: TProcessUTF8;
  Executable, ParamsStr: String;
  IsShellStr:Boolean = false; // added
begin
  Result:=shrViewerError;
  ErrMsg:='';
  if (not Node.URLValid) then begin
    ErrMsg:='THTMLBrowserHelpViewer.ShowNode Node.URLValid=false';
    exit;
  end;
  if (Node.URL='') then begin
    ErrMsg:='THTMLBrowserHelpViewer.ShowNode Node.URL empty';
    exit;
  end;

  // check browser path
  Executable:=BrowserPath;
  ParamsStr:=BrowserParams;
  if Executable='' then
    FindDefaultBrowser(Executable, ParamsStr);
  if Executable='' then begin
    if (HelpDatabases<>nil)
    and (CompareText(HelpDatabases.ClassName,'TIDEHelpDatabases')=0) then
      ErrMsg:=Format(hhsHelpNoHTMLBrowserFoundPleaseDefineOne,[LineEnding])
    else
      ErrMsg:=hhsHelpNoHTMLBrowserFound;
    exit;
  end;
  {$ifdef windows}
  //The result of FindDefaultBrowser may or may not be quoted on Windows
  //Since on Windows, a filename cannot contain a double quote, we simply remove them
  //otherwise FileExistsUf8 and FileIsExecutable fail. Issue #0030502
  if (Length(Executable) > 1) and (Executable[1] = '"') and (Executable[Length(Executable)] = '"') then
    Executable := Copy(Executable, 2, Length(Executable)-2);
  {$endif windows}
  IsShellStr := UpperCase(LeftStr(Executable,Pos(':',Executable)))='SHELL:'; //Added
  if Not IsShellStr Then  //Added
  Begin
  if (not FileExistsUTF8(Executable)) then begin
    ErrMsg:=Format(hhsHelpBrowserNotFound, [Executable]);
    exit;
  end;
  if (not FileIsExecutable(Executable)) then begin
    ErrMsg:=Format(hhsHelpBrowserNotExecutable, [Executable]);
    exit;
  end;
  End; //added
  //debugln('THTMLBrowserHelpViewer.ShowNode Node.URL=',Node.URL);

  // create params and replace %ParamsStr for URL
  URLMacroPos:=Pos('%s',ParamsStr);
  if URLMacroPos>=1 then
    ReplaceSubstring(ParamsStr,URLMacroPos,2,Node.URL)
  else begin
    if ParamsStr<>'' then
      ParamsStr:=ParamsStr+' ';
    ParamsStr:=ParamsStr+Node.URL;
  end;

  {$IFNDEF DisableChecks}
  debugln('THTMLBrowserHelpViewer.ShowNode Executable="',Executable,'" Params="',ParamsStr,'"');
  {$ENDIF}

  // run
{$IFDEF Windows}  //Added
 If IsShellStr Then
  Begin
    If ShellExecute(0,'open',Pchar(Executable),Pchar(ParamsStr),'',SW_SHOWNORMAL)<=32 Then
     ErrMsg := Format(hhsHelpErrorWhileExecuting,[Executable+' ',ParamsStr, LineEnding, 'ShellExecute']) else
    Result := shrSuccess;
  end else
  {$IFEND} //Added
  try
    BrowserProcess:=TProcessUTF8.Create(nil);
    try
      BrowserProcess.InheritHandles:=false;
      BrowserProcess.Executable:=Executable;
      SplitCmdLineParams(ParamsStr,BrowserProcess.Parameters);
      BrowserProcess.Execute;
    finally
      BrowserProcess.Free;
    end;
    Result:=shrSuccess;
  except
    on E: Exception do begin
      ErrMsg:=Format(hhsHelpErrorWhileExecuting, [Executable+' '+ParamsStr, LineEnding, E.Message]);
    end;
  end;
end;

procedure THTMLBrowserHelpViewer.FindDefaultBrowser(out Browser, Params: string);
begin
  if FDefaultBrowser='' then
  begin
    if Assigned(OnFindDefaultBrowser) then
      OnFindDefaultBrowser(FDefaultBrowser, FDefaultBrowserParams);
  end;
  if FDefaultBrowser = '' then
    LCLIntf.FindDefaultBrowser(FDefaultBrowser, FDefaultBrowserParams);

  Browser := FDefaultBrowser;
  Params := FDefaultBrowserParams;

  //DebugLn('THTMLBrowserHelpViewer.FindDefaultBrowser Browser=',Browser,' Params=',Params);
end;

procedure THTMLBrowserHelpViewer.Assign(Source: TPersistent);
var
  Viewer: THTMLBrowserHelpViewer;
begin
  if Source is THTMLBrowserHelpViewer then begin
    Viewer:=THTMLBrowserHelpViewer(Source);
    BrowserPath:=Viewer.BrowserPath;
    BrowserParams:=Viewer.BrowserParams;
  end;
  inherited Assign(Source);
end;

procedure THTMLBrowserHelpViewer.Load(Storage: TConfigStorage);
begin
  BrowserPath:=Storage.GetValue('Browser/Path','');
  BrowserParams:=Storage.GetValue('Browser/Params','%s');
end;

procedure THTMLBrowserHelpViewer.Save(Storage: TConfigStorage);
begin
  Storage.SetDeleteValue('Browser/Path',BrowserPath,'');
  Storage.SetDeleteValue('Browser/Params',BrowserParams,'%s');
end;

function THTMLBrowserHelpViewer.GetLocalizedName: string;
begin
  Result:='HTML Browser';
end;

end.

lazhelphtml.pas (15,236 bytes)

wp

2019-12-14 13:44

reporter   ~0119837

Extracted the patch from jamie's post (0035659:0118718 ), relative to current trunk.

lazhelphtml.pas.patch (2,089 bytes)
Index: lcl/lazhelphtml.pas
===================================================================
--- lcl/lazhelphtml.pas	(revision 62380)
+++ lcl/lazhelphtml.pas	(working copy)
@@ -18,7 +18,7 @@
 interface
 
 uses
-  Classes, SysUtils,
+  {$IFDEF Windows}Windows,ShellApi, {$IFEND}Classes, SysUtils,
   // LazUtils
   LazFileUtils, UTF8Process, LazUTF8, LazConfigStorage,
   // LCL
@@ -207,7 +207,7 @@
   end;
   FullURL:=CombineURL(URLType,URLPath,URLParams);
   {$IFNDEF DisableChecks}
-  debugln('THTMLHelpDatabase.ShowURL B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
+    debugln('THTMLHelpDatabase.ShowURL B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
   {$ENDIF}
 
   // call viewer
@@ -320,6 +320,7 @@
   URLMacroPos: LongInt;
   BrowserProcess: TProcessUTF8;
   Executable, ParamsStr: String;
+  IsShellStr:Boolean = false; // added
 begin
   Result:=shrViewerError;
   ErrMsg:='';
@@ -352,6 +353,9 @@
   if (Length(Executable) > 1) and (Executable[1] = '"') and (Executable[Length(Executable)] = '"') then
     Executable := Copy(Executable, 2, Length(Executable)-2);
   {$endif windows}
+  IsShellStr := UpperCase(LeftStr(Executable,Pos(':',Executable)))='SHELL:'; //Added
+  if Not IsShellStr Then  //Added
+  Begin
   if (not FileExistsUTF8(Executable)) then begin
     ErrMsg:=Format(hhsHelpBrowserNotFound, [Executable]);
     exit;
@@ -360,7 +364,7 @@
     ErrMsg:=Format(hhsHelpBrowserNotExecutable, [Executable]);
     exit;
   end;
-
+  End; //added
   //debugln('THTMLBrowserHelpViewer.ShowNode Node.URL=',Node.URL);
 
   // create params and replace %ParamsStr for URL
@@ -378,6 +382,14 @@
   {$ENDIF}
 
   // run
+{$IFDEF Windows}  //Added
+ If IsShellStr Then
+  Begin
+    If ShellExecute(0,'open',Pchar(Executable),Pchar(ParamsStr),'',SW_SHOWNORMAL)<=32 Then
+     ErrMsg := Format(hhsHelpErrorWhileExecuting,[Executable+' ',ParamsStr, LineEnding, 'ShellExecute']) else
+    Result := shrSuccess;
+  end else
+  {$IFEND} //Added
   try
     BrowserProcess:=TProcessUTF8.Create(nil);
     try
lazhelphtml.pas.patch (2,089 bytes)

jamie philbrook

2019-12-14 14:52

reporter   ~0119842

although I haven't tried your version of the path it does look like the same basic alteration I've made which has been working great for me..

I was wondering what the added debugInfo
+ debugln('THTMLHelpDatabase.ShowURL B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
   {$ENDIF}

Just out of curiosity and not directly related to this , how does that work in the system for debugging, does that generate a debug output in a console window when enabled ?

wp

2019-12-14 17:32

reporter   ~0119846

> Just out of curiosity and not directly related to this , how does that work in the system for debugging,
> does that generate a debug output in a console window when enabled ?

Read: https://wiki.freepascal.org/LazLogger

Here: Uncheck the option "Win32 gui application" in "Project options" > "Compiler options" > "Config and targets" and see the debugLn output in the console window. Or leave this check box alone, but call the application with the argument --debug-log=name_of_log_file.txt, and see the debugln output in this logfile when the program has ended.

wp

2019-12-14 17:57

reporter   ~0119848

Applied with minor modifications, thanks. Please test again, and close if ok, otherwise reopen.

Issue History

Date Modified Username Field Change
2019-05-31 16:51 jamie philbrook New Issue
2019-06-02 01:11 jamie philbrook Note Added: 0116524
2019-06-02 01:24 jamie philbrook Note Edited: 0116524 View Revisions
2019-06-02 01:57 jamie philbrook Note Added: 0116525
2019-06-02 01:58 jamie philbrook Note Edited: 0116525 View Revisions
2019-06-02 02:26 jamie philbrook Note Added: 0116526
2019-06-02 04:02 jamie philbrook Note Edited: 0116526 View Revisions
2019-06-02 04:07 jamie philbrook Note Edited: 0116526 View Revisions
2019-06-03 05:06 jamie philbrook Note Added: 0116543
2019-10-18 19:24 Bart Broersma Note Added: 0118668
2019-10-18 22:49 jamie philbrook Note Added: 0118673
2019-10-18 23:47 jamie philbrook Note Added: 0118674
2019-10-18 23:57 Bart Broersma Note Added: 0118675
2019-10-19 01:20 jamie philbrook Note Added: 0118676
2019-10-19 01:21 jamie philbrook Note Edited: 0118676 View Revisions
2019-10-19 01:54 jamie philbrook Note Added: 0118677
2019-10-19 03:32 jamie philbrook Note Edited: 0118677 View Revisions
2019-10-19 19:52 jamie philbrook Note Added: 0118711
2019-10-19 23:31 jamie philbrook File Added: lazhelphtml.pas
2019-10-19 23:31 jamie philbrook Note Added: 0118718
2019-12-14 13:44 wp File Added: lazhelphtml.pas.patch
2019-12-14 13:44 wp Note Added: 0119837
2019-12-14 14:52 jamie philbrook Note Added: 0119842
2019-12-14 17:32 wp Note Added: 0119846
2019-12-14 17:48 wp Assigned To => wp
2019-12-14 17:48 wp Status new => assigned
2019-12-14 17:57 wp Status assigned => resolved
2019-12-14 17:57 wp Resolution open => fixed
2019-12-14 17:57 wp Fixed in Revision => 62387
2019-12-14 17:57 wp LazTarget => 2.0.8
2019-12-14 17:57 wp Note Added: 0119848
2020-01-12 14:28 Bart Broersma Relationship added related to 0036558