The Road to Delphi – a Blog about programming

Delphi – Lazarus – Delphi Prism

Monthly Archives: June 2011


by 1 Comment

Delphi Preview Handler – source code published in google code

A few hours ago I  published in the google code site the code of the Delphi Preview Handler project, under the Mozilla Public License 1.1 , now you can browse in the code and make your suggestions and report bugs using the issue page of the project. I also want to thank to Uwe Raabe by allow me use part of his work in this article to rewrite some parts of the preview handler.


by 21 Comments

Using the Google Maps API V3 from Delphi – Part III Getting the latitude and longitude of a mouse click

In this post I will show, how you can interact with a google map embedded in a TWebbrowser component in order to get the location ( latitude and longitude) of  a point when you click in the map.

JavaScript

To get the location of the mouse when you make a click in the map you must add a  Google maps Event Listener, passing a function to process the event, the values of the current location are retrieved in the event.latLng variable , the next step is store the values returned in a hidden field element to after get these values from Delphi.

Check this sample JavaScript snippet which create an event listener and store the values in the LatValue and LngValue fields.

    google.maps.event.addListener(map, "click",
         function(event)
           {
            document.getElementById("LatValue").value = event.latLng.lat();
            document.getElementById("LngValue").value = event.latLng.lng();
            PutMarker(document.getElementById("LatValue").value, document.getElementById("LngValue").value,"")
           }
   );

This is the PutMarker function which creates a marker in the current location

function PutMarker(Lat, Lang, Msg)
{
 var latlng = new google.maps.LatLng(Lat,Lang);
 var marker = new google.maps.Marker({
     position: latlng,
     map: map,
     title: Msg+" ("+Lat+","+Lang+")"
  });

   //put the created marker in an array
   markersArray.push(marker);

   //compute the index to associate an image to the marker
   index= (markersArray.length % 10);
   if (index==0) { index=10 }
   icon = "http://www.google.com/mapfiles/kml/paddle/"+index+"-lv.png";
   marker.setIcon(icon);
 }

And this is the code to create the 2 input hidden fields in the html page to store the values returned by the Event listener

<body onload="initialize()">
  <div id="map_canvas" style="width:100%; height:100%"></div>
  <div id="latlong">
  <input id="<span class=" type="hidden" />LatValue" >
  <input id="<span class=" type="hidden" />LngValue" >
  </div>
</body>

Delphi

Now from the Delphi side, you must detect the click event in the TWebBrowser component and then read the values stored in the hidden fields. Exists several ways to detect the click in the TWebBrowser, in this case I will use the OnCommandStateChange event.

Check this code which detect the click event and then read the values stored in the hidden fields.

procedure TForm1.WebBrowser1CommandStateChange(ASender: TObject;  Command: Integer; Enable: WordBool);
var
  ADocument : IHTMLDocument2;
  ABody     : IHTMLElement2;
  Lat : string;
  Lng : string;

      //get the value from a field
      function GetIdValue(const Id : string):string;
      var
        Tag      : IHTMLElement;
        TagsList : IHTMLElementCollection;
        Index    : Integer;
      begin
        Result:='';
        TagsList := ABody.getElementsByTagName('input');
        for Index := 0 to TagsList.length-1 do
        begin
          Tag:=TagsList.item(Index, EmptyParam) As IHTMLElement;
          if CompareText(Tag.id,Id)=0 then
            Result := Tag.getAttribute('value', 0);
        end;
      end;

begin
  //is a valid command?
  if TOleEnum(Command) <> CSC_UPDATECOMMANDS then //-1
    Exit;

  //The page is loaded?
  ADocument := WebBrowser1.Document as IHTMLDocument2;
  if not Assigned(ADocument) then
    Exit;

  //the page has body?
  if not Supports(ADocument.body, IHTMLElement2, ABody) then
    exit;

  // get the values of the Latitude and Longitude
  Lat :=GetIdValue('LatValue');
  Lng :=GetIdValue('LngValue');

  //Now process the data
  if  (Lat<>'') and (Lng<>'') and ((Lat<>Latitude.Text) or (Lng<>Longitude.Text)) then
  begin
    Latitude.Text :=Lat;
    Longitude.Text:=Lng;

  end;
end;

Finally this is the full source code for the demo application

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls, XPMan, ComCtrls,MSHTML;

type
  TFrmMain = class(TForm)
    WebBrowser1: TWebBrowser;
    PanelHeader: TPanel;
    ButtonGotoLocation: TButton;
    XPManifest1: TXPManifest;
    LabelLatitude: TLabel;
    LabelLongitude: TLabel;
    Longitude: TEdit;
    Latitude: TEdit;
    ButtonClearMarkers: TButton;
    ListView1: TListView;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure ButtonClearMarkersClick(Sender: TObject);
    procedure WebBrowser1CommandStateChange(ASender: TObject; Command: Integer;  Enable: WordBool);
    procedure ButtonGotoLocationClick(Sender: TObject);
  private
    HTMLWindow2: IHTMLWindow2;
    procedure AddLatLngToList(const Lat,Lng:string);
  public
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

uses
   ActiveX;

const
HTMLStr: AnsiString =
'<html> '+
'<head> '+
'<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
'<script type="text/javascript">// <![CDATA[
src</span>="http://maps.google.com/maps/api/js?sensor=false&language=en">
// ]]></script> '+
//'<script type="text/javascript">// <![CDATA[
src</span>="http://maps.google.com/maps/api/js?sensor=false">
// ]]></script> '+
'<script type="text/javascript"> '+
''+
''+
'  var geocoder; '+
'  var map;  '+
'  var markersArray = [];'+
''+
''+
'  function initialize() { '+
'    geocoder = new google.maps.Geocoder();'+
'    var latlng = new google.maps.LatLng(40.714776,-74.019213); '+
'    var myOptions = { '+
'      zoom: 13, '+
'      center: latlng, '+
'      mapTypeId: google.maps.MapTypeId.ROADMAP '+
'    }; '+
'    map = new google.maps.Map(document.getElementById("map_canvas"), myOptions); '+
'    map.set("streetViewControl", false);'+
'    google.maps.event.addListener(map, "click", '+
'         function(event) '+
'                        {'+
'                         document.getElementById("LatValue").value = event.latLng.lat(); '+
'                         document.getElementById("LngValue").value = event.latLng.lng(); '+
'                         PutMarker(document.getElementById("LatValue").value, document.getElementById("LngValue").value,"") '+
'                        } '+
'   ); '+
''+
'  } '+
''+
''+
'  function GotoLatLng(Lat, Lang) { '+
'   var latlng = new google.maps.LatLng(Lat,Lang);'+
'   map.setCenter(latlng);'+
'  }'+
''+
''+
'function ClearMarkers() {  '+
'  if (markersArray) {        '+
'    for (i in markersArray) {  '+
'      markersArray[i].setMap(null); '+
'    } '+
'  } '+
'}  '+
''+
'  function PutMarker(Lat, Lang, Msg) { '+
'   var latlng = new google.maps.LatLng(Lat,Lang);'+
'   var marker = new google.maps.Marker({'+
'      position: latlng, '+
'      map: map,'+
'      title: Msg+" ("+Lat+","+Lang+")"'+
'  });'+
'  markersArray.push(marker); '+
'  index= (markersArray.length % 10);'+
'  if (index==0) { index=10 } '+
'  icon = "http://www.google.com/mapfiles/kml/paddle/"+index+"-lv.png"; '+
'  marker.setIcon(icon); '+
'  }'+
''+
''+
''+'</script> '+
'</head> '+
''+
'<body onload="initialize()"> '+
'  <div id="map_canvas" style="width:100%; height:100%"></div> '+
'  <div id="latlong"> '+
'  <input type="hidden" id="LatValue" >'+
'  <input type="hidden" id="LngValue" >'+
'  </div>  '+
''+
'</body> '+
'</html> ';

procedure TFrmMain.FormCreate(Sender: TObject);
var
  aStream     : TMemoryStream;
begin
   WebBrowser1.Navigate('about:blank');
    if Assigned(WebBrowser1.Document) then
    begin
      aStream := TMemoryStream.Create;
      try
         aStream.WriteBuffer(Pointer(HTMLStr)^, Length(HTMLStr));
         //aStream.Write(HTMLStr[1], Length(HTMLStr));
         aStream.Seek(0, soFromBeginning);
         (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(aStream));
      finally
         aStream.Free;
      end;
      HTMLWindow2 := (WebBrowser1.Document as IHTMLDocument2).parentWindow;
    end;
end;

procedure TFrmMain.WebBrowser1CommandStateChange(ASender: TObject;  Command: Integer; Enable: WordBool);
var
  ADocument : IHTMLDocument2;
  ABody     : IHTMLElement2;
  Lat : string;
  Lng : string;

      function GetIdValue(const Id : string):string;
      var
        Tag      : IHTMLElement;
        TagsList : IHTMLElementCollection;
        Index    : Integer;
      begin
        Result:='';
        TagsList := ABody.getElementsByTagName('input');
        for Index := 0 to TagsList.length-1 do
        begin
          Tag:=TagsList.item(Index, EmptyParam) As IHTMLElement;
          if CompareText(Tag.id,Id)=0 then
            Result := Tag.getAttribute('value', 0);
        end;
      end;

begin
  if TOleEnum(Command) <> CSC_UPDATECOMMANDS then
    Exit;

  ADocument := WebBrowser1.Document as IHTMLDocument2;
  if not Assigned(ADocument) then
    Exit;

  if not Supports(ADocument.body, IHTMLElement2, ABody) then
    exit;

  Lat :=GetIdValue('LatValue');
  Lng :=GetIdValue('LngValue');
  if  (Lat<>'') and (Lng<>'') and ((Lat<>Latitude.Text) or (Lng<>Longitude.Text)) then
  begin
    Latitude.Text :=Lat;
    Longitude.Text:=Lng;
    AddLatLngToList(Lat, Lng);
  end;
end;

procedure TFrmMain.AddLatLngToList(const Lat, Lng: string);
var
  Item  : TListItem;
begin
   if (Lat<>'') and (Lng<>'') then
   begin
     Item:=ListView1.Items.Add;
     Item.Caption:=Lng;
     Item.SubItems.Add(Lat);
     Item.MakeVisible(False);
   end;
end;

procedure TFrmMain.ButtonClearMarkersClick(Sender: TObject);
begin
  HTMLWindow2.execScript('ClearMarkers()', 'JavaScript');
  ListView1.Items.Clear;
end;

procedure TFrmMain.ButtonGotoLocationClick(Sender: TObject);
begin
  if Assigned(ListView1.Selected) then
    HTMLWindow2.execScript(Format('GotoLatLng(%s,%s)',[ListView1.Selected.SubItems[0],ListView1.Selected.Caption]), 'JavaScript');
end;

end.

Download the demo application and sourcecode from here


by Leave a comment

WMI Delphi Code Creator – New features and source code published in google code

In the last months I’ been working in a new version of the WMI Delphi Code Creator, porting the original code from Delphi 2007 to XE, adding new features like support for Delphi Prism and Free Pascal, and improving the source code generated by the tool. Now is time to show the results, so the new version is here with many new features,  also  the full source code is now available in the google code project hosting site under the Mozilla Public License 1.1

Check the list of features of the current version

  • Can generate object pascal code compatible with one of these compilers Delphi Win32, Delphi -Prism (Oxygene) , Free Pascal
  • The Delphi code generated is compatible with  Delphi 7, 2005, BDS/Turbo 2006 and RAD Studio 2007, 2009, 2010, XE.
  • The Free Pascal code generated is compatible with these versions 2.4.2, 2.4.4
  • The Delphi prism .Net  (Oxygene) generated code is compatible with all the versions up to 4.0.23.741 (in newer versions must work too)
  • Full access to metadata of any WMI Class registered in the system including qualifiers, mof definition, properties, methods, events
  • You can access directly from the application the MSDN web page related to the WMI Class which your are using.
  • Compile and run the generated code directly form the application using the selected compiler.
  • Open the the generated Delphi code in any of these  Delphi IDE’s 7, 2005, BDS/Turbo 2006 and RAD Studio 2007, 2009, 2010, XE
  • Open the the generated Free Pascal code directly in the Lazarus IDE.
  • Open the the generated Delphi Prism code directly in Visual Studio 2008, Visual Studio 2010 or MonoDevelop.
  • Runs on Windows XP, 2003, 2008, Vista and 7.
  • Themes support for Syntax highlighting (+50 themes included) compatible with the Delphi IDE Theme Editor.

For download the new version of the application and more details go to project page


by 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


by 62 Comments

Introducing the Delphi Preview Handler

To download the last version of the delphi preview handler check the new page of the project.

 
The current beta version of the preview handler (DelphiPreviewHandler.dll)  is 1.0.1.168  please check the version installed before you report bugs.

Some weeks ago I began a parallel project to the Delphi IDE Theme Editor, I name this project Delphi Preview Handler, which basically is a preview handler for windows vista and  7 which allow you read your object pascal, C++ and Assembly code with Syntax highlighting without open in a editor, this preview handler can render these file extensions .pp, .lpr, .lfm, .lpk, .inc, .pas, .dpr,.dfm, .dpk,.dproj, .bdsproj,.c, .cpp,. cc,.h, .hpp,.hh, .cxx, .hxx, . cu, .asm.

Features

  • Supports Windows Vista y Windows 7 32 and 64 bits.
  • +50 themes included to see your code with style
  • Themes compatibles with the Delphi IDE Theme Editor
  • Support these file extensions .pp, .lpr, .lfm, .lpk, .inc, .pas, .dpr,.dfm, .dpk,.dproj, .bdsproj,.c, .cpp,. cc,.h, .hpp,.hh, .cxx, .hxx, . cu, .asm.

Technical Stuff

  • Written in Delphi XE
  • Components used SynEdit

Screenshots

Video

Source Code

Soon, very soon.

Manual Installation

Follow these steps to register the preview handler

1. Choose Start > All Programs > Accessories.
2. Right-click on Command Prompt, Select Run As Administrator, and Authenticate.
3. Go to Delphi Preview Hander folder in Command Prompt.
4. Run “Register.bat”
5. Enjoy

Important Note about editing the Settings.ini file

You can change  the theme used in the Preview Handler editing the Settings.ini file, but before to do this you must unregister the preview handler and close all the explorer windows. to avoid problems. please follow these steps :

1. unregister the dll

2.close all the windows explorer

3.edit the Settings.ini file

4.save the changes

5.register the dll

6.enjoy

Important Note about installing  a new version

In order to avoid problems you must follow these steps when you install or register a new version of the preview handler.

1. close all the windows explorer windows which have the preview handler active or the preview handler was used (remember the dll remains in memory until the windows explorer was closed)

2. unregister the previous version executing the uninstaller located in C:\Program Files (x86)\TheRoadToDelphi\DelphiPreviewHandler or C:\Program Files\TheRoadToDelphi\DelphiPreviewHandler

3. If you install the preview handler manually you must unregister using the UnRegister.bat  running as admin.

4.Now proceed with the installation of the new version.

Download the Binaries of the Delphi Preview Handler from here

Download the Installer (recommended) of the Delphi Preview Handler from here

All your suggestions and comments are very welcome.

Follow

Get every new post delivered to your Inbox.

Join 401 other followers