I am using TWebBrowser in DesignMode (Doc.DesignMode := 'On') to compose a HTML document. There is no document (HTML file on disk) loaded in TWebBrowser. I create the document from zero directly in TWebBrowser. The html code will be extracted from TWebBrowser and saved as c:/MyProjects/SomeHtmlName.html.
The problem is that it won't show images I insert if they have relative path.
More exactly, if I paste this code in the WebBrowser it will instantly display the image:
<IMG src="file:///c:/MyProjects/resources/R.PNG">
However, if I enter:
<IMG border=0 src="resources\R.PNG">
<IMG border=0 src="resources/R.PNG"> <---- preferred so it will work on Linux
it will display an image placeholder instead of the actual image.
I need relative paths so the web site will still work if I change the root path OR if I upload it on FTP.
procedure TForm1.Button1Click(Sender: TObject);
begin
LoadDummyPage;
SetHtmlCode('<img src="resources/test_img.PNG">');
Memo1.Text:= GetHtmlCode;
end;
function TForm1.LoadDummyPage: Boolean;
const FileName: string= 'c:\MyProject\_ONLINE WEB SITE\dummy.html';
begin
if not Assigned(wbBrowser.Document)
then wbBrowser.Navigate('about:blank');
Result := FileExists(FileName);
if Result
then wbBrowser.Navigate('file://' + FileName)
else Caption:= 'file not found';
end;
procedure TForm1.SetHtmlCode(const HTMLCode: string);
var
Doc: Variant;
begin
if not Assigned(wbBrowser.Document)
then wbBrowser.Navigate('about:blank');
Doc := wbBrowser.Document;
Doc.Write(HTMLCode);
Doc.Close;
Doc.DesignMode := 'On';
WHILE wbBrowser.ReadyState < READYSTATE_INTERACTIVE
DO Application.ProcessMessages;
Doc.body.style.fontFamily := 'Arial';
Doc.Close;
end;
function TForm1.GetHtmlCode: string; { Get the HTML code from the browser }
var
Doc: IHTMLDocument2;
BodyElement: IHTMLElement;
begin
if Assigned(wbBrowser.Document) and (wbBrowser.Document.QueryInterface(IHTMLDocument2, Doc) = S_OK) then
begin
BodyElement := Doc.body;
if Assigned(BodyElement) then
Result := BodyElement.innerHTML;
end;
if Result > ''
then Result := StringReplace(Result, '="about:', '="', [rfReplaceAll, rfIgnoreCase]); { Fix the 'How stop TWebBrowser from adding 'file:///' in front of my links' bug }
end;
You need to pre-load a valid HTML "template" string/stream including the BASE tag where you set the desired path (with trailing slash) e.g. "file:///c:/MyProjects/".
And switch to edit mode, where your images SRC should be relative e.g. "resources/R.PNG". Your final extracted HTML ater editing should be the body.innerHTML or body.outerHTML (whatever you need). You can even take the whole document source (google it).
Wrap the extracted source with valid HTML/Body WITHOUT the BASE tag and save to disk at c:\MyProjects.
but the code resulted for IMG SRC is full path!
Nothing much you can do about it. this is how the DOM represent the HTML - it's not necessary the HTML source code. this behavior is not consistent. and also depend on how you insert images (I do not use execCommand and have my own dialog and insert my own html code). You need to manually replace the extracted source "file:///c:/MyProjects/" with empty string. at least, this is how I do it.
Edit: You don't need to Navigate() to an external file. you can write the "template"/"empty" HTML via document.write(HTML).
Try this:
const
HTML_TEMPLATE = '<html><head><base href="file:///%s"></head><body style="font-family:Arial">%s</body></html>';
procedure TForm1.LoadHTML(HTMLCode: string);
var
Doc: Variant;
HTML, Path: string;
begin
Path := 'D:\Temp\';
HTML := Format(HTML_TEMPLATE, [Path, HTMLCode]);
WebBrowser1.Navigate('about:blank');
Doc := WebBrowser1.Document;
Doc.Write(HTML);
Doc.Close;
Doc.DesignMode := 'On';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LoadHTML('<b>Hello</b><img SRC="resources/1.png">');
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Doc: IHTMLDocument2;
begin
Doc := WebBrowser1.Document as IHTMLDocument2;
if Assigned(Doc) then
begin
ShowMessage(Doc.body.innerHTML);
end;
end;
The output for me is: <B>Hello</B><IMG src="resources/1.png">. in some cases the src might contain the full path. I can't 100% be sure to when this happens. but you need to be ready to deal with this situation by manually replacing the path. there is no conclusive documentation about this so I always deal with this issue in any case.
I suggest to use a small embedded web server such as Internet Direct (Indy) TIdHttpServer, which is able to serve all HTTP requests in a standard way. This removes all potential file system trouble.
Related
I have a Delphi app which prints HTML to PDF by opening the document in IE11 in the background and using the default PDF printer to print to PDF. This process works fine.
The issue is the following:
(Example I want to print 5 HTML documents to PDF.)
On the first run, it processes the first document fine, but then skips the rest with the following errors:
On Win Server 2016:
EOleSysErrorOLE A system shutdown has already been scheduled.
On Windows 10:
EOleSysErrorOLE error 8150002E
Then I wait until "iexplore.exe" closes, which takes a few sec.
From then, it processes all documents just fine regardless the number of the documents.
If I do not use the app for a long time (approx a day), it does the same as above.
It skips on the first run, then waits a few seconds and then us fine.
I tried to use OleVariant and IWebBrowser2, but both have the same outcome.
I close the Object with .Quit. (see in code below). I also tried Unassigned, Free, setting the Object to Null before creating a new object. None of them worked. Same outcome.
Here are a few thing which I tried as a workaround:
If I do not use .Quit, it works fine, but obviously won't close any iexplore.exe.
Also, if I open an IE window (GUI) and minimize it, the HTML-PDF process works fine.
I also tried to call to create a background IE object on TMainForm.FormCreate() when the app starts, and it works as well.
When it gets to the HTML-PDF process, it creates a new IE background object (additional "iexplore.exe") and closes it by leaving the one created on FormCreate().
I would like to figure out why it just cannot create and close an object fast enough on the first run (without having an IE opened or without using .Quit).
Here is the code:
Note: The program also writes some stuff to the registry, but I cut some lines for simplicity (I also might cut a few end here and there. Note that the function works fine apart than the issue above).
function THTMLMergeDocument.FilePrint: boolean;
var
BrowserObject: OleVariant;
ie : IWebBrowser2;
vaIn, vaOut: OleVariant;
OldHeader, OldFooter, OldPrinterName: String;
OldOrientation: Integer;
Registry : TRegistry;
ST, TOutVal: TDateTime;
sUrl : string;
Flag, TargetFrameName, PostData, Headers : OleVariant;
begin
result := false;
try
if fPrinterName = VTPrint.GetDefaultPrinter then
begin
try
//Tried OleVariant
{
BrowserObject := Unassigned;
BrowserObject := CreateOleObject('InternetExplorer.Application');
BrowserObject.Silent := true;
BrowserObject.Visible := false;
BrowserObject.Navigate('file:\\'+DocumentFileName);
BrowserObject.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER);
while BrowserObject.Busy or BrowserObject.ReadyState <> READYSTATE_COMPLETE do
begin
Application.ProcessMessages;
end;
}
//Tried IWebBrowser2
ie := CoInternetExplorer.Create;
sUrl := 'file:\\'+DocumentFileName;
ie.Navigate(sUrl, Flag, TargetFrameName, PostData, Headers);
ie.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,vaIn,vaOut);
while ie.ReadyState <> READYSTATE_COMPLETE do
begin
Application.ProcessMessages;
end;
if (PDFOutput) then
begin
ST := Now;
TOutVal := EncodeTime(0,DocumentServerOptions.PDFConverterTimeOutInterval,0,0);
while not PDF.Completed and (Now-ST<TOutVal) do
Application.ProcessMessages;
if PDF.Completed then
result := true
else
WinWordLogProc('ERROR: No response received from PDF converter');
end
else
begin
result := true;
end;
ie.Quit; //close IWebBrowser2 object
BrowserObject.Quit; //close OleVariant object
except on E: Exception do
WinWordLogProc( 'Error class: ' + E.ClassName + #13 + E.Message);
end;
end
else
begin
WinWordLogProc('Error setting default printer to '+fPrinterName);
end;
finally
VTPrint.SetDefaultPrinter(OldPrinterName);
end;
`
I suspect that it has something do do with the IE object handling, but I'm not sure, hence asking for help here.
The browser's Navigate() method is asynchronous. You should wait for the document to finish loading before you then call ExecWB() to print the document, not after calling it.
I've been trying to figure this out for a few days and I've kind of exhausted even the most effective of google searching. What I've been trying to do is to open a file of the type HTML and with Go's library (http://golang.org/x/net/html) modify the img tags and their source to a known directory and set of files. So far I've been able to find the elements using this,
//Open the file and return a variable called file.
file, _ = os.Open(file.Name())
//Create the doc
doc, err := html.Parse(file)
//Check for err when generating the doc
check(err)
//Look for tags with img using an anonymous function.
var f func(*html.Node)
f = func(n *html.Node) {
if n.Type == html.ElementNode && n.Data == "img" {
for _, img := range n.Attr {
if img.Key == "src" {
str := breakdownURL(img.Val) //Gets the ../../resource/(thing.h23.jpg) <-- That
//Creating a static address to add to the dynamic one
address := filepath.Join(filepath.Join("Resources", getFileNotExt(file)), str)
img.Val = address
break
}
}
}
for at := n.FirstChild; at != nil; at = at.NextSibling {
f(at)
}
}
f(doc)
That's been able to find the elements and append the correct directory but it's only modifying this doc file. I have no clue how to append it to the actual file. The only thought that I have is opening the doc as some kind of writing way and copying the new data from the doc to the file. Any help is greatly appreciated! Thank you so much for taking your time :).
You should definitely save the edited document.
First, open the file for read/write and truncate:
file, err := os.OpenFile("sample.html", os.O_RDWR | os.O_TRUNC, 0644)
And after you finish processing, override the original file:
html.Render(file, doc)
I am implementing an application using Delphi XE2 Rest/JSON Server and jQTouch client. I have pretty much finished the server side and am now moving onto the client side development.
I have downloaded the jQTouch source and have set it up under IIS on port 8081 of my PC. This works fine.
But I need the static demo source to be accessible via a Delphi WebFileDispatcher.
This is where I have the problem...
As a stripped down test/proof, I have set this up using the Web Broker / Web Server Application / Standalone VCL wizard, and dropped a WebFileDispatcher onto the Web Module. The only config has been to configure the 'Root' of the WebFileDispatcher to pick up the content.
Here's the problem reproduced in its most simple form:
I can access the content via IIS on port 8081.
I can access the content via Web Broker on port 8080.
Both using exactly the same localhost URL, just different ports.
So I know my paths and basic config are correct.
BUT... the 'Greater Than' or 'Right Arrows' on the jQTouch menu items are appearing as an 'a' with a circumflex when the content is server up from Web Broker. The green external link arrows are appearing with a Euro symbol on them.
The content appears without any problem when server up from IIS.
The problem appears to be the charset that is being appended to the content-type by code in the IdHTTPHeaderInfo unit. This unit is adding 'charset=8859-1' when the html and css files are UTF-8.
I can fix this by changing the MimeTypes defined in the WebFileExtensions property of the WebFileDispatcher to include charset=UTF-8. i.e. change the entry for 'text/html' to 'text/html; charset=UTF-8'.
But should this be required? I don't think so. I think that either:
A) If Delphi includes a web server that is serving these files and its default is to assume all text files are 8859-1, then the mime types of the web dispatcher should be setup to override this to the correct value of UTF-8.
B) Or the files should be checked for head meta tags for the actual encoding to be reported in the response.
At the moment, neither of these seem to be the case.
Would anybody else class this as a bug that needs reporting?
It has taken two days to narrow the problem down this far, and I wouldn't want anyone else to have to do this in the future.
See W3.org - Handling Character Encodings
To reproduce, just download the latest jQTouch release and map the content to a WebFileDispatcher.
Here are two images that show the problem:
![enter image description here][2]
Also, below are the Delphi files relating to the configuration of the Web Module..
Here is the PAS file...
unit WebModuleUnit1;
interface
uses System.SysUtils, System.Classes, Web.HTTPApp;
type
TWebModule1 = class(TWebModule)
WebFileDispatcher1: TWebFileDispatcher;
procedure WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
WebModuleClass: TComponentClass = TWebModule1;
implementation
{$R *.dfm}
procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.Content := '<html><heading/><body>Web Server Application</body></html>';
end;
end.
And here is the dfm...
object WebModule1: TWebModule1
OldCreateOrder = False
Actions = <
item
Default = True
Name = 'DefaultHandler'
PathInfo = '/'
OnAction = WebModule1DefaultHandlerAction
end>
Height = 230
Width = 415
object WebFileDispatcher1: TWebFileDispatcher
WebFileExtensions = <
item
MimeType = 'text/css'
Extensions = 'css'
end
item
MimeType = 'text/html'
Extensions = 'html;htm'
end
item
MimeType = 'text/javascript'
Extensions = 'js'
end
item
MimeType = 'image/jpeg'
Extensions = 'jpeg;jpg'
end
item
MimeType = 'image/x-png'
Extensions = 'png'
end>
WebDirectories = <
item
DirectoryAction = dirInclude
DirectoryMask = '*'
end
item
DirectoryAction = dirExclude
DirectoryMask = '\templates\*'
end>
RootDirectory = 'C:\WebRoot'
Left = 80
Top = 64
end
end
[2]:
I'm making a Delphi XE5 VCL Forms Application with a TIdHTTPServer on the main form and a CommandGet of the IdHTTPServer procedure:
procedure TForm1.IdHTTPServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var pageContent: TStringList;
begin
if pos('&command=add', ARequestInfo.UnparsedParams) > 0 then
begin
pageContent:= TStringList.Create;
try
pageContent.Add('<html>');
pageContent.Add('<head>');
pageContent.Add('<title>Profile</title>');
pageContent.Add('</head>');
pageContent.Add('<body>');
pageContent.Add('<input id="subjects" type="text"/>');
pageContent.Add('<input id="Add" type="button" onclick="sendData()"/>');
pageContent.Add('</body>');
pageContent.Add('</html>');
AResponseInfo.ContentText := pageContent.Text;
finally
pageContent.Free;
end;
end;
end;
My question is how the user input is send to the server when the user clicks the button 'Add'.
With this HTML, the client (web browser) will not send any data because there is no HTML form element present.
I am trying to save the contents of a TRichMemo to TMemoryStream, and then be able to load the formatted data back from the stream into the rich memo.
The problem is LoadRichText is failing for some reason. I know the data is been saved to my stream because I can actually save it fo file as rtf and view it externally.
This is basically what I have:
var
FMyStream: TMemoryStream;
To save:
RichMemo1.SaveRichText(FMyStream);
To load:
FMyStream.Seek(0, soBeginning);
if not RichMemo1.LoadRichText(FMyStream) then
raise Exception.Create('Failed to load data from stream.');
As I said the data is saved to stream correctly, but trying to load into the rich memo is hitting my exception everytime.
What could be the problem?
The code for the LoadRichText function is:
function TCustomRichMemo.LoadRichText(Source: TStream): Boolean;
begin
if Assigned(Source) and HandleAllocated then begin
Result := TWSCustomRichMemoClass(WidgetSetClass).LoadRichText(Self, Source);
if not Result and Assigned(RTFLoadStream) then begin
Self.Lines.BeginUpdate;
Self.Lines.Clear;
Result:=RTFLoadStream(Self, Source);
Self.Lines.EndUpdate;
end;
end else
Result := false;
end;
and SaveRichText code:
function TCustomRichMemo.SaveRichText(Dest: TStream): Boolean;
begin
if Assigned(Dest) and HandleAllocated then begin
Result := TWSCustomRichMemoClass(WidgetSetClass).SaveRichText(Self, Dest);
if not Result and Assigned(RTFSaveStream) then
Result:=RTFSaveStream(Self, Dest);
end else
Result := false;
end;
Thanks.
Ok, I found the solution to my problem.
At first I created a simple test project and LoadRichText and SaveRichText worked, which meant the problem was within my code somewhere...
My stream is declared in a class in a separate unit. In another form I have my rich memo control, when the form is closed the data is saved to the stream, that part I knew worked because I could save it to file and view it externally.
The problem was when I was creating the form that contains my rich memo, I was calling LoadRichText from the FormCreate event. So I moved it into FormActivate and now it works without error.