The Road to Delphi – a Blog about programming

Delphi – Free Pascal – Oxygene


1 Comment

Enabling XPath (selectNode, selectNodes) methods in Vcl and FireMonkey Apps

The TXMLDocument class allow you to manipulate XML files in VCL and FireMonkey Apps, but this class doesn’t implements a direct way to call the XPath related methods (selectNode, selectNodes) , so you must write a set of helper functions to call these methods.

Normally you can write something like so

 
function selectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  Result:=LDomNodeSelect.selectNode(nodePath);
end;

 
function SelectNodes(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNodeList;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  Result:=LDomNodeSelect.selectNodes(nodePath);
end;

And use like so.

 
var
  XmlDoc: IXMLDocument;
  LNode : IDOMNode;
  i : Integer;
begin
  XmlDoc := TXMLDocument.Create(nil);
  XmlDoc.Active := True;
  XmlDoc.Options := XmlDoc.Options + [doNodeAutoIndent];
  XmlDoc.Version := '1.0';
  ...
  ...
  LNode:=selectSingleNode(XmlDoc.DOMDocument,XPathExpr);

The above code will works fine under Windows using the MSXML provider as Default DOM Vendor, but in a FireMonkey Application which must run in OSX and Windows you must set the Default DOM Vendor to ADOM (OpenXML).

 
 DefaultDOMVendor := OpenXML4Factory.Description;

Now if you try to use the above functions (selectSingleNode, SelectNodes) under the ADOM vendor you will get an awfull exception

 
EOleException Catastrophic failure 8000FFFF

The root of this issue is located in the Tox4DOMNode.selectNode and Tox4DOMNode.selectNodes implementation of these methods, check the next code.

 
function Tox4DOMNode.selectNode(const nodePath: WideString): IDOMNode;
var
  xpath: TXpathExpression;
  xdomText: TDomText;
begin
  Result := nil;
  if not Assigned(WrapperDocument) or not Assigned(WrapperDocument.WrapperDOMImpl) then
    Exit;

  xpath := WrapperDocument.WrapperDOMImpl.FXpath; //here the xpath is set with a nil value because the FXpath was no initialized  
  xpath.ContextNode := NativeNode; //Here the App crash because xpath is nil

The FXpath field is initialized in the Tox4DOMImplementation.InitParserAgent method which is never call at least which you uses the Tox4DOMImplementation.loadFromStream or Tox4DOMImplementation.loadxml methods. So to fix this issue you must call the Tox4DOMImplementation.InitParserAgent function before to call the selectNode and selectNodes methods.

 
function selectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  if (DefaultDOMVendor = OpenXML4Factory.Description) then
    Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent;
  Result:=LDomNodeSelect.selectNode(nodePath);
end;
 
function SelectNodes(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNodeList;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  if (DefaultDOMVendor = OpenXML4Factory.Description) then
    Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent;
  Result:=LDomNodeSelect.selectNodes(nodePath);
end;

Now with these changes you will able to evaluate XPath expressions in VCL and FireMonkey Apps using the ADOM vendor.

This is a demo console App tested in Windows and OSX (XE2 and XE4)

 
{$APPTYPE CONSOLE}

uses
  {$IFDEF MSWINDOWS}
  System.Win.ComObj,
  Winapi.ActiveX,
  {$ENDIF}
  System.SysUtils,
  Xml.XMLIntf,
  Xml.adomxmldom,
  Xml.XMLDom,
  Xml.XMLDoc;

function selectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  if (DefaultDOMVendor = OpenXML4Factory.Description) then
    Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent;
  Result:=LDomNodeSelect.selectNode(nodePath);
end;

function SelectNodes(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNodeList;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  if (DefaultDOMVendor = OpenXML4Factory.Description) then
    Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent;
  Result:=LDomNodeSelect.selectNodes(nodePath);
end;

procedure  TestXPath;
var
  XmlDoc: IXMLDocument;
  Root, Book, Author, Publisher : IXMLNode;
  LNodeList : IDOMNodeList;
  LNode : IDOMNode;
  i : Integer;
begin
  XmlDoc := TXMLDocument.Create(nil);
  XmlDoc.Active := True;
  XmlDoc.Options := XmlDoc.Options + [doNodeAutoIndent];
  XmlDoc.Version := '1.0';

  Root := XmlDoc.CreateNode('BookStore');
  Root.Attributes['url'] := 'http://www.amazon.com';
  XmlDoc.DocumentElement := Root;

  Book := XmlDoc.CreateNode('Book');
  Book.Attributes['Name'] := 'Steve Jobs';
  Author := XmlDoc.CreateNode('Author');
  Author.Text := 'Walter Isaacson';
  Publisher := XmlDoc.CreateNode('Publisher');
  Publisher.Text := 'Simon Schuster (October 24, 2011)';
  Root.ChildNodes.Add(Book);
  Book.ChildNodes.Add(Author);
  Book.ChildNodes.Add(Publisher);

  Book := XmlDoc.CreateNode('Book');
  Book.Attributes['Name'] := 'Clean Code: A Handbook of Agile Software Craftsmanship';
  Author := XmlDoc.CreateNode('Author');
  Author.Text := 'Robert C. Martin';
  Publisher := XmlDoc.CreateNode('Publisher');
  Publisher.Text := 'Prentice Hall; 1 edition (August 11, 2008)';
  Root.ChildNodes.Add(Book);
  Book.ChildNodes.Add(Author);
  Book.ChildNodes.Add(Publisher);

  Book := XmlDoc.CreateNode('Book');
  Book.Attributes['Name'] := 'Paradox Lost';
  Author := XmlDoc.CreateNode('Author');
  Author.Text := 'Kress, Peter';
  Publisher := XmlDoc.CreateNode('Publisher');
  Publisher.Text := 'Prentice Hall; 1 edition (February 2, 2000)';
  Root.ChildNodes.Add(Book);
  Book.ChildNodes.Add(Author);
  Book.ChildNodes.Add(Publisher);

  Writeln(XmlDoc.XML.Text);

  Writeln('selectSingleNode');
  LNode:=selectSingleNode(XmlDoc.DOMDocument,'/BookStore/Book[2]/Author["Robert C. Martin"]');
  if LNode<>nil then
   Writeln(LNode.firstChild.nodeValue);

  Writeln;

  Writeln('SelectNodes');
  LNodeList:=SelectNodes(XmlDoc.DOMDocument,'//BookStore/Book/Author');
  if LNodeList<>nil then
    for i := 0 to LNodeList.length-1 do
      Writeln(LNodeList[i].firstChild.nodeValue);
end;

begin
 try
    ReportMemoryLeaksOnShutdown:=True;
    DefaultDOMVendor := OpenXML4Factory.Description;
    {$IFDEF MSWINDOWS}CoInitialize(nil);{$ENDIF}
    try
      TestXPath;
    finally
    {$IFDEF MSWINDOWS}CoUninitialize;{$ENDIF}
    end;
 except
    {$IFDEF MSWINDOWS}
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    {$ENDIF}
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln;
 Writeln('Press Enter to exit');
 Readln;
end.

OSXXPATH


8 Comments

Using the Bing search API from Delphi

The Bing Search API 2.0 now is available in the Windows Azure Marketplace, check the updated article here.

The Bing Search API provides a very flexible set of methods to submit queries and retrieve results from the Bing Engine. In this article I will show how you can use this API from Delphi.

Getting Started

Before to start read the terms of use of the Bing API which states “…The API is intended to deliver relevant results (collectively, “Bing results”) for queries submitted to Microsoft’s Bing service and other related Microsoft services (collectively, “Bing services”) for rendering within a customer-facing or end-user-facing website (“Website”) or application..(So it’s ok use this API from a desktop application)

To use the Bing API you must get an Application ID from the Bing Developer Center and include this AppId in the API calls.

You can send a request to the Bing Search API and get the response in one of these protocols JSON (JavaScript Object Notation), XML (Extended Markup Language) or SOAP (Simple Object Access Protocol).

The protocol is identified in the used URI, check these samples URLs

Before to choose the appropriate response protocol you must evaluate the kind of application which are you developing, in this article I choose the XML protocol due that can be implemented im most of the delphi versions without use third party libraries (Note : the only limitation using the XML response is which the length of the requested URL is limited by the maximum URL length.)

Building the URL

When you uses the Bing XML interface, you must make a HTTP GET using a URL like this

http://api.bing.net/xml.aspx?AppId= YOUR_APPID &Version=2.2&Market=en-US&Query=testign&Sources=web+spell&Web.Count=1&xmltype=elementbased

  • Appid : is the Application ID
  • Version : Version of the API to use (recommended is 2.2)
  • Market : prefered language of the search results
  • Query : the sentence to search
  • Web.Count : the number of results to get
  • xmltype : this field control control the flavor of XML interface. If ElementBased enumeration is specified, each field will be rendered as a separated tag. If AttributeBased enumeration is specified, all simple type fields will be rendered as attributes instead of elements. The default value is ElementBased.
  • Sources : indicate the types of data to retrieve (see Working with SourceTypes) (you can use multiple values in this files separated by an +)

the values of this field can be

  • Image (Bing, Version 2.0)
  • News (Bing, Version 2.0)
  • Phonebook  (Bing, Version 2.0)
  • RelatedSearch(Bing, Version 2.0)
  • Spell(Bing, Version 2.0)
  • Translation (Bing, Version 2.2)
  • Video (Bing, Version 2.x)
  • Web (Bing, Version 2)

Depending of how you construct your URL the XML returned can vary (see Using XML (Bing, Version2) for a sample output XML).

The code

After of build the URL you must make a GET request to access the Bing API. you can use your favorite component like WinInet, Indy and so on. In my case I choose the IXMLHTTPRequest interface to make GET request because I can use the same object to parse the XML result.

Check the next snippets using the AttributeBased and elementbased values in the xmltype field and how the parse procedure changes depending of this value.


{$APPTYPE CONSOLE}

uses
  MSXML,
  SysUtils,
  ActiveX,
  ComObj,
  Variants;

//Demo of Attribute Based XML request
procedure GetBingInfoXML(const SearchKey : string;NumberOfResults:integer=1);
const
 //this AppId if for demo only please be nice and use your own , it's easy get one from here http://msdn.microsoft.com/en-us/library/ff512386.aspx
 ApplicationID= '73C8F474CA4D1202AD60747126813B731199ECEA';
 URI='http://api.bing.net/xml.aspx?AppId=%s&Version=2.2&Market=en-US&Query=%s&Sources=web&web.count=%d&xmltype=AttributeBased';
 COMPLETED=4;
 OK       =200;
var
  XMLHTTPRequest  : IXMLHTTPRequest;
  XMLDOMDocument  : IXMLDOMDocument;
  XMLDOMNode      : IXMLDOMNode;
  XMLDOMNodeList  : IXMLDOMNodeList;
  LIndex          : Integer;
begin
    XMLHTTPRequest := CreateOleObject('MSXML2.XMLHTTP') As IXMLHTTPRequest;
  try
    XMLHTTPRequest.open('GET', Format(URI,[ApplicationID, SearchKey, NumberOfResults]), False, EmptyParam, EmptyParam);
    XMLHTTPRequest.send('');
    if (XMLHTTPRequest.readyState = COMPLETED) and (XMLHTTPRequest.status = OK) then
    begin
      XMLDOMDocument := XMLHTTPRequest.responseXML  As IXMLDOMDocument2;
      XMLDOMNode := XMLDOMDocument.selectSingleNode('//web:Web');
      Writeln(Format('Total found %s',[String(XMLDOMNode.attributes.getNamedItem('Total').Text)]));
      Writeln;
      XMLDOMNodeList := XMLDOMNode.selectNodes('//web:WebResult');
      for LIndex:=0 to  XMLDOMNodeList.length-1 do
      begin
        XMLDOMNode:=XMLDOMNodeList.item[LIndex];
         Writeln(Format('Title       %s',[String(XMLDOMNode.attributes.getNamedItem('Title').Text)]));
         Writeln(Format('Description %s',[String(XMLDOMNode.attributes.getNamedItem('Description').Text)]));
         Writeln(Format('Url         %s',[String(XMLDOMNode.attributes.getNamedItem('Url').Text)]));
         Writeln(Format('CacheUrl    %s',[String(XMLDOMNode.attributes.getNamedItem('CacheUrl').Text)]));
         Writeln(Format('DisplayUrl  %s',[String(XMLDOMNode.attributes.getNamedItem('DisplayUrl').Text)]));
         Writeln(Format('DateTime    %s',[String(XMLDOMNode.attributes.getNamedItem('DateTime').Text)]));
         Writeln;
      end;
    end;
  finally
    XMLHTTPRequest := nil;
  end;
end;

begin
 try
    CoInitialize(nil);
    try
      GetBingInfoXML('delphi programming blogs', 5);
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

{$APPTYPE CONSOLE}

uses
  MSXML,
  SysUtils,
  ActiveX,
  ComObj,
  Variants;

//Demo of element based XML request
procedure GetBingInfoXML(const SearchKey : string;NumberOfResults:integer=1);
const
 //this AppId if for demo only please be nice and use your own , it's easy get one from here http://msdn.microsoft.com/en-us/library/ff512386.aspx
 ApplicationID= '73C8F474CA4D1202AD60747126813B731199ECEA';
 URI='http://api.bing.net/xml.aspx?AppId=%s&Version=2.2&Market=en-US&Query=%s&Sources=web&web.count=%d&xmltype=elementbased';
 COMPLETED=4;
 OK       =200;
var
  XMLHTTPRequest  : IXMLHTTPRequest;
  XMLDOMDocument  : IXMLDOMDocument;
  XMLDOMNode      : IXMLDOMNode;
  XMLDOMNodeList  : IXMLDOMNodeList;
  LIndex          : Integer;
begin
    XMLHTTPRequest := CreateOleObject('MSXML2.XMLHTTP') As IXMLHTTPRequest;
  try
    XMLHTTPRequest.open('GET', Format(URI,[ApplicationID, SearchKey, NumberOfResults]), False, EmptyParam, EmptyParam);
    XMLHTTPRequest.send('');
    if (XMLHTTPRequest.readyState = COMPLETED) and (XMLHTTPRequest.status = OK) then
    begin
      XMLDOMDocument := XMLHTTPRequest.responseXML  As IXMLDOMDocument2;
      XMLDOMNode := XMLDOMDocument.selectSingleNode('//web:Total');
      Writeln(Format('Total found %s',[String(XMLDOMNode.text)]));
      Writeln;
      XMLDOMNodeList := XMLDOMNode.selectNodes('//web:WebResult');
        for LIndex:=0 to  XMLDOMNodeList.length-1 do
        begin
          XMLDOMNode:=XMLDOMNodeList.item[LIndex];
          Writeln(Format('Title       %s',[String(XMLDOMNode.selectSingleNode('./web:Title').Text)]));
          Writeln(Format('Description %s',[String(XMLDOMNode.selectSingleNode('./web:Description').Text)]));
          Writeln(Format('Url         %s',[String(XMLDOMNode.selectSingleNode('./web:Url').Text)]));
          Writeln(Format('CacheUrl    %s',[String(XMLDOMNode.selectSingleNode('./web:CacheUrl').Text)]));
          Writeln(Format('DisplayUrl  %s',[String(XMLDOMNode.selectSingleNode('./web:DisplayUrl').Text)]));
          Writeln(Format('DateTime    %s',[String(XMLDOMNode.selectSingleNode('./web:DateTime').Text)]));
          Writeln;
        end;
    end;
  finally
    XMLHTTPRequest := nil;
  end;
end;

begin
 try
    CoInitialize(nil);
    try
      GetBingInfoXML('delphi programming blogs', 5);
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

And calling any of these methods in this way

  GetBingInfoXML('delphi programming blogs', 5);

Will produce this output

Total found 7190000

Title       DelphiFeeds.com - All Delphi blogs in one place - Delphi community ...
Description Andy's Blog - I get some reports about problems with IDE Fix Pack 4.7. Those ... About Delphi Programming - in TTreeView :: Say you want to display customer-order-item data ...
Url         http://www.delphifeeds.com/
CacheUrl    http://cc.bingj.com/cache.aspx?q=delphi+programming+blogs&d=46646399
49310488&mkt=en-US&w=c537195d,718a1a7b
DisplayUrl  www.delphifeeds.com
DateTime    2012-03-30T13:36:00Z

Title       Delphi Programming Blog
Description Recently TMS Software released a FTP Uploader which I tried and liked because of its simplicity, but I was not satisfied with it because it did not reset itself to ...
Url         http://williamwmiller.wordpress.com/
CacheUrl    http://cc.bingj.com/cache.aspx?q=delphi+programming+blogs&d=4754451987498697&mkt=en-US&w=368ed92b,7b91d282
DisplayUrl  williamwmiller.wordpress.com
DateTime    2011-12-29T03:45:00Z

Title       RTTI « The Road to Delphi - a Blog about programming
Description Here 's a sample code of how you can dump the declaration of a TRttiType using the Rtti. Supports classes, records and interfaces. Delphi //Author ...
Url         https://theroadtodelphi.wordpress.com/category/delphi/rtti/
CacheUrl    http://cc.bingj.com/cache.aspx?q=delphi+programming+blogs&d=4925950032087641&mkt=en-US&w=c2546964,98458a
DisplayUrl  theroadtodelphi.wordpress.com/category/delphi/rtti
DateTime    2012-02-22T11:03:00Z

Title       2011 September « The Road to Delphi - a Blog about programming
Description Maybe you've seen articles about how use the FireMonkey Styles, and how you can set almost every aspect of a visual control, today I will go a step...
Url         https://theroadtodelphi.wordpress.com/2011/09/
CacheUrl    http://cc.bingj.com/cache.aspx?q=delphi+programming+blogs&d=5062478449739337&mkt=en-US&w=d5622f5e,eeaafc08
DisplayUrl  theroadtodelphi.wordpress.com/2011/09
DateTime    2012-03-05T17:17:00Z

Title       Delphi Programming Blog
Description Here's how to place a check box into a DBGrid. Create visually moreattractive user interfaces for editing boolean fields inside a DBGrid. ...
Url         http://delphi4all.blogfa.com/
CacheUrl    http://cc.bingj.com/cache.aspx?q=delphi+programming+blogs&d=4525654810627103&mkt=en-US&w=63fcb281,3d45a160
DisplayUrl  delphi4all.blogfa.com
DateTime    2012-03-25T01:10:00Z

As you probably note , the above source code only parses the result when the response includes a web search result, so now we are to expand this code to support and parse any result returned by the Bing API (Web search, Images, Videos, etc.)

Check the next full sample

{$APPTYPE CONSOLE}

{$R *.res}

uses
  MSXML,
  SysUtils,
  ActiveX,
  ComObj,
  Variants;

type
  TBingApiSearchSource=(Image, News, RelatedSearch, Spell, Video,  Web);
  TBingApiSearchSources = Set of TBingApiSearchSource;

const
  BingApiSearchSourcesStr : Array [TBingApiSearchSource] of string = ('Image','News','RelatedSearch','spell','Video','Web');


procedure GetBingInfoExtXML(const SearchKey : string;const NumberOfResults:integer=1;Source : TBingApiSearchSources=[Web]);
const
 //this AppId if for demo only please be nice and use your own , it's easy get one from here http://msdn.microsoft.com/en-us/library/ff512386.aspx
 ApplicationID= '73C8F474CA4D1202AD60747126813B731199ECEA';
 URI='http://api.bing.net/xml.aspx?AppId=%s&Version=2.2&Market=en-US&Query=%s&Sources=%s&web.count=%d&xmltype=AttributeBased';
 COMPLETED=4;
 OK       =200;
var
  XMLHTTPRequest  : IXMLHTTPRequest;
  XMLDOMDocument  : IXMLDOMDocument;
  XMLDOMNode      : IXMLDOMNode;
  XMLDOMNodeList  : IXMLDOMNodeList;
  LIndex          : Integer;
  LSource         : TBingApiSearchSource;
  Sources         : string;
begin
    XMLHTTPRequest := CreateOleObject('MSXML2.XMLHTTP') As IXMLHTTPRequest;
  try
    Sources:='';
    for LSource in Source do
     Sources:=Sources+BingApiSearchSourcesStr[LSource]+'+';
    Delete(Sources,Length(Sources),1);

    XMLHTTPRequest.open('GET', Format(URI,[ApplicationID, SearchKey, Sources, NumberOfResults]), False, EmptyParam, EmptyParam);
    XMLHTTPRequest.send('');
    if (XMLHTTPRequest.readyState = COMPLETED) and (XMLHTTPRequest.status = OK) then
    begin
      XMLDOMDocument := XMLHTTPRequest.responseXML  As IXMLDOMDocument2;

      if Web in Source then
      begin
        XMLDOMNode := XMLDOMDocument.selectSingleNode('//web:Web');
        Writeln(Format('WebSearch results total found %s',[String(XMLDOMNode.attributes.getNamedItem('Total').Text)]));
        Writeln;
        XMLDOMNodeList := XMLDOMNode.selectNodes('//web:WebResult');
        for LIndex:=0 to  XMLDOMNodeList.length-1 do
        begin
          XMLDOMNode:=XMLDOMNodeList.item[LIndex];
           Writeln(Format('Title       %s',[String(XMLDOMNode.attributes.getNamedItem('Title').Text)]));
           Writeln(Format('Description %s',[String(XMLDOMNode.attributes.getNamedItem('Description').Text)]));
           Writeln(Format('Url         %s',[String(XMLDOMNode.attributes.getNamedItem('Url').Text)]));
           Writeln(Format('CacheUrl    %s',[String(XMLDOMNode.attributes.getNamedItem('CacheUrl').Text)]));
           Writeln(Format('DisplayUrl  %s',[String(XMLDOMNode.attributes.getNamedItem('DisplayUrl').Text)]));
           Writeln(Format('DateTime    %s',[String(XMLDOMNode.attributes.getNamedItem('DateTime').Text)]));
           Writeln;
        end;
      end;

      if Image in Source then
      begin
        XMLDOMNode := XMLDOMDocument.selectSingleNode('//mms:Image');
        Writeln(Format('Images results total found %s',[String(XMLDOMNode.attributes.getNamedItem('Total').Text)]));
        Writeln;
        XMLDOMNodeList := XMLDOMNode.selectNodes('//mms:ImageResult');
        for LIndex:=0 to  XMLDOMNodeList.length-1 do
        begin
          XMLDOMNode:=XMLDOMNodeList.item[LIndex];
           Writeln(Format('Title       %s',[String(XMLDOMNode.attributes.getNamedItem('Title').Text)]));
           Writeln(Format('MediaUrl    %s',[String(XMLDOMNode.attributes.getNamedItem('MediaUrl').Text)]));
           Writeln(Format('Url         %s',[String(XMLDOMNode.attributes.getNamedItem('Url').Text)]));
           Writeln(Format('DisplayUrl  %s',[String(XMLDOMNode.attributes.getNamedItem('DisplayUrl').Text)]));
           Writeln(Format('Width       %s',[String(XMLDOMNode.attributes.getNamedItem('Width').Text)]));
           Writeln(Format('Height      %s',[String(XMLDOMNode.attributes.getNamedItem('Height').Text)]));
           Writeln(Format('FileSize    %s',[String(XMLDOMNode.attributes.getNamedItem('FileSize').Text)]));
           Writeln(Format('ContentType %s',[String(XMLDOMNode.attributes.getNamedItem('ContentType').Text)]));
            XMLDOMNode:=XMLDOMNode.selectSingleNode('//mms:Thumbnail');
            if XMLDOMNode<>nil then
            begin
              Writeln(' Thumbnail Info');
              Writeln(Format(' Url         %s',[String(XMLDOMNode.attributes.getNamedItem('Url').Text)]));
              Writeln(Format(' ContentType %s',[String(XMLDOMNode.attributes.getNamedItem('ContentType').Text)]));
              Writeln(Format(' Width       %s',[String(XMLDOMNode.attributes.getNamedItem('Width').Text)]));
              Writeln(Format(' Height      %s',[String(XMLDOMNode.attributes.getNamedItem('Height').Text)]));
              Writeln(Format(' FileSize    %s',[String(XMLDOMNode.attributes.getNamedItem('FileSize').Text)]));
            end;
           Writeln;
        end;
      end;

      if Video in Source then
      begin
        XMLDOMNode := XMLDOMDocument.selectSingleNode('//mms:Video');
        Writeln(Format('Video results total found %s',[String(XMLDOMNode.attributes.getNamedItem('Total').Text)]));
        Writeln;
        XMLDOMNodeList := XMLDOMNode.selectNodes('//mms:VideoResult');
        for LIndex:=0 to  XMLDOMNodeList.length-1 do
        begin
          XMLDOMNode:=XMLDOMNodeList.item[LIndex];
           Writeln(Format('Title       %s',[String(XMLDOMNode.attributes.getNamedItem('Title').Text)]));
           Writeln(Format('PlayUrl     %s',[String(XMLDOMNode.attributes.getNamedItem('PlayUrl').Text)]));
           Writeln(Format('SourceTitle %s',[String(XMLDOMNode.attributes.getNamedItem('SourceTitle').Text)]));
           Writeln(Format('RunTime     %s',[String(XMLDOMNode.attributes.getNamedItem('RunTime').Text)]));
           Writeln(Format('Click Through Page Url %s',[String(XMLDOMNode.attributes.getNamedItem('ClickThroughPageUrl').Text)]));
            XMLDOMNode:=XMLDOMNode.selectSingleNode('//mms:StaticThumbnail');
            if XMLDOMNode<>nil then
            begin
              Writeln(' Static Thumbnail Info');
              Writeln(Format(' Url         %s',[String(XMLDOMNode.attributes.getNamedItem('Url').Text)]));
              Writeln(Format(' ContentType %s',[String(XMLDOMNode.attributes.getNamedItem('ContentType').Text)]));
              Writeln(Format(' Width       %s',[String(XMLDOMNode.attributes.getNamedItem('Width').Text)]));
              Writeln(Format(' Height      %s',[String(XMLDOMNode.attributes.getNamedItem('Height').Text)]));
              Writeln(Format(' FileSize    %s',[String(XMLDOMNode.attributes.getNamedItem('FileSize').Text)]));
            end;
           Writeln;
        end;
      end;


      if RelatedSearch in Source then
      begin
        Writeln('Related Searchs');
        Writeln;
        XMLDOMNodeList := XMLDOMDocument.selectNodes('//rs:RelatedSearchResult');
        for LIndex:=0 to  XMLDOMNodeList.length-1 do
        begin
          XMLDOMNode:=XMLDOMNodeList.item[LIndex];
          Writeln(Format('Title       %s',[String(XMLDOMNode.attributes.getNamedItem('Title').Text)]));
          Writeln(Format('Url         %s',[String(XMLDOMNode.attributes.getNamedItem('Url').Text)]));
        end;
      end;


      if News in Source then
      begin
        XMLDOMNode := XMLDOMDocument.selectSingleNode('//news:News');
        Writeln(Format('News results total found %s',[String(XMLDOMNode.attributes.getNamedItem('Total').Text)]));
        Writeln;
        XMLDOMNodeList := XMLDOMNode.selectNodes('//news:NewsResult');
        for LIndex:=0 to  XMLDOMNodeList.length-1 do
        begin
          XMLDOMNode:=XMLDOMNodeList.item[LIndex];
           Writeln(Format('Title        %s',[String(XMLDOMNode.attributes.getNamedItem('Title').Text)]));
           Writeln(Format('Url          %s',[String(XMLDOMNode.attributes.getNamedItem('Url').Text)]));
           Writeln(Format('Source       %s',[String(XMLDOMNode.attributes.getNamedItem('Source').Text)]));
           Writeln(Format('Snippet      %s',[String(XMLDOMNode.attributes.getNamedItem('Snippet').Text)]));
           Writeln(Format('Date         %s',[String(XMLDOMNode.attributes.getNamedItem('Date').Text)]));
           Writeln(Format('BreakingNews %s',[String(XMLDOMNode.attributes.getNamedItem('BreakingNews').Text)]));
           Writeln;
        end;
      end;

      if Spell in Source then
      begin
        XMLDOMNode := XMLDOMDocument.selectSingleNode('//spl:Spell');
        Writeln(Format('Spell results total found %s',[String(XMLDOMNode.attributes.getNamedItem('Total').Text)]));
        Writeln;
        XMLDOMNodeList := XMLDOMNode.selectNodes('//spl:SpellResult');
        for LIndex:=0 to  XMLDOMNodeList.length-1 do
        begin
          XMLDOMNode:=XMLDOMNodeList.item[LIndex];
           Writeln(Format('Value        %s',[String(XMLDOMNode.attributes.getNamedItem('Value').Text)]));
           Writeln;
        end;
      end;

    end;
  finally
    XMLHTTPRequest := nil;
  end;
end;

begin
 try
    CoInitialize(nil);
    try
      GetBingInfoExtXML('Delphi programming', 1, [Web, Video, Image]);
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.


Leave a comment

How get and parse a manifest of an external application using delphi

A manifest is basically a XML file that contains settings that informs Windows how to handle a program when it is started.  The manifest can be embedded inside the program file (as a resource) or it can be located in a separate external XML file. In this article I will show how you can read a embedded windows application manifest from a exe using delphi and parse the information contained using XPath.

The manifest are full of rich information which you can use to determine for example the Requested Execution Levels  or the version of the comctl32.dll used by an application.

To read the manifest from a exe file you must use the LoadLibraryEx function with the LOAD_LIBRARY_AS_DATAFILE flag (or since windows vista you can use the LOAD_LIBRARY_AS_IMAGE_RESOURCE value instead) and the TResourceStream class.

Check this sample code which returns the manifest from a exe file as a string;

function  GetManifest(const FileName:string) : AnsiString;
var
  hModule  : THandle;
  Resource : TResourceStream;
begin
  Result:='';
  //load the file to read
  hModule:=LoadLibraryEx(PChar(FileName),0,LOAD_LIBRARY_AS_DATAFILE);
  try
     if hModule=0 then RaiseLastOSError;
     //check if exist the manifest inside of the file
     if FindResource(hModule, MakeIntResource(1), RT_MANIFEST)<>0 then
     begin
       //load the resource
       Resource:=TResourceStream.CreateFromID(hModule,1,RT_MANIFEST);
       try
         SetString(Result, PAnsiChar(Resource.Memory),Resource.Size);
       finally
         Resource.Free;
       end;
     end;
  finally
      FreeLibrary(hModule);
  end;
end;

Ok that was the easy part, now before to parse the xml check a sample manifest file generated by Delphi XE

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <assemblyIdentity
    type="win32"
    name="CodeGear RAD Studio"
    version="15.0.3890.34076" 
    processorArchitecture="*"/>
  <dependency>
    <dependentAssembly>
      <assemblyIdentity
        type="win32"
        name="Microsoft.Windows.Common-Controls"
        version="6.0.0.0"
        publicKeyToken="6595b64144ccf1df"
        language="*"
        processorArchitecture="*"/>
    </dependentAssembly>
  </dependency>
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
    <security>
      <requestedPrivileges>
        <requestedExecutionLevel
          level="asInvoker"
          uiAccess="false"/>
        </requestedPrivileges>
    </security>
  </trustInfo>
</assembly>

As you can see exist two XML namespaces (urn:schemas-microsoft-com:asm.v1 and urn:schemas-microsoft-com:asm.v3) inside of the xml file, before to read the xml string using XPath you must consider these two namespaces.

See this code which deal with the xml and the namespaces

//the namespaces used
const
 assembly_namespace_V1='urn:schemas-microsoft-com:asm.v1';
 assembly_namespace_V2='urn:schemas-microsoft-com:asm.v2';
 assembly_namespace_V3='urn:schemas-microsoft-com:asm.v3';
var
  XmlDoc : OleVariant;
  ns     : string;
  Node   : OleVariant;
begin
  if Trim(FManifest)='' then exit;
  //create a Xml Dom instance
  XmlDoc       := CreateOleObject('Msxml2.DOMDocument.6.0');
  XmlDoc.Async := False;
  try
    //load the Xml string
    XmlDoc.LoadXML(FManifest);
    XmlDoc.SetProperty('SelectionLanguage','XPath');

    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);

    //set the namespaces alias
    ns := Format('xmlns:a=%s xmlns:b=%s xmlns:c=%s',[QuotedStr(assembly_namespace_V1),QuotedStr(assembly_namespace_V2),QuotedStr(assembly_namespace_V3)]);
    XmlDoc.setProperty('SelectionNamespaces', ns);

    //get the version of the manifest
    Node:=XmlDoc.selectSingleNode('/a:assembly/@manifestVersion');
    if not VarIsNull(Node) and not VarIsClear(Node) then
    FManifestVersion:=Node.text;

    //parsing then Assembly Identity
    Node:=XmlDoc.selectSingleNode('/a:assembly/a:assemblyIdentity');
    if not VarIsNull(Node) and not VarIsClear(Node) then
    begin
      FMainAssemblyIdentity.&type   :=Node.getAttribute('type');
      FMainAssemblyIdentity.name    :=Node.getAttribute('name');
      FMainAssemblyIdentity.language:=VarNullToStr(Node.getAttribute('language'));
      FMainAssemblyIdentity.version :=Node.getAttribute('version');
      FMainAssemblyIdentity.processorArchitecture:=VarNullToStr(Node.getAttribute('processorArchitecture'));
      FMainAssemblyIdentity.publicKeyToken       :=VarNullToStr(Node.getAttribute('publicKeyToken'));
    end;

    Node:=XmlDoc.selectSingleNode('/a:assembly/a:dependency/a:dependentAssembly/a:assemblyIdentity');
    if not VarIsNull(Node) and not VarIsClear(Node) then
    begin
      FDependentAssembly.&type   :=Node.getAttribute('type');
      FDependentAssembly.name    :=Node.getAttribute('name');
      FDependentAssembly.language:=VarNullToStr(Node.getAttribute('language'));
      FDependentAssembly.version :=Node.getAttribute('version');
      FDependentAssembly.processorArchitecture:=VarNullToStr(Node.getAttribute('processorArchitecture'));
      FDependentAssembly.publicKeyToken       :=VarNullToStr(Node.getAttribute('publicKeyToken'));
    end;

    //Now the tricky part. The requestedExecutionLevel can be located in one of these namespaces
    //urn:schemas-microsoft-com:asm.v2 or urn:schemas-microsoft-com:asm.v3
    Node:=XmlDoc.selectSingleNode('/a:assembly/b:trustInfo/b:security/b:requestedPrivileges/b:requestedExecutionLevel');
    //if not found the requestedExecutionLevel then
    if VarIsNull(Node) or VarIsClear(Node) then
    //try with the next namespace
      Node:=XmlDoc.selectSingleNode('/a:assembly/c:trustInfo/c:security/c:requestedPrivileges/c:requestedExecutionLevel');
    //contains data?
    if not VarIsNull(Node) and not VarIsClear(Node) then
    begin
      FRequestedExecutionLevel.level   :=Node.getAttribute('level');
      FRequestedExecutionLevel.uiAccess:=VarNullToStr(Node.getAttribute('uiAccess'));
    end;

  finally
    XmlDoc:=Unassigned;
  end;
end;

Finally check this class to read the content of an Manifest embedded in exe file.

{$APPTYPE CONSOLE}

uses
  ActiveX,
  Classes,
  Windows,
  Variants,
  ComObj,
  StrUtils,
  SysUtils;

type
  TAssemblyIdentity=record
    &type : string;
    name	: string;
    language: string;
    processorArchitecture	: string;
    version	: string;
    publicKeyToken: string;
  end;

  TRequestedExecutionLevel=record
    level    : string;
    uiAccess : string;
  end;

  TManifiestReader=class
  private
    FFileName: string;
    FManifest: AnsiString;
    FMainAssemblyIdentity: TAssemblyIdentity;
    FHasManifest: Boolean;
    FDependentAssembly: TAssemblyIdentity;
    FManifestVersion: string;
    FRequestedExecutionLevel: TRequestedExecutionLevel;
    procedure GetManifest;
    procedure LoadManifestData;
    function  VarNullToStr(Value:OleVariant):string;
  public
    property FileName : string read FFileName;
    property Manifest : AnsiString read FManifest;
    property ManifestVersion : string read FManifestVersion;
    property MainAssemblyIdentity : TAssemblyIdentity read FMainAssemblyIdentity;
    property DependentAssembly : TAssemblyIdentity read FDependentAssembly;
    property HasManifest : Boolean read FHasManifest;
    property RequestedExecutionLevel : TRequestedExecutionLevel read FRequestedExecutionLevel;
    constructor Create(const AFileName:string);
  end;

{ TReadManifiest }

constructor TManifiestReader.Create(const AFileName: string);
begin
  FFileName:=AFileName;
  FHasManifest:=False;
  GetManifest;
  LoadManifestData;
end;

procedure TManifiestReader.GetManifest;
var
  hModule  : THandle;
  Resource : TResourceStream;
begin
  FManifest:='';
  hModule:=LoadLibraryEx(PChar(FileName),0,LOAD_LIBRARY_AS_DATAFILE);
  try
     if hModule=0 then RaiseLastOSError;
     if FindResource(hModule, MakeIntResource(1), RT_MANIFEST)<>0 then
     begin
       Resource:=TResourceStream.CreateFromID(hModule,1,RT_MANIFEST);
       try
         SetString(FManifest, PAnsiChar(Resource.Memory),Resource.Size);
         FHasManifest:=True;
       finally
         Resource.Free;
       end;
     end;
  finally
      FreeLibrary(hModule);
  end;
end;

procedure TManifiestReader.LoadManifestData;
const
 assembly_namespace_V1='urn:schemas-microsoft-com:asm.v1';
 assembly_namespace_V2='urn:schemas-microsoft-com:asm.v2';
 assembly_namespace_V3='urn:schemas-microsoft-com:asm.v3';
var
  XmlDoc : OleVariant;
  ns     : string;
  Node   : OleVariant;
begin
  if Trim(FManifest)='' then exit;
  XmlDoc       := CreateOleObject('Msxml2.DOMDocument.6.0');
  XmlDoc.Async := False;
  try
    XmlDoc.LoadXML(FManifest);
    XmlDoc.SetProperty('SelectionLanguage','XPath');

    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);

    //set the namespaces alias
    ns := Format('xmlns:a=%s xmlns:b=%s xmlns:c=%s',[QuotedStr(assembly_namespace_V1),QuotedStr(assembly_namespace_V2),QuotedStr(assembly_namespace_V3)]);
    XmlDoc.setProperty('SelectionNamespaces', ns);

    //get the version of the manifest
    Node:=XmlDoc.selectSingleNode('/a:assembly/@manifestVersion');
    if not VarIsNull(Node) and not VarIsClear(Node) then
    FManifestVersion:=Node.text;

    Node:=XmlDoc.selectSingleNode('/a:assembly/a:assemblyIdentity');
    if not VarIsNull(Node) and not VarIsClear(Node) then
    begin
      FMainAssemblyIdentity.&type   :=Node.getAttribute('type');
      FMainAssemblyIdentity.name    :=Node.getAttribute('name');
      FMainAssemblyIdentity.language:=VarNullToStr(Node.getAttribute('language'));
      FMainAssemblyIdentity.version :=Node.getAttribute('version');
      FMainAssemblyIdentity.processorArchitecture:=VarNullToStr(Node.getAttribute('processorArchitecture'));
      FMainAssemblyIdentity.publicKeyToken       :=VarNullToStr(Node.getAttribute('publicKeyToken'));
    end;

    Node:=XmlDoc.selectSingleNode('/a:assembly/a:dependency/a:dependentAssembly/a:assemblyIdentity');
    if not VarIsNull(Node) and not VarIsClear(Node) then
    begin
      FDependentAssembly.&type   :=Node.getAttribute('type');
      FDependentAssembly.name    :=Node.getAttribute('name');
      FDependentAssembly.language:=VarNullToStr(Node.getAttribute('language'));
      FDependentAssembly.version :=Node.getAttribute('version');
      FDependentAssembly.processorArchitecture:=VarNullToStr(Node.getAttribute('processorArchitecture'));
      FDependentAssembly.publicKeyToken       :=VarNullToStr(Node.getAttribute('publicKeyToken'));
    end;

    Node:=XmlDoc.selectSingleNode('/a:assembly/b:trustInfo/b:security/b:requestedPrivileges/b:requestedExecutionLevel');
    if VarIsNull(Node) or VarIsClear(Node) then
      Node:=XmlDoc.selectSingleNode('/a:assembly/c:trustInfo/c:security/c:requestedPrivileges/c:requestedExecutionLevel');
    if not VarIsNull(Node) and not VarIsClear(Node) then
    begin
      FRequestedExecutionLevel.level   :=Node.getAttribute('level');
      FRequestedExecutionLevel.uiAccess:=VarNullToStr(Node.getAttribute('uiAccess'));
    end;

  finally
    XmlDoc:=Unassigned;
  end;
end;

function TManifiestReader.VarNullToStr(Value: OleVariant): string;
begin
  if VarIsNull(Value) then
    Result:=''
  else
    Result:=VarToStr(Value);
end;

Var
  ManifestReader : TManifiestReader;
begin
 try
    CoInitialize(nil);
    try
      ManifestReader:=TManifiestReader.Create('MyApplication.exe');
      try
        //Writeln(ManifestReader.Manifest);

        Writeln('Manifest version '+ManifestReader.ManifestVersion);
        Writeln('Main Assembly Identity');
        Writeln('----------------------');
        Writeln('type     '+ManifestReader.MainAssemblyIdentity.&type);
        Writeln('name     '+ManifestReader.MainAssemblyIdentity.name);
        Writeln('language '+ManifestReader.MainAssemblyIdentity.language);
        Writeln('version  '+ManifestReader.MainAssemblyIdentity.version);
        Writeln('processorArchitecture '+ManifestReader.MainAssemblyIdentity.processorArchitecture);
        Writeln('publicKeyToken        '+ManifestReader.MainAssemblyIdentity.publicKeyToken);
        Writeln('');

        Writeln('Dependent Assembly Identity');
        Writeln('---------------------------');
        Writeln('type     '+ManifestReader.DependentAssembly.&type);
        Writeln('name     '+ManifestReader.DependentAssembly.name);
        Writeln('language '+ManifestReader.DependentAssembly.language);
        Writeln('version  '+ManifestReader.DependentAssembly.version);
        Writeln('processorArchitecture '+ManifestReader.DependentAssembly.processorArchitecture);
        Writeln('publicKeyToken        '+ManifestReader.DependentAssembly.publicKeyToken);
        Writeln('');

        Writeln('Requested Execution Level');
        Writeln('---------------------------');
        Writeln('level     '+ManifestReader.RequestedExecutionLevel.level);
        Writeln('uiAccess  '+ManifestReader.RequestedExecutionLevel.uiAccess);

      finally
        ManifestReader.Free;
      end;
    finally
      CoUninitialize;
    end;
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
  Readln;
end.

Additional resources

Follow

Get every new post delivered to your Inbox.

Join 586 other followers