24 February 2010

Call JavaScript in a TWebBrowser and get a result back

Calling a JavaScript function in a TWebBrowser is easy, but getting a return value from it is hard. I've been struggling for ages to find an answer to this, and lots of users have asked. My article "How to call JavaScript functions in a TWebBrowser from Delphi" goes into details.

Christian Sciberras suggested a solution that depended on modifying the HTML source to include a hidden input field and modifying the function stores its result in the field. I've wanted a tidier solution that didn't involve changing either the HTML code or the JavaScript function, because we can't always do that.

I've now got a solution based on Christian's:

  1. Create a hidden input field in the current document with a unique id.
  2. Wrap the required function call in JavaScript that calls the function and stores its return value in the input field.
  3. Read the value from the input field and return it.

It's a bit of a dirty hack, and it only works if the function's return value can be represented as a string. For what it's worth, here it is:

We'll create a little class called TJSExec:

type
  TJSExec = class(TObject)
  private
    fWB: TWebBrowser;
    function GetDocWindow: IHTMLWindow2;
    function GetElementById(const ID: string): IHTMLElement;
    function GetRetValContainer: IHTMLElement;
    function CreateRetValContainer: IHTMLElement;
  public
    constructor Create(const WB: TWebBrowser);
    procedure RunJSProc(const Fn: string);
    function RunJSFn(const Fn: string): string;
  end;

GetDocWindow and GetElementById are just helpers that get the IHTMLWindow2 interface to the current document and find an element with a given ID:

function TJSExec.GetDocWindow: IHTMLWindow2;
var
  Doc: IHTMLDocument2;
begin
  if not Supports(fWB.Document, IHTMLDocument2, Doc) then
    raise Exception.Create('Invalid document');
  Result := Doc.parentWindow;
  if not Assigned(Result) then
    raise Exception.Create('No document window');
end;

function TJSExec.GetElementById(const ID: string): IHTMLElement;
var
  Doc: IHTMLDocument3;
begin
  if not Supports(fWB.Document, IHTMLDocument3, Doc) then
    raise Exception.Create('Invalid document');
  Result := Doc.getElementById(ID);
end;

CreateRetValContainer and GetRetValContainer create and find the hidden input field:

function TJSExec.CreateRetValContainer: IHTMLElement;
var
  Doc: IHTMLDocument2;
begin
  if not Supports(fWB.Document, IHTMLDocument2, Doc) then
    raise Exception.Create('Invalid document');
  Result := Doc.createElement('input');
  Result.id := cRetValElemId;
  Result.setAttribute('name', cRetValElemId, 0);
  Result.setAttribute('type', 'hidden', 0);
  Result.setAttribute('value', '', 0);
end;

function TJSExec.GetRetValContainer: IHTMLElement;
var
  NewNode: IHTMLDOMNode;
  BodyNode: IHTMLDOMNode;
  Doc: IHTMLDocument2;
begin
  Result := GetElementById(cRetValElemId);
  if not Assigned(Result) then
  begin
    if not Supports(fWB.Document, IHTMLDocument2, Doc) then
      raise Exception.Create('Invalid document');
    if not Supports(Doc.body, IHTMLDOMNode, BodyNode) then
      raise Exception.Create('Invalid body node');
    Result := CreateRetValContainer;
    if not Supports(Result, IHTMLDOMNode, NewNode) then
      raise Exception.Create('Invalid new node');
    BodyNode.appendChild(NewNode);
  end;
end;

GetRetValContainer tries to find the hidden input field and, if it doesn't exist, calls CreateRetValContainer. This method manipulates the DOM to append a hidden input field to the current document. In this way repeated calls to JavaScript function re-use the hidden field once it has been created.

RunJSProc just calls a JavaScript function without getting its return value. It is useful when no return value is needed or available.

procedure TJSExec.RunJSProc(const Fn: string);
var
  Wdw: IHTMLWindow2;
begin
  try
    Wdw := GetDocWindow;
    Wdw.execScript(Fn, 'JavaScript'); // execute function
  except
    // swallow exception to prevent JS error dialog
  end;
end;

RunJSFn is where the action is. The key is the use of the JavaScript eval function to store the function result in the hidden input. It finds the field from its id and stores the function result its value attribute. RunJSFn then gets its return value from the field.

function TJSExec.RunJSFn(const Fn: string): string;
var
  EmbedFn: string;
  WrapperFn: string;
  HiddenElem: IHTMLElement;
const
  WrapperFnTplt = 'eval("'
    + 'id = document.getElementById(''' + cRetValElemId + '''); '
    + 'id.value = %s;'
    + '")';
begin
  EmbedFn := StringReplace(Fn, '"', '\"', [rfReplaceAll]);
  EmbedFn := StringReplace(EmbedFn, '''', '\''', [rfReplaceAll]);
  HiddenElem := GetRetValContainer;
  WrapperFn := Format(WrapperFnTplt, [EmbedFn]);
  RunJSProc(WrapperFn);
  Result := HiddenElem.getAttribute('value', 0);
end;

The constructor just records the browser control that contains the relevant document.

constructor TJSExec.Create(const WB: TWebBrowser);
begin
  inherited Create;
  fWB := WB;
end;

Finally, we use a GUID as the id of the hidden input field to try to ensure it is unique in the document:

const
  cRetValElemId = 'id58A3A2A46539468A943D00FDD6A4FF08';

So there we have it - at last a way to get a value from a JavaScript function. But, what about functions that don't return values that make sense when cast to strings: what if the function returns an object such as Date? Leave a comment if you have ideas please.

This source code, along with a demo project for Delphi 2010 is available in my Delphi Doodlings repository. View the code.

21 February 2010

Code Library Newsletter

Just lately I've spent a lot of time bringing my rather dusty code library up to date.

The library has been established as a project on GoogleCode (ddab-lib) and the code is gradually being moved into the project's Subversion repository.

A wiki documenting the library is also hosted on the same GoogleCode project.

There has been enough activity here to warrant setting up a newsletter to notify changes to the library. If interested you can sign up on my main site. I aim to launch it early in March.

19 February 2010

Unicode environment blocks and CreateProcess

I've just been struggling with a Unicode conversion of some code that passes a custom environment block to a child process.

On Unicode Delphi compilers the code produces a Unicode environment block, and I'd done something like this...

procedure ExecProgWithUnicodeEnv(const ProgName: string; EnvBlock: Pointer);
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  SafeProgName: string;
begin
  SafeProgName := ProgName;    // workaround for read-only lpCommandLine
  UniqueString(SafeProgName);  // param to CreateProcessW
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);
  CreateProcess(
    nil, PChar(ProgName), nil, nil, True,
    0, EnvBlock, nil, SI, PI
  );
end;

If you're wandering about that UniqueString stuff, check out this post.

The assumption was that CreateProcessW would expect a Unicode environment block. Wrong! It actually still expects an ANSI block by default.

A dig around in the API docs revealed the answer: If you pass a Unicode environment block to CreateProcess in the lpEnvironment parameter you must also include CREATE_UNICODE_ENVIRONMENT in the dwCreationFlags parameter. So it's just a matter of changing

  ...
  CreateProcess(
    nil, PChar(ProgName), nil, nil, True,
    0, EnvBlock, nil, SI, PI
  );
  ...

to

  ...
  CreateProcess(
    nil, PChar(ProgName), nil, nil, True,
    CREATE_UNICODE_ENVIRONMENT, EnvBlock, nil, SI, PI
  );
  ...

In the end, because my project guarantees a Unicode environment block if and only if it is compiled on a Unicode Delphi, I went for code similar to the following:

  ...
  {$IFDEF UNICODE}
  CreateFlags := CREATE_UNICODE_ENVIRONMENT;
  {$ELSE}
  CreateFlags := 0;
  {$ENDIF}
  CreateProcess(
    nil, PChar(SafeProgName), nil, nil, True,
    CreateFlags, EnvBlock, nil, SI, PI
  );
  ...

You definately shouldn't use conditional compilation like this if there's a chance you'll be handling an ANSI environment block with a Unicode compile, or vice-versa.

There we have it, just one more thing to consider when porting code to Unicode.

And the code in question? It's part of the demo for my article "How to access environment variables".

18 February 2010

URL Encoding

I've being reviewing the URI encoding code from the Code Snippets Database and I realised that it doesn't comply with RFC 3986.

So here's my first attempt at some compliant code.

According to the RFC:

"the data should first be encoded as octets according to the UTF-8 character encoding [STD63]; then only those octets that do not correspond to characters in the unreserved set should be percent-encoded."

So, we define the URIEncode function to operate on the UTF8String type. It's easy to encode UnicodeString and AnsiString into UTF using the System unit's UTF8Encode overloaded functions. You can overload URIEncode to do the UTF8 conversion, but I haven't done here.

There's a nice shortcut we can take when url encoding. Remember only unreserved characters are percent-encoded. The set of unreserved characters is:

const
  cURLUnreservedChars = [
    'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.', '~'
  ];

All other characters are percent encoded. But what about any UTF-8 continuation bytes? Well, by definition these have value > $80. And all the unreserved characters have ordinal value < $80. This means that no legal continuation character can be an unreserved character.

Therefore any byte in the UTF-8 string can be treated the same regardless of whether it's a lead or continuation character: i.e. we percent encode it if it's not an unreserved character.

Here's the function:

// Assumes Defined(UNICODE)
function URIEncode(const S: UTF8String): string; overload;
var
  Ch: AnsiChar;
begin
  // Just scan the string an octet at a time looking for chars to encode
  Result := '';
  for Ch in S do
    if CharInSet(Ch,  cURLUnreservedChars) then
      Result := Result + WideChar(Ch)
    else
      Result := Result + '%' + IntToHex(Ord(Ch), 2);
end;

This, and more similar routines, are available (and may even be evolving) in my Delphi Doodlings repo. View the code (see UURIEncode.pas).

Welcome to the new DelphiDabbler blog

Welcome to this new blog, which I'm thinking of as an extension to DelphiDabbler.com where more peripheral programming stuff can be discussed.

I'll also use it for news of happenings on the main site.

Will I keep up with it? Let's see how it goes!