Page 3 of 5 FirstFirst 12345 LastLast
Results 21 to 30 of 43

Thread: Luna Game Pascal

  1. #21
    Hi, yea sure. Here is the handler for the test project i'm working this evening. I just figured out how to prevent the new browser window popup Problem. You have to cancel it and then do a new navigation to the URL. The problem now is how to keep the link content within the frame. When you click on a link, the URL will be something like this: lgp://index.html/and.html, this will display and.html within the frame contents of index.html. Gosh, I can't rem now how I made this work. I don't have the old project code version where I got all these little PITA things sorted out. I rem now running up against each one and sorting them out one by one. Once I can get the frame thing sorted out, then I can start trying to read from zip.


    Code:
    procedure TForm2.MyProtocolHandler(aURL: string; var aMIMEType: string;
      const aPostMIMEType: string; const aPostData: array of byte;
      aMemoryStream: TCustomMemoryStream); // TProtocolCallback
    var
      fn: string;
    
    
      procedure WriteOutString(const aStr: string);
      var
        utf8Out: UTF8String;
      begin
        utf8Out := UTF8Encode(aStr);
        aMemoryStream.WriteBuffer(Pointer(utf8Out)^,
          Length(utf8Out) * SizeOf(AnsiChar));
      end;
    
    
      procedure WriteOutFile(const aFilename: string);
      var
        ms: TMemoryStream;
      begin
        ms := TMemoryStream.Create;
        try
          ms.LoadFromFile(aFilename);
          ms.SaveToStream(aMemoryStream);
        finally
          ms.Free;
        end;
      end;
    
    
      procedure WriteOutTextFile(const aFilename: string);
      var
        ms: TStringList;
      begin
        ms := TStringList.Create;
        try
          ms.LoadFromFile(aFilename);
          WriteOutString(ms.Text);
        finally
          ms.Free;
        end;
      end;
    
    
      function FindMimeType(const url: WideString): string;
      var
        mimetype: PWideChar;
      begin
        mimetype := nil;
        FindMimeFromData(nil, PWideChar(URL), nil, 0, nil, 0, mimetype, 0);
        Result := mimetype;
      end;
    
    
    begin
      // remove any slashes from the front
      while (aURL <> '') and (aURL[1] = '/') do
        Delete(aURL, 1, 1);
      // remove any slashes from the back
      while (aURL <> '') and (aURL[Length(aURL)] = '/') do
        Delete(aURL, Length(aURL), 1);
    
    
      if aURL.Contains('index.html?') then
        aURL := aURL.Replace('index.html?', '')
      else
        aURL := aURL.Replace('index.html/', '');
      if aURL.IsEmpty then
        aURL := 'index.html';
    
    
      // get mime type
      aMIMEType := FindMimeType(aURL);
    
    
      fn :=  TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'HTML\' + aURL);
      WriteOutFile(fn);
    end;
    
    
    procedure TForm2.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
      bstrUrl: WideString);
    begin
      Cancel := True;
      WebBrowser1.Navigate(bstrUrl);
    end;
    Last edited by drezgames; 22-06-2017 at 12:50 AM.

  2. #22
    @SilverWarior,

    Ok, this is what I got. I can now click on the local links and they will open up properly inside the frame of the help system. SWEET! Now, the last nagging thing is getting the javascript to work.

    Code:
    procedure TForm2.FormCreate(Sender: TObject);begin
    
    
      FMimeTable := TIdMimeTable.Create;
      NewHttpProtocolHandler('lgp', MyProtocolHandler);
      WebBrowser1.Silent := True;
      WebBrowser1.Navigate('lgp://index.html');
    end;
    
    procedure TForm2.MyProtocolHandler(aURL: string; var aMIMEType: string;
      const aPostMIMEType: string; const aPostData: array of byte;
      aMemoryStream: TCustomMemoryStream); // TProtocolCallback
    
    
      procedure WriteOutString(const aStr: string);
      var
        utf8Out: UTF8String;
      begin
        utf8Out := UTF8Encode(aStr);
        aMemoryStream.WriteBuffer(Pointer(utf8Out)^,
          Length(utf8Out) * SizeOf(AnsiChar));
      end;
    
    
      procedure WriteOutFile(const aFilename: string);
      var
        ms: TMemoryStream;
      begin
        ms := TMemoryStream.Create;
        try
          ms.LoadFromFile(aFilename);
          ms.SaveToStream(aMemoryStream);
        finally
          ms.Free;
        end;
      end;
    
    
      procedure WriteOutTextFile(const aFilename: string);
      var
        ms: TStringList;
      begin
        ms := TStringList.Create;
        try
          ms.LoadFromFile(aFilename);
          WriteOutString(ms.Text);
        finally
          ms.Free;
        end;
      end;
    
    
      function FindMimeType(const url: WideString): string;
      var
        mimetype: PWideChar;
      begin
        mimetype := nil;
        FindMimeFromData(nil, PWideChar(URL), nil, 0, nil, 0, mimetype, 0);
        Result := mimetype;
      end;
    
    
      function GenFilename(url: string): string;
      begin
        Result :=  TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'HTML\' + url);
      end;
    
    
    begin
      // remove any slashes from the front
      while (aURL <> '') and (aURL[1] = '/') do
        Delete(aURL, 1, 1);
      // remove any slashes from the back
      while (aURL <> '') and (aURL[Length(aURL)] = '/') do
        Delete(aURL, Length(aURL), 1);
    
    
      // index.html/? indicate a frame operation
      if aURL.Contains('index.html/?') then
      begin
        // remove index.html/? from the url
        aURL := aURL.Replace('index.html/?', '');
    
    
        // load in the frame
        WriteOutFile(GenFilename('index.html'));
      end;
    
    
      // check for index.html/
      if aURL.Contains('index.html/') then
      begin
        // remove from url
        aURL := aURL.Replace('index.html/', '');
      end;
    
    
      // if empty endpoint is the frame index else endpoint is a specific file
      if aURL.IsEmpty then
        aURL := 'index.html';
    
    
      // get mime type of file
      aMIMEType := FindMimeType(aURL);
    
    
      // load the file
      WriteOutFile(GenFilename(aURL));
    end;
    
    
    procedure TForm2.WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
      const URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
      var Cancel: WordBool);
    begin
      //
      Statusbar1.SimpleText := URL;
    end;
    
    
    procedure TForm2.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
      bstrUrl: WideString);
    var
      s: string;
    begin
      // cancel new window operation
      Cancel := True;
    
    
      // get the url
      s := bstrURL;
    
    
      // modify url to indicate a frame load operation,
      s := s.Replace('index.html/', 'index.html?');
    
    
      // navigate to modified url that indicates a frame load operation
      WebBrowser1.Navigate(s);
    end;

  3. #23
    Ok, I got it reading from the zip file. Seem to work ok. The one problem i'm seeing is that I can not get the index items to collapse. Not sure what's going there, but everything else seems to be working.

    Inkedhelpviewer_LI.jpg

  4. #24
    Quote Originally Posted by piradyne View Post
    Ok, I got it reading from the zip file. Seem to work ok. The one problem i'm seeing is that I can not get the index items to collapse. Not sure what's going there, but everything else seems to be working.
    I'm not sure but not being able to collapse index tree might be due the fact that by default pages that are being displayed in TWebBrowser component or whenever any third part program is using IWebBrowser interface are being opened in backward compatibility mode. In order to avoid that your program must be registered as a Web Browser. See the link bellow for more information
    https://stackoverflow.com/a/25843958

    Any way with the help of your posted code I can now display and navigate Platform eXtended documentation properly as it consists of just bunch of self contained HTML files (no use of frames). So I don't even need the code in OnNewWindow3 event.

  5. #25
    Oh sweet! You got it working. NICE!!

    Ok, I will check out the link. Thanks.

  6. #26
    Oh oh! To use the frames, you simple have to do this:

    Code:
    procedure TForm2.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
      bstrUrl: WideString);
    var
      s: string;
    begin
      // cancel new window operation
      Cancel := True;
      WebBrowser1.Navigate(bstrURL, '', 'hmcontent');
    end;
    Just specify the frame name and it will "just work" without all the extra loading I was doing before.

    Code:
    begin  // remove any slashes from the front
      while (aURL <> '') and (aURL[1] = '/') do
        Delete(aURL, 1, 1);
      // remove any slashes from the back
      while (aURL <> '') and (aURL[Length(aURL)] = '/') do
        Delete(aURL, Length(aURL), 1);
    
    
      // check for index.html/
      if aURL.Contains('index.html/') then
      begin
        // remove from url
        aURL := aURL.Replace('index.html/', '');
      end;
    
    
      // if empty its the room else endpoint is a file
      if aURL.IsEmpty then
        aURL := 'index.html';
    
    
      // get mime type of file
      aMIMEType := FindMimeType(aURL);
    
    
      // load the file
      WriteOutFile(GenFilename(aURL));
    end;

    Now, on to javascript issues. Oh, I tried the emulation and some other stuff, not working so far. Grrrr!

  7. #27
    Could you provide sample of your help webpages you use. After searching my computer I have no webpages which would be utilizing Frames, so I can't see and diagnose problems you are facing. Therefore I can't actually help but only speculate of what might be wrong.

  8. #28
    Hi, yea sure. Thanks. This link!

  9. #29
    Just tested your help and it seems that there is a problem in FindMimeType function becouse it always returns empty string when it is checking Mime Type of Java Scripts (.js files). Consequently no Java Scripts are loaded properly. I guess.

  10. #30
    I'm getting 'text/plain' for everything except the image files. I just added this:

    Code:
    if TPath.GetExtension(aURL) = '.js' then
        aMIMEType := 'application/javascript';
    Still get those errors.

    Interestingly, if you do this: WebBrowser1.Navigate('file:///' + TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'HTML\index.html')), it all works as expected. So the Twebbrowser component can execute the javascript, there is something missing here that we need to do when running it through the protocol handler.

    I've been goodling/bing'ing for hours, trying different things.... nothing so far. Sigh.

Page 3 of 5 FirstFirst 12345 LastLast

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •