The Road to Delphi

Delphi – Free Pascal – Oxygene


8 Comments

Listing the running user applications under osx using Delphi

The NSWorkspace class provides a set of methods and properties which allow open and manipulate files, applications and others useful tasks. One of these properties can be used to list the running applications. The property is runningApplications , this will return an array of NSRunningApplication elements representing the running applications. Unfortunately the definition of this interface (NSRunningApplication) in the Macapi.AppKit is incomplete.

  NSRunningApplication = interface(NSObject)
    ['{96F4D9CA-0732-4557-BA1F-177958903B8F}']
    function activateWithOptions(options: NSApplicationActivationOptions): Boolean; cdecl;
    function activationPolicy: NSApplicationActivationPolicy; cdecl;
    function executableArchitecture: NSInteger; cdecl;
    function forceTerminate: Boolean; cdecl;
    function hide: Boolean; cdecl;
    function isActive: Boolean; cdecl;
    function isFinishedLaunching: Boolean; cdecl;
    function isHidden: Boolean; cdecl;
    function isTerminated: Boolean; cdecl;
    function processIdentifier: Integer; cdecl;
    function terminate: Boolean; cdecl;
    function unhide: Boolean; cdecl;
  end;

As you can see in the above definition there is not a property to retrieve the application name or path. So the first task in order to retrieve the list of the running applications is add the missing properties like so.

  NSRunningApplicationEx = interface(NSObject)
    ['{96F4D9CA-0732-4557-BA1F-177958903B8F}']
    function activateWithOptions(options: NSApplicationActivationOptions): Boolean; cdecl;
    function activationPolicy: NSApplicationActivationPolicy; cdecl;
    function executableArchitecture: NSInteger; cdecl;
    function forceTerminate: Boolean; cdecl;
    function hide: Boolean; cdecl;
    function isActive: Boolean; cdecl;
    function isFinishedLaunching: Boolean; cdecl;
    function isHidden: Boolean; cdecl;
    function isTerminated: Boolean; cdecl;
    function processIdentifier: Integer; cdecl;
    function terminate: Boolean; cdecl;
    function unhide: Boolean; cdecl;

    //Added functions(properties)
    //Indicates the URL to the application's executable.
    function executableURL : NSURL; cdecl;//@property (readonly) NSURL *executableURL;
    //Indicates the name of the application.  This is dependent on the current localization of the referenced app, and is suitable for presentation to the user.
    function localizedName : NSString; cdecl;//@property (readonly) NSString *localizedName;
    //Indicates the URL to the application's bundle, or nil if the application does not have a bundle.
    function bundleURL : NSURL; cdecl;//@property (readonly) NSURL *bundleURL;
    //Indicates the CFBundleIdentifier of the application, or nil if the application does not have an Info.plist.
    function bundleIdentifier : NSString; cdecl;//@property (readonly) NSString *bundleIdentifier;
    //Indicates the date when the application was launched.  This property is not available for all applications.  Specifically, it is not available for applications that were launched without going through LaunchServices.   */
    function launchDate : NSDate;cdecl;//@property (readonly) NSDate *launchDate;
    //Returns the icon of the application.
    function icon : NSImage;cdecl;//@property (readonly) NSImage *icon;
  end;
  TNSRunningApplicationEx = class(TOCGenericImport<NSRunningApplicationClass, NSRunningApplicationEx>)  end;

Now using a TStringGrid we can list all the user applications running

var
  LWorkSpace : NSWorkspace;
  LApp       : NSRunningApplicationEx;
  LFormatter : NSDateFormatter;
  i : integer;
  LArray     : NSArray;
begin
  LWorkSpace:=TNSWorkspace.create;//or TNsWorkspace.Wrap(TNsWorkSpace.OCClass.sharedWorkspace);
  LArray:=LWorkSpace.runningApplications;
  //NSDateFormatter Class Reference
  //https://developer.apple.com/library/mac/#documentation/Cocoa/Reference/Foundation/Classes/NSDateFormatter_Class/Reference/Reference.html
  TNSDateFormatter.OCClass.setDefaultFormatterBehavior(NSDateFormatterBehavior10_4);
  LFormatter:=TNSDateFormatter.Create;
  LFormatter.setDateFormat(NSSTR('HH:mm:ss YYYY/MM/dd'));
  if LArray<>nil then
  begin
    StringGrid1.RowCount:=LArray.count;
   for i := 0 to LArray.count-1 do
   begin
     LApp:= TNSRunningApplicationEx.Wrap(LArray.objectAtIndex(i));
     StringGrid1.Cells[0,i]:=LApp.processIdentifier.ToString();
     if LApp.launchDate<>nil then
     StringGrid1.Cells[1,i]:=string(LFormatter.stringFromDate(LApp.launchDate).UTF8String);
     StringGrid1.Cells[2,i]:=string(LApp.localizedName.UTF8String);
     StringGrid1.Cells[3,i]:=string(LApp.executableURL.path.UTF8String);

     if LApp.bundleIdentifier<>nil then
       StringGrid1.Cells[4,i]:=string(LApp.bundleIdentifier.UTF8String);

     if LApp.bundleURL<>nil then
       StringGrid1.Cells[5,i]:=string(LApp.bundleURL.path.UTF8String);

      case LApp.executableArchitecture of
        NSBundleExecutableArchitectureI386  :   StringGrid1.Cells[6,i]:='I386';
        NSBundleExecutableArchitecturePPC   :   StringGrid1.Cells[6,i]:='PPC';
        NSBundleExecutableArchitecturePPC64 :   StringGrid1.Cells[6,i]:='PPC64';
        NSBundleExecutableArchitectureX86_64:   StringGrid1.Cells[6,i]:='X86_64';
      end;
   end;
  end;
end;

And this is the final result.

Mac OS X Lion

Note : The runningApplications property only list the user applications and does not provide information about every process on the system. In order to access to all the process you can use the sysctl function with the CTL_KERN, KERN_PROC, KERN_PROC_ALL values.

Download the sample Firemonkey project from Github.


Leave a comment

Getting System information in OSX and iOS using Delphi (XE2, XE3, XE4) Part 2

This is the continuation of the Getting System information in OSX and iOS using Delphi (XE2, XE3, XE4) Part 1 article.

Inside of the Posix.SysSysctl unit (which is the translation for the sysctl.h file) you can find a set of arrays (CTL_NAMES, CTL_KERN_NAMES, CTL_HW_NAMES, CTL_USER_NAMES, CTL_VM_NAMES) which contains the alias names for the system information elements, so using the items of these arrays you can build the name parameter for the SysCtlByName method.

For example if you want to access the kernel version you can build the alias like so

  Name:=PAnsiChar(CTL_NAMES[CTL_KERN].ctl_name+'.'+CTL_KERN_NAMES[KERN_VERSION].ctl_name);//kern.version

And then using the SysCtlByName method

function KernelVersion: AnsiString;
var
  res : Integer;
  len : size_t;
  p, Name: PAnsiChar;
begin
  len := SizeOf(Result);
  Name:=PAnsiChar(CTL_NAMES[CTL_KERN].ctl_name+'.'+CTL_KERN_NAMES[KERN_VERSION].ctl_name);
  res:=SysCtlByName(Name, nil, @len, nil, 0);
   if (len>0) and (res=0)  then
   begin
     GetMem(p, len);
     try
       res:=SysCtlByName(Name, p, @len, nil, 0);
       if res=0 then
        Result:=p;
     finally
       FreeMem(p);
     end;
   end;
end;

Another option is use these definitions for build a set of methods to retrieve all the system info included in these structs.

Try the next sample project.

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Classes,
  System.Types,
  Posix.Errno,
  Posix.SysTypes,
  Posix.SysSysctl,
  System.SysUtils;

function GetsysctlIntValue(mib: TIntegerDynArray) : integer;
var
  len : size_t;
  res : integer;
begin
   len := sizeof(Result);
   res:=sysctl(@mib[0], 2, @Result, @len, nil, 0);
   if res<>0 then
    Result:=-1;// RaiseLastOSError;
end;

function GetsysctlInt64Value(mib: TIntegerDynArray) : Int64;
var
  len : size_t;
  res : integer;
begin
   len := sizeof(Result);
   res:=sysctl(@mib[0], 2, @Result, @len, nil, 0);
   if res<>0 then
     Result:=-1; //RaiseLastOSError;
end;

function GetsysctlStrValue(mib: TIntegerDynArray) : AnsiString;
var
  len : size_t;
  p   : PAnsiChar;
  res : integer;
begin
   Result:='';
   res:=sysctl(@mib[0], 2, nil, @len, nil, 0);
   if (len>0) and (res=0)  then
   begin
     GetMem(p, len);
     try
       res:=sysctl(@mib[0], 2, p, @len, nil, 0);
       if res=0 then
        Result:=p;
     finally
       FreeMem(p);
     end;
   end;
end;

procedure  ListKernelValues;
var
  mib : TIntegerDynArray;
  i   : Integer;
begin
 Writeln('High kernel limits');
 Writeln('------------------');
 for i:=0 to KERN_MAXID-1 do
 begin
    mib:=TIntegerDynArray.Create(CTL_KERN, i);
    case CTL_KERN_NAMES[i].ctl_type of
     CTLTYPE_NODE  :  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, '[node]']));
     CTLTYPE_OPAQUE:  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, '[structure]']));
     CTLTYPE_INT   :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, GetsysctlIntValue(mib)]));
     CTLTYPE_QUAD  :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, GetsysctlInt64Value(mib)]));
     CTLTYPE_STRING : Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, GetsysctlStrValue(mib)]));
    end;
 end;
 Writeln;
end;

procedure  ListGenericCPU_IO_Values;
var
  mib : TIntegerDynArray;
  i   : Integer;
begin
 Writeln('Generic CPU, I/O');
 Writeln('-----------------');
 for i:=0 to HW_MAXID-1 do
 begin
    mib:=TIntegerDynArray.Create(CTL_HW, i);
    case CTL_HW_NAMES[i].ctl_type of
     CTLTYPE_NODE  :  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, '[node]']));
     CTLTYPE_OPAQUE:  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, '[structure]']));
     CTLTYPE_INT   :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, GetsysctlIntValue(mib)]));
     CTLTYPE_QUAD  :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, GetsysctlInt64Value(mib)]));
     CTLTYPE_STRING : Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, GetsysctlStrValue(mib)]));
    end;
 end;
 Writeln;
end;

procedure  ListUserLevelValues;
var
  mib : TIntegerDynArray;
  i   : Integer;
begin
 mib:=TIntegerDynArray.Create(CTL_USER, 0);
 Writeln('User-level');
 Writeln('----------');
 for i:=0 to USER_MAXID-1 do
 begin
    mib[1]:=i;
    case CTL_USER_NAMES[i].ctl_type of
     CTLTYPE_NODE  :  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, '[node]']));
     CTLTYPE_OPAQUE:  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, '[structure]']));
     CTLTYPE_INT   :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, GetsysctlIntValue(mib)]));
     CTLTYPE_QUAD  :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, GetsysctlInt64Value(mib)]));
     CTLTYPE_STRING : Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, GetsysctlStrValue(mib)]));
    end;
 end;
 Writeln;
end;

procedure  ListVMValues;
var
  mib : TIntegerDynArray;
  i   : Integer;
begin
 Writeln('Virtual memory');
 Writeln('-------------');
 for i:=0 to VM_MAXID-1 do
 begin
    mib:=TIntegerDynArray.Create(CTL_VM, i);
    case CTL_VM_NAMES[i].ctl_type of
     CTLTYPE_NODE  :  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, '[node]']));
     CTLTYPE_OPAQUE:  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, '[structure]']));
     CTLTYPE_INT   :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, GetsysctlIntValue(mib)]));
     CTLTYPE_QUAD  :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, GetsysctlInt64Value(mib)]));
     CTLTYPE_STRING : Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, GetsysctlStrValue(mib)]));
    end;
 end;
 Writeln;
end;

begin
  try
    ListKernelValues;
    ListGenericCPU_IO_Values;
    ListUserLevelValues;
    ListVMValues;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


3 Comments

Getting System information in OSX and iOS using Delphi (XE2, XE3, XE4) Part 1

In the following article you can learn how to use the sysctl, sysctlbyname and sysctlnametomib functions to get system information (kernel values, hardware, networking, file system, machine specific and user related data) under the OSX and iOS systems.

sysctl

int sysctl(int *name, u_int namelen, void *oldp, size_t *oldlenp, void *newp, size_t newlen);

The sysctl allows you retrieves and set system information, the data returned from the sysctl() function consists of integers (int32, int64), strings(AnsiStrings) and structs (records). this function is defined in the Posix.SysSysctl (SysSysctlAPI.inc) unit

Note : The Posix.SysSysctl unit is a partial translation the sysctl.h file.

function sysctl(name: PInteger; namelen: cardinal; oldp: Pointer; oldlen: Psize_t; newp: Pointer; newlen: size_t): Integer; cdecl; external libc name _PU + 'sysctl';

name : This parameter receive a pointer to a Management Information Base (MIB) style value, which is only a array of integers. Each element of this array must be filled with the values related to the info to read or write.

The number of elements of this array, depends of the data to be obtained or modified, most of times only we need to pass and fill a mib with 2 elements (integer values). The first element indicates the level(location) of the info and the second element indicates the value to retrieve.

These are the possible values for the first element of the mib.

           Name           Value            Description
           CTL_DEBUG      $00000005        Debugging
           CTL_VFS        $00000003        File system
           CTL_HW         $00000006        Generic CPU, I/O
           CTL_KERN       $00000001        High kernel limits
           CTL_MACHDEP    $00000007        Machine dependent
           CTL_NET        $00000004        Networking
           CTL_USER       $00000008        User-level
           CTL_VM         $00000002        Virtual memory 

Note: All these values are already defined in the Posix.SysSysctl unit.

So if we want access to the kernel related values we must fill the mib like so

var
  mib : array[0..1] of Integer;
...
...
 mib[0] := CTL_KERN;

The second element value is related to the first level and the possible values are defined in the Posix.SysSysctl unit as well, for example to get the max processes supported by the system we must use the KERN_MAXPROC($00000006) value.

var
  mib : array[0..1] of Integer;
...
...
 mib[0] := CTL_KERN;
 mib[1] := KERN_MAXPROC;

namelen : This parameter is the length of the mib structure.
oldp: Must be filled with a pointer to the buffer to receive. The info which can be a integer, int64, a AnsiString(MarshaledAString) or a record.
oldlen: Indicates the size of the oldp parameter.
newp: This parameter must be filled with a pointer to the buffer to with the info to set up, when you don’t modify the data you must pass a nil value.
newlen: Indicates the size of the newp parameter.

So with all the above info now you can write a function to retrieve the max processes supported, check this sample code which retrieves a integer value.

function MaxProcesses : Integer;
var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
begin

 mib[0] := CTL_KERN;
 mib[1] := KERN_MAXPROC;

 len := sizeof(Result);
 res:=sysctl(@mib, Length(mib), @Result, @len, nil, 0);
 if res<>0 then
  RaiseLastOSError;
end;

To get a Int64 value the code is very similar, check this sample which get the size of the memory installed on the system using the CTL_HW level and the HW_MEMSIZE value.

function MemSize : Int64;
var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
begin
 mib[0] := CTL_HW;
 mib[1] := HW_MEMSIZE;

 len := sizeof(Result);
 res := sysctl(@mib, Length(mib), @Result, @len, nil, 0);
 if res<>0 then
  RaiseLastOSError;
end;

If you want retrieve a string value, you must get the length of the value before to allocate the buffer, to do this you must pass a nil value in the oldp parameter like so.

sysctl(@mib, Length(mib), nil, @len, nil, 0)

The next code shows how to get a string(ascii) type using the sysctl function.

function KernelVersion : AnsiString;
var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
  p   : MarshaledAString;//in XE2 you can use the PAnsiChar type
begin
 mib[0] := CTL_KERN;
 mib[1] := KERN_VERSION;
 //get the length of the buffer 
 res := sysctl(@mib, Length(mib), nil, @len, nil, 0);
 if res<>0 then
   RaiseLastOSError;
 //allocates the buffer
 GetMem(p, len);
 try
   res := sysctl(@mib, Length(mib), p, @len, nil, 0);
   if res<>0 then
     RaiseLastOSError;
   Result:=p;
 finally
   FreeMem(p);
 end;
end;

Finally we can use the sysctl function to retrieve complex structures(records) passing a pointer to the record to hold the data.

Try this sample which get the clock rate values from the kernel.

procedure GetClockInfo;
type
 clockinfo = record
	hz      : Integer;
	tick    : Integer;
	tickadj : Integer;
	stathz  : Integer;
	profhz  : Integer;
  end;

(*
struct clockinfo {
	int	hz;	   	/* clock frequency */
	int	tick;		/* micro-seconds per hz tick */
	int	tickadj;/* clock skew rate for adjtime() */
	int	stathz;		/* statistics clock frequency */
	int	profhz;		/* profiling clock frequency */
};
*)

var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
  clock : clockinfo;
begin
 FillChar(clock, sizeof(clock), 0);
 mib[0] := CTL_KERN;
 mib[1] := KERN_CLOCKRATE;
 len := sizeof(clock);
 res:=sysctl(@mib, Length(mib), @clock, @len, nil, 0);
 if res<>0 then
   RaiseLastOSError;

 Writeln(Format('clock frequency             %d',[clock.hz]));
 Writeln(Format('micro-seconds per hz tick   %d',[clock.tick]));
 Writeln(Format('clock skew rate for adjtime %d',[clock.tickadj]));
 Writeln(Format('statistics clock frequency  %d',[clock.stathz]));
 Writeln(Format('profiling clock frequency   %d',[clock.profhz]));
end;

sysctlbyname

int sysctlbyname(const char *name, void *oldp, size_t *oldlenp, void *newp, size_t newlen);

The sysctlbyname works in the same way which the sysctl, the only difference is which the values are accessed using a alias string. because that you don’t need pass a mib structure and length to this function.

function sysctlbyname(Name: MarshaledAString; oldp: Pointer; oldlen: Psize_t; newp: Pointer; newlen: size_t): Integer; cdecl; external libc name _PU + 'sysctlbyname';

name: this parameter is the alias for the info to access and is composed by the level splus the string representation of the value to get, because that you don’t need pass a mib structure.

These are the possible values for the first level element

           Name           string 
           CTL_DEBUG      debug
           CTL_VFS        vfs
           CTL_HW         hw
           CTL_KERN       kern
           CTL_MACHDEP    machdep
           CTL_NET        net
           CTL_USER       user
           CTL_VM         vm

This is a sample list of some of the values which you can use in the name parameter of the sysctlbyname function.

     Name                            Type           
     kern.ostype                     string       
     kern.osrelease                  string       
     kern.osrevision                 integer      
     kern.version                    string       
     kern.maxvnodes                  integer       
     kern.maxproc                    integer       
     kern.maxfiles                   integer       
     kern.argmax                     integer      
     kern.securelevel                integer       
     kern.hostname                   string        
     kern.hostid                     integer       
     kern.clockrate                  struct       
     kern.posix1version              integer      
     kern.ngroups                    integer      
     kern.job_control                integer      
     kern.saved_ids                  integer      
     kern.link_max                   integer      
     kern.max_canon                  integer      
     kern.max_input                  integer      
     kern.name_max                   integer      
     kern.path_max                   integer      
     kern.pipe_buf                   integer      
     kern.chown_restricted           integer      
     kern.no_trunc                   integer      
     kern.vdisable                   integer      
     kern.boottime                   struct       
     vm.loadavg                      struct       
     vm.swapusage                    struct       
     machdep.console_device          dev_t        
     net.inet.ip.forwarding          integer       
     net.inet.ip.redirect            integer       
     net.inet.ip.ttl                 integer       
     net.inet.icmp.maskrepl          integer      
     net.inet.udp.checksum           integer       
     hw.machine                      string       
     hw.model                        string       
     hw.ncpu                         integer      
     hw.byteorder                    integer      
     hw.physmem                      integer      
     hw.usermem                      integer      
     hw.memsize                      integer      
     hw.pagesize                     integer      
     user.cs_path                    string       
     user.bc_base_max                integer      
     user.bc_dim_max                 integer      
     user.bc_scale_max               integer      
     user.bc_string_max              integer      
     user.coll_weights_max           integer      
     user.expr_nest_max              integer      
     user.line_max                   integer      
     user.re_dup_max                 integer      
     user.posix2_version             integer      
     user.posix2_c_bind              integer      
     user.posix2_c_dev               integer      
     user.posix2_char_term           integer      
     user.posix2_fort_dev            integer      
     user.posix2_fort_run            integer      
     user.posix2_localedef           integer      
     user.posix2_sw_dev              integer      
     user.posix2_upe                 integer      

Note : You can get a full list of the supported values running the sysctl -A command from a Terminal.

Finally this code shows how use the SysCtlByName function to retrieve the number of cpus installed.

function NumberOfCPU: Integer;
var
  res : Integer;
  len : size_t;
begin
  len := SizeOf(Result);
  res:=SysCtlByName('hw.ncpu', @Result, @len, nil, 0);
  if res<>0 then
    RaiseLastOSError;
end;

Note : The sysctl function runs in about a third the time as the same request made via the sysctlbyname, so when is possible uses sysctl instead.

sysctlnametomib

int sysctlnametomib(const char *name, int *mibp, size_t *sizep);

The sysctlnametomib function fill a mib structure using a alias a string. this function is intended for use by apps that want to repeatedly use the same variable.

function sysctlnametomib(name: MarshaledAString; mibp: PInteger; sizep: Psize_t): Integer; cdecl; external libc name _PU + 'sysctlnametomib';

name: ASCII representation of the value to retrieve.
mibp: pointer to the mib structure to fill.
sizep: pointer to the length of the mib structure to fill.

var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
begin
  len := Length(mib);
  sysctlnametomib('hw.physicalcpu', @mib, @len);
  //now the mib structure is filled with the proper values to call the sysctl function. 

Error Handling

All the above functions returns a 0 values when the execution was succefull, otherwise an error code is returned, this code can be obtained using the errno (Posix.Errno) or the GetLastError function.

The following errors may be reported (theses values and meanings are defined in the osx/ErrnoTypes.inc file)

     [EFAULT]           The buffer name, oldp, newp, or length pointer oldlenp contains an invalid address.
     [EINVAL]           The name array is less than two or greater than CTL_MAXNAME.
     [EINVAL]           A non-null newp is given and its specified length in newlen is too large or too
                        small.
     [ENOMEM]           The length pointed to by oldlenp is too short to hold the requested value.
     [ENOMEM]           The smaller of either the length pointed to by oldlenp or the estimated size of the
                        returned data exceeds the system limit on locked memory.
     [ENOMEM]           Locking the buffer oldp, or a portion of the buffer if the estimated size of the
                        data to be returned is smaller, would cause the process to exceed its per-process
                        locked memory limit.
     [ENOTDIR]          The name array specifies an intermediate rather than terminal name.
     [EISDIR]           The name array specifies a terminal name, but the actual name is not terminal.
     [ENOENT]           The name array specifies a value that is unknown.
     [EPERM]            An attempt is made to set a read-only value.
     [EPERM]            A process without appropriate privilege attempts to set a value.

This a full sample console app which summarizes this article.

{$APPTYPE CONSOLE}

uses
  //System.Classes,
  //System.Types,
  //Posix.Errno,
  Posix.SysTypes,
  Posix.SysSysctl,
  System.SysUtils;

//https://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man3/sysctl.3.html
//https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man8/sysctl.8.html


function NumberOfCPU: Integer;
var
  res : Integer;
  len : size_t;
begin
  len := SizeOf(Result);
  res:=SysCtlByName('hw.ncpu', @Result, @len, nil, 0);
  if res<>0 then
    RaiseLastOSError;
end;


function MaxProcesses : Integer;
var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
begin

 mib[0] := CTL_KERN;
 mib[1] := KERN_MAXPROC;

 len := sizeof(Result);
 res:=sysctl(@mib, Length(mib), @Result, @len, nil, 0);
 if res<>0 then
  RaiseLastOSError;
end;

function MemSize : Int64;
var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
begin
 mib[0] := CTL_HW;
 mib[1] := HW_MEMSIZE;

 len := sizeof(Result);
 res := sysctl(@mib, Length(mib), @Result, @len, nil, 0);
 if res<>0 then
  RaiseLastOSError;
end;


function KernelVersion : AnsiString;
var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
  p   : MarshaledAString;//in XE2 use  PAnsiChar
begin
 mib[0] := CTL_KERN;
 mib[1] := KERN_VERSION;
 res := sysctl(@mib, Length(mib), nil, @len, nil, 0);
 if res<>0 then
   RaiseLastOSError;
 GetMem(p, len);
 try
   res := sysctl(@mib, Length(mib), p, @len, nil, 0);
   if res<>0 then
     RaiseLastOSError;
   Result:=p;
 finally
   FreeMem(p);
 end;
end;


procedure GetClockInfo;
type
 clockinfo = record
	hz      : Integer;
	tick    : Integer;
	tickadj : Integer;
	stathz  : Integer;
	profhz  : Integer;
  end;

(*
struct clockinfo {
	int	hz;	   	/* clock frequency */
	int	tick;		/* micro-seconds per hz tick */
	int	tickadj;/* clock skew rate for adjtime() */
	int	stathz;		/* statistics clock frequency */
	int	profhz;		/* profiling clock frequency */
};
*)

var
  mib : array[0..1] of Integer;
  res : Integer;
  len : size_t;
  clock : clockinfo;
begin
 FillChar(clock, sizeof(clock), 0);
 mib[0] := CTL_KERN;
 mib[1] := KERN_CLOCKRATE;
 len := sizeof(clock);
 res:=sysctl(@mib, Length(mib), @clock, @len, nil, 0);
 if res<>0 then
   RaiseLastOSError;

 Writeln(Format('clock frequency             %d',[clock.hz]));
 Writeln(Format('micro-seconds per hz tick   %d',[clock.tick]));
 Writeln(Format('clock skew rate for adjtime %d',[clock.tickadj]));
 Writeln(Format('statistics clock frequency  %d',[clock.stathz]));
 Writeln(Format('profiling clock frequency   %d',[clock.profhz]));
end;

begin
  try
    Writeln(Format('max processes     %d',[MaxProcesses]));
    Writeln(Format('number of cpus    %d',[NumberOfCPU]));
    Writeln(Format('physical ram size %s',[FormatFloat('#,', MemSize)]));
    Writeln(Format('Kernel Version    %s',[KernelVersion]));
    GetClockInfo;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


2 Comments

Vcl Styles Utils updated to fix QC #114040, #114032 (XE2 and XE3)

I just commit in the Vcl Styles Project two new fixes to patch the QC 114040 and QC 114032 (these issues exist in Delphi XE2 and XE3), both reports are related to the Highlight colors used to draw the TColorBox and TComboBoxEx components when the Vcl Styles are active.

QC 114032

As you can see in the below image the TColorBox component doesn’t use the proper highlight color, but the TColorListBox uses the highlight color of the current Vcl Style.

TColorBoxQC

The TColorBox control doesn’t use a Style Hook, so the fix was done using a interposer class. To apply the path just add the Vcl.Styles.Fixes unit to your uses list after of the Vcl.ExtCtrls unit. And the result will be

TColorBoxFix

QC 114040

The TComboBoxEx control have a similar issue.

TcomboboxExQc

In this case fixing the Style Hook related to the TComboBoxEx control was the key.

TcomboboxExFix

To apply this fix, just register the TComboBoxExStyleHookFix style hook located in the Vcl.Styles.Fixes unit.


4 Comments

Added new vcl style hook to the Vcl Styles Utils to fix QC #108678, #108875 (XE2 and XE3)

I just added a new vcl style hook (TListViewStyleHookFix) for the TListView component in the Vcl Styles Utils project to fix the QC #108678, #108875 (XE2 and XE3)

The issue reported in both reports, is that the images are not displayed in the TListView header with the VCL Styles enabled.

When you uses the Windows Theme in a TListView with images in the header will look like so

LVWindows

But if you enable the Vcl Styles, the images in the header are lost.

LVStyles2

The issue is located in the TListViewStyleHook.DrawHeaderSection method, this method must paint the image and text of each section of the header of the ListView.

This is part of the code with the bug

  ...
  ...
  ImageList := SendMessage(Handle, HDM_GETIMAGELIST, 0, 0);
  Item.Mask := HDI_FORMAT or HDI_IMAGE;
  InflateRect(R, -2, -2);
  if (ImageList <> 0) and Header_GetItem(Handle, Index, Item) then
  begin
    if Item.fmt and HDF_IMAGE = HDF_IMAGE then
      ImageList_Draw(ImageList, Item.iImage, Canvas.Handle, R.Left, R.Top, ILD_TRANSPARENT);
    ImageList_GetIconSize(ImageList, IconWidth, IconHeight);
    Inc(R.Left, IconWidth + 5);
  end;
  ...
  ...

The problem with the above code is that the SendMessage function with the HDM_GETIMAGELIST message (which is used to get the current imagelist) is not using the proper Handle. The above code is passing the handle of the ListView, but must pass the handle of the Header control, the same applies to the call to the Header_GetItem method.

The TListViewStyleHookFix introduces a new DrawHeaderSection method which passes the handle of the header control and fix the issue. You can use this Stylehook adding Vcl.Styles.Fixes unit to you uses clause and then register the hook on this way.

initialization
   TStyleManager.Engine.RegisterStyleHook(TListView, TListViewStyleHookFix);

LVStylesFix


11 Comments

Exploring Delphi XE3 – Accesing Windows Sensors from VCL (and Firemonkey)

Delphi XE3 includes support for sensors in OSX and Windows, the classes and types necessaries to access such devices are defined as abstract classes in the System.Sensors unit and implemented in the System.Mac.Sensors unit for OSX and System.Win.Sensors unit for Windows. This article will focus in the Windows side implementation.

Windows 7 introduces the Sensor and Location API, which unifies the access to hardware devices like GPS, Light Sensors, Biometric Sensors and so on. Avoiding the need of use a specific dlls or SDK to control the sensor devices. this API is condensed on these files which are part of the Windows 7 Software Development Kit (SDK).

File name Description
Sensorsapi.h The main header file for the Sensor API. This header file contains the interface definitions.
Sensors.h The header file that contains definitions of platform-defined constants.
Initguid.h The header file that contains definitions for controlling GUID initialization.{
FunctionDiscoveryKeys.h The header file that defines device ID property keys that are required when you connect to logical sensors.
Sensorsapi.lib A static library that contains GUID definitions for the Sensor API.
PortableDeviceGuids.lib A static library that contains GUID definitions for Windows Portable Devices objects.

All these headers was translated by Embarcadero and included as part of the RTL of the Delphi XE3, these are the units which contains such translations Winapi.Portabledevicetypes, Winapi.Sensors, Winapi.Sensorsapi, Winapi.Locationapi. Fortunately an additional set of classes was added to wrap the sensors API, these classes are defined and implemented in the System.Sensors and System.Win.Sensors units. So you don’t need access directly interfaces like ISensor or ISensorManager to gain access to the sensors.

Enumerating Sensors

In order to gain access to the sensors you must get an instance to the TSensorManager class and then call the Activate method, from here you can iterate over the Sensors property or use the GetSensorsByCategory method to get an array of TSensor objects filtered by an TSensorCategory.

var
  LManager : TSensorManager;
  LSensors : TSensorArray;
  LSensor  : TCustomSensor;
begin
  LManager := TSensorManager.Current;
  LManager.Activate;
  try
    LSensors  := LManager.GetSensorsByCategory(TSensorCategory.Location);
    for LSensor in LSensors do
    begin
      //do something
    end;
  finally
    LManager.Deactivate;
  end;
end;

All the sensors share a common set of properties like the Manufacturer, Model, Serial number and so on. So extending the above code you can access such properties on this way :

var
  LManager : TSensorManager;
  LSensors : TSensorArray;
  LSensor  : TCustomSensor;
begin
  LManager := TSensorManager.Current;
  LManager.Activate;
  try
    LSensors  := LManager.GetSensorsByCategory(TSensorCategory.Location);
    for LSensor in LSensors do
    begin
      Writeln(Format('Description  : %s', [LSensor.Description]));
      Writeln(Format('Manufacturer : %s', [LSensor.Manufacturer]));
      Writeln(Format('Model        : %s', [LSensor.Model]));
      Writeln(Format('Serial No    : %s', [LSensor.SerialNo]));
      Writeln(Format('State        : %s', [GetEnumName(TypeInfo(TSensorState),integer(LSensor.State))]));
      Writeln(Format('TimeStamp    : %s', [DatetoStr(LSensor.TimeStamp)]));
      Writeln(Format('Unique ID    : %s', [LSensor.UniqueID]));
    end;
  finally
    LManager.Deactivate;
  end;
end;

Now depending of the sensor category, you must cast the TCustomSensor to the proper specific class, in this case we will use the TCustomLocationSensor class.

var
  LManager : TSensorManager;
  LSensors : TSensorArray;
  LSensor  : TCustomSensor;
  LLocationSensor          : TCustomLocationSensor;
begin
  LManager := TSensorManager.Current;
  LManager.Activate;
  try
    LSensors  := LManager.GetSensorsByCategory(TSensorCategory.Location);
    for LSensor in LSensors do
    begin
      Writeln(Format('Description  : %s', [LSensor.Description]));
      Writeln(Format('Manufacturer : %s', [LSensor.Manufacturer]));
      Writeln(Format('Model        : %s', [LSensor.Model]));
      Writeln(Format('Serial No    : %s', [LSensor.SerialNo]));
      Writeln(Format('State        : %s', [GetEnumName(TypeInfo(TSensorState),integer(LSensor.State))]));
      Writeln(Format('TimeStamp    : %s', [DatetoStr(LSensor.TimeStamp)]));
      Writeln(Format('Unique ID    : %s', [LSensor.UniqueID]));

        LLocationSensor:=LSensor as TCustomLocationSensor;
        LLocationSensor.Start;
        try
          Writeln(Format('Sensor Type       : %s', [GetEnumName(TypeInfo(TLocationSensorType),integer(LLocationSensor.SensorType))]));
          Writeln(Format('Authorized        : %s', [GetEnumName(TypeInfo(TAuthorizationType),integer(LLocationSensor.Authorized))]));
          Writeln(Format('Accuracy          : %n', [LLocationSensor.Accuracy]));
          Writeln(Format('Distance          : %n', [LLocationSensor.Distance]));
          Writeln(Format('Power Consumption : %s', [GetEnumName(TypeInfo(TPowerConsumption),integer(LLocationSensor.PowerConsumption))]));
          Writeln(Format('Location Change   : %s', [GetEnumName(TypeInfo(TLocationChangeType),integer(LLocationSensor.LocationChange))]));
          if TCustomLocationSensor.TProperty.Latitude in  LLocationSensor.AvailableProperties then
          Writeln(Format('Latitude          : %n', [LLocationSensor.Latitude]));
          if TCustomLocationSensor.TProperty.Longitude in  LLocationSensor.AvailableProperties then
          Writeln(Format('Longitude         : %n', [LLocationSensor.Longitude]));
          if TCustomLocationSensor.TProperty.ErrorRadius in  LLocationSensor.AvailableProperties then
          Writeln(Format('Error Radius      : %n', [LLocationSensor.ErrorRadius]));
          if TCustomLocationSensor.TProperty.Altitude in  LLocationSensor.AvailableProperties then
          Writeln(Format('Altitude          : %n', [LLocationSensor.Altitude]));
          if TCustomLocationSensor.TProperty.Speed in  LLocationSensor.AvailableProperties then
          Writeln(Format('Speed             : %n', [LLocationSensor.Speed]));
          if TCustomLocationSensor.TProperty.TrueHeading in  LLocationSensor.AvailableProperties then
          Writeln(Format('True Heading      : %n', [LLocationSensor.TrueHeading]));
          if TCustomLocationSensor.TProperty.MagneticHeading in  LLocationSensor.AvailableProperties then
          Writeln(Format('Magnetic Heading  : %n', [LLocationSensor.MagneticHeading]));
          if TCustomLocationSensor.TProperty.Address1 in  LLocationSensor.AvailableProperties then
          Writeln(Format('Address1          : %s', [LLocationSensor.Address1]));
          if TCustomLocationSensor.TProperty.Address2 in  LLocationSensor.AvailableProperties then
          Writeln(Format('Address2          : %s', [LLocationSensor.Address2]));
          if TCustomLocationSensor.TProperty.City in  LLocationSensor.AvailableProperties then
          Writeln(Format('City              : %s', [LLocationSensor.City]));
          if TCustomLocationSensor.TProperty.StateProvince in  LLocationSensor.AvailableProperties then
          Writeln(Format('State/Province    : %s', [LLocationSensor.StateProvince]));
          if TCustomLocationSensor.TProperty.PostalCode in  LLocationSensor.AvailableProperties then
          Writeln(Format('Postal Code       : %s', [LLocationSensor.PostalCode]));
          if TCustomLocationSensor.TProperty.CountryRegion in  LLocationSensor.AvailableProperties then
          Writeln(Format('Country Region    : %s', [LLocationSensor.CountryRegion]));
        finally
          LLocationSensor.Stop;
        end;
        Writeln;
    end;
  finally
    LManager.Deactivate;
  end;

end;

Not all the properties exposed by the Windows sensors and Location API are mapped directly in the TCustomSensors class, so to access this additional data you can use the HasCustomData and CustomData indexed properties and use one of the values defined in the Winapi.Sensors unit which is the translation of the Sensors.h header file.

  if LLocationSensor.HasCustomData[SENSOR_DATA_TYPE_SATELLITES_USED_COUNT]  then
    Writeln(Format('Satellites used : %d', [ Integer(LLocationSensor.CustomData[SENSOR_DATA_TYPE_SATELLITES_USED_COUNT])]));

Sample Application

Check this sample console application which enumerates all the sensors and properties.

{$APPTYPE CONSOLE}

uses
  System.TypInfo,
  System.Sensors,
  System.SysUtils;

procedure EnumerateSensors;
var
  LManager : TSensorManager;
  LCustomLocationSensor          : TCustomLocationSensor;
  LCustomLightSensor             : TCustomLightSensor;
  LCustomEnvironmentalSensor     : TCustomEnvironmentalSensor;
  LCustomMotionSensor            : TCustomMotionSensor;
  LCustomOrientationSensor       : TCustomOrientationSensor;
  LCustomMechanicalSensor        : TCustomMechanicalSensor;
  LCustomElectricalSensor        : TCustomElectricalSensor;
  LCustomBiometricSensor         : TCustomBiometricSensor;
  LCustomScannerSensor           : TCustomScannerSensor;
  LSensor  : TCustomSensor;
  i        : Integer;
begin
  LManager := TSensorManager.Current;
  LManager.Activate;
  //LSensors  := LManager.GetSensorsByCategory(TSensorCategory.Location);
  if LManager.Count > 0 then
  for i := 0 to LManager.Count-1 do
  begin
    Writeln(Format('Sensor %d',[i+1]));
    Writeln('--------');

    LSensor:= LManager.Sensors[i];
    Writeln(Format('Category     : %s', [GetEnumName(TypeInfo(TSensorCategory),integer(LSensor.Category))]));
    Writeln(Format('Description  : %s', [LSensor.Description]));
    Writeln(Format('Manufacturer : %s', [LSensor.Manufacturer]));
    Writeln(Format('Model        : %s', [LSensor.Model]));
    Writeln(Format('Serial No    : %s', [LSensor.SerialNo]));
    Writeln(Format('State        : %s', [GetEnumName(TypeInfo(TSensorState),integer(LSensor.State))]));
    Writeln(Format('TimeStamp    : %s', [DatetoStr(LSensor.TimeStamp)]));
    Writeln(Format('Unique ID    : %s', [LSensor.UniqueID]));

    case LSensor.Category of

      TSensorCategory.Location :
      begin
        LCustomLocationSensor:=LSensor as TCustomLocationSensor;
        LCustomLocationSensor.Start;
        Writeln(Format('Sensor Type       : %s', [GetEnumName(TypeInfo(TLocationSensorType),integer(LCustomLocationSensor.SensorType))]));
        Writeln(Format('Authorized        : %s', [GetEnumName(TypeInfo(TAuthorizationType),integer(LCustomLocationSensor.Authorized))]));
        Writeln(Format('Accuracy          : %n', [LCustomLocationSensor.Accuracy]));
        Writeln(Format('Distance          : %n', [LCustomLocationSensor.Distance]));
        Writeln(Format('Power Consumption : %s', [GetEnumName(TypeInfo(TPowerConsumption),integer(LCustomLocationSensor.PowerConsumption))]));
        Writeln(Format('Location Change   : %s', [GetEnumName(TypeInfo(TLocationChangeType),integer(LCustomLocationSensor.LocationChange))]));
        Writeln(Format('Latitude          : %n', [LCustomLocationSensor.Latitude]));
        Writeln(Format('Longitude         : %n', [LCustomLocationSensor.Longitude]));
        Writeln(Format('Longitude         : %n', [LCustomLocationSensor.Longitude]));
        Writeln(Format('Error Radius      : %n', [LCustomLocationSensor.ErrorRadius]));
        Writeln(Format('Altitude          : %n', [LCustomLocationSensor.Altitude]));
        Writeln(Format('Speed             : %n', [LCustomLocationSensor.Speed]));
        Writeln(Format('True Heading      : %n', [LCustomLocationSensor.TrueHeading]));
        Writeln(Format('Magnetic Heading  : %n', [LCustomLocationSensor.MagneticHeading]));
        Writeln(Format('Address1          : %s', [LCustomLocationSensor.Address1]));
        Writeln(Format('Address2          : %s', [LCustomLocationSensor.Address2]));
        Writeln(Format('City              : %s', [LCustomLocationSensor.City]));
        Writeln(Format('State/Province    : %s', [LCustomLocationSensor.StateProvince]));
        Writeln(Format('Postal Code       : %s', [LCustomLocationSensor.PostalCode]));
        Writeln(Format('Country Region    : %s', [LCustomLocationSensor.CountryRegion]));
        LCustomLocationSensor.Stop;
      end;

      TSensorCategory.Light :
      begin
        LCustomLightSensor:=LSensor as TCustomLightSensor;
        Writeln(Format('Lux          : %n', [LCustomLightSensor.Lux]));
        Writeln(Format('Temperature  : %n', [LCustomLightSensor.Temperature]));
        Writeln(Format('Chromacity   : %n', [LCustomLightSensor.Chromacity]));
        Writeln(Format('Sensor Type  : %s', [GetEnumName(TypeInfo(TLightSensorType),integer(LCustomLightSensor.SensorType))]));
      end;

      TSensorCategory.Environmental :
      begin
        LCustomEnvironmentalSensor:= LSensor as TCustomEnvironmentalSensor;
        Writeln(Format('Sensor Type    : %s', [GetEnumName(TypeInfo(TEnvironmentalSensorType),integer(LCustomEnvironmentalSensor.SensorType))]));
        Writeln(Format('Temperature    : %n', [LCustomEnvironmentalSensor.Temperature]));
        Writeln(Format('Pressure       : %n', [LCustomEnvironmentalSensor.Pressure]));
        Writeln(Format('Humidity       : %n', [LCustomEnvironmentalSensor.Humidity]));
        Writeln(Format('Wind Direction : %n', [LCustomEnvironmentalSensor.WindDirection]));
        Writeln(Format('Wind Speed     : %n', [LCustomEnvironmentalSensor.WindSpeed]));
      end;

      TSensorCategory.Motion :
      begin
        LCustomMotionSensor:= LSensor as TCustomMotionSensor;
        Writeln(Format('Sensor Type    : %s', [GetEnumName(TypeInfo(TMotionSensorType),integer(LCustomMotionSensor.SensorType))]));
        Writeln(Format('Acceleration X : %n', [LCustomMotionSensor.AccelerationX]));
        Writeln(Format('Acceleration Y : %n', [LCustomMotionSensor.AccelerationY]));
        Writeln(Format('Acceleration Z : %n', [LCustomMotionSensor.AccelerationZ]));
        Writeln(Format('Angle Accel. X : %n', [LCustomMotionSensor.AngleAccelX]));
        Writeln(Format('Angle Accel. Y : %n', [LCustomMotionSensor.AngleAccelY]));
        Writeln(Format('Angle Accel. Z : %n', [LCustomMotionSensor.AngleAccelZ]));
        Writeln(Format('Motion         : %n', [LCustomMotionSensor.Motion]));
        Writeln(Format('Speed          : %n', [LCustomMotionSensor.Speed]));
        Writeln(Format('Update Interval: %n', [LCustomMotionSensor.UpdateInterval]));
      end;

      TSensorCategory.Orientation :
      begin
        LCustomOrientationSensor:= LSensor as TCustomOrientationSensor;
        Writeln(Format('Sensor Type    : %s', [GetEnumName(TypeInfo(TOrientationSensorType),integer(LCustomOrientationSensor.SensorType))]));
        Writeln(Format('Tilt X         : %n', [LCustomOrientationSensor.TiltX]));
        Writeln(Format('Tilt Y         : %n', [LCustomOrientationSensor.TiltY]));
        Writeln(Format('Tilt Z         : %n', [LCustomOrientationSensor.TiltZ]));
        Writeln(Format('Distance X     : %n', [LCustomOrientationSensor.DistanceX]));
        Writeln(Format('Distance Y     : %n', [LCustomOrientationSensor.DistanceY]));
        Writeln(Format('Distance Z     : %n', [LCustomOrientationSensor.DistanceZ]));
        Writeln(Format('Heading X      : %n', [LCustomOrientationSensor.HeadingX]));
        Writeln(Format('Heading Y      : %n', [LCustomOrientationSensor.HeadingY]));
        Writeln(Format('Heading Z      : %n', [LCustomOrientationSensor.HeadingZ]));
        Writeln(Format('Mag. Heading   : %n', [LCustomOrientationSensor.MagHeading]));
        Writeln(Format('True Heading   : %n', [LCustomOrientationSensor.TrueHeading]));
        Writeln(Format('Comp.Heading   : %n', [LCustomOrientationSensor.CompMagHeading]));
        Writeln(Format('Comp True Head : %n', [LCustomOrientationSensor.CompTrueHeading]));
      end;

      TSensorCategory.Mechanical :
      begin
        LCustomMechanicalSensor:= LSensor as TCustomMechanicalSensor;
        Writeln(Format('Sensor Type    : %s', [GetEnumName(TypeInfo(TMechanicalSensorType),integer(LCustomMechanicalSensor.SensorType))]));
        Writeln(Format('Switch State   : %s', [BoolToStr(LCustomMechanicalSensor.SwitchState, True)]));
        Writeln(Format('Switch Array State : %d', [LCustomMechanicalSensor.SwitchArrayState]));
        Writeln(Format('Multi Value State  : %n', [LCustomMechanicalSensor.MultiValueState]));
        Writeln(Format('Force              : %n', [LCustomMechanicalSensor.Force]));
        Writeln(Format('Abs. Pressure      : %n', [LCustomMechanicalSensor.AbsPressure]));
        Writeln(Format('Gauge Pressure     : %n', [LCustomMechanicalSensor.GaugePressure]));
        Writeln(Format('Strain             : %n', [LCustomMechanicalSensor.Strain]));
        Writeln(Format('Weight             : %n', [LCustomMechanicalSensor.Weight]));
      end;

      TSensorCategory.Electrical :
      begin
        LCustomElectricalSensor:= LSensor as TCustomElectricalSensor;
        Writeln(Format('Sensor Type    : %s', [GetEnumName(TypeInfo(TElectricalSensorType),integer(LCustomElectricalSensor.SensorType))]));
        Writeln(Format('Capacitance    : %n', [LCustomElectricalSensor.Capacitance]));
        Writeln(Format('Resistance     : %n', [LCustomElectricalSensor.Resistance]));
        Writeln(Format('Inductance     : %n', [LCustomElectricalSensor.Inductance]));
        Writeln(Format('Current        : %n', [LCustomElectricalSensor.Current]));
        Writeln(Format('Voltage        : %n', [LCustomElectricalSensor.Voltage]));
        Writeln(Format('Power          : %n', [LCustomElectricalSensor.Power]));
      end;

      TSensorCategory.Biometric :
      begin
        LCustomBiometricSensor:= LSensor as TCustomBiometricSensor;
        Writeln(Format('Sensor Type    : %s', [GetEnumName(TypeInfo(TBiometricSensorType),integer(LCustomBiometricSensor.SensorType))]));
        Writeln(Format('Human Proximity: %n', [LCustomBiometricSensor.HumanProximity]));
        Writeln(Format('Human Presense : %s', [BoolToStr(LCustomBiometricSensor.HumanPresense, True)]));
        Writeln(Format('Touch          : %s', [BoolToStr(LCustomBiometricSensor.Touch, True)]));
      end;

      TSensorCategory.Scanner :
      begin
        LCustomScannerSensor:= LSensor as TCustomScannerSensor;
        Writeln(Format('Sensor Type    : %s', [GetEnumName(TypeInfo(TScannerSensorType),integer(LCustomScannerSensor.SensorType))]));
        Writeln(Format('Human Proximity: %d', [LCustomScannerSensor.RFIDTag]));
        Writeln(Format('Barcode Data   : %s', [LCustomScannerSensor.BarcodeData]));
      end;

    end;
    Writeln;
  end
  else
   Writeln('Not sensors was found');
  LManager.Deactivate;
end;

begin
  try
    EnumerateSensors;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

Virtual Sensors

If you don’t have sensors in your machine you can play with these virtual sensors.


3 Comments

Exploring Delphi XE3 – WinApi Additions – Winapi.Functiondiscovery Part 3

This is the part 3 of the Exploring Delphi XE3 – WinApi Additions – Winapi.Functiondiscovery Article.

The Function Discovery API can be used not just for enumerate devices also you can receive notifications as well, like when a device is added, removed or a property of the device is modified. In order to receive such notifications you must implement the IFunctionDiscoveryNotification interface and pass a instance of this implementation to the CreateInstanceCollectionQuery method, then you must restrict the result of the query with the method AddQueryConstraint passing the PROVIDERPNP_QUERYCONSTRAINT_NOTIFICATIONSONLY value to only receive notifications and finally call the IFunctionInstanceCollectionQuery.Execute method.

Implementing the IFunctionDiscoveryNotification interface

The IFunctionDiscoveryNotification interface exposes 3 methods to receive the results of the asynchronous queries returned by the execution of the IFunctionInstanceCollectionQuery.Execute method.

OnError Receives errors that occur during asynchronous query processing.
OnEvent Receives any add, remove, or update events.
OnUpdate Indicates that a function instance has been added, removed, or changed.

This is the Delphi declaration of the IFunctionDiscoveryNotification interface.

IFunctionDiscoveryNotification = interface(IUnknown)
[SID_IFunctionDiscoveryNotification]
  function OnUpdate(enumQueryUpdateAction: QueryUpdateAction; fdqcQueryContext: FDQUERYCONTEXT; pIFunctionInstance: IFunctionInstance): HRESULT; stdcall;
  function OnError(hr: HRESULT; fdqcQueryContext: FDQUERYCONTEXT; pszProvider: PWCHAR): HRESULT; stdcall;
  function OnEvent(dwEventID: DWORD; fdqcQueryContext: FDQUERYCONTEXT; pszProvider: PWCHAR): HRESULT; stdcall;
end;

Now check this Delphi implementation for the IFunctionDiscoveryNotification interface.

type
  TFunctionDiscoveryOnUpdate = procedure(enumQueryUpdateAction: QueryUpdateAction; fdqcQueryContext: FDQUERYCONTEXT;
      pIFunctionInstance: IFunctionInstance) of object;
  TFunctionDiscoveryOnError  = procedure(hr: HRESULT; fdqcQueryContext: FDQUERYCONTEXT; pszProvider: PWCHAR) of object;
  TFunctionDiscoveryOnEvent  = procedure(dwEventID: DWORD; fdqcQueryContext: FDQUERYCONTEXT; pszProvider: PWCHAR) of object;

  TFunctionDiscoveryNotificationSync=class(TInterfacedObject, IFunctionDiscoveryNotification)
  private
    FAction        : QueryUpdateAction;
    FEventAdd      : TEvent;
    FEventRemove   : TEvent;
    FEventChange   : TEvent;
    FOnUpdateEvent : TFunctionDiscoveryOnUpdate;
    FOnErrorEvent  : TFunctionDiscoveryOnError;
    FOnEventEvent  : TFunctionDiscoveryOnEvent;
    function OnUpdate(enumQueryUpdateAction: QueryUpdateAction; fdqcQueryContext: FDQUERYCONTEXT;
      pIFunctionInstance: IFunctionInstance): HRESULT; stdcall;
    function OnError(hr: HRESULT; fdqcQueryContext: FDQUERYCONTEXT; pszProvider: PWCHAR): HRESULT; stdcall;
    function OnEvent(dwEventID: DWORD; fdqcQueryContext: FDQUERYCONTEXT; pszProvider: PWCHAR): HRESULT; stdcall;
  public
    constructor Create;
    destructor Destroy; override;
    function WaitFor(dwTimeout : DWORD; pszCategory: PWCHAR; eAction : QueryUpdateAction) : HRESULT;
    property OnUpdateEvent: TFunctionDiscoveryOnUpdate read FOnUpdateEvent write FOnUpdateEvent;
    property OnErrorEvent : TFunctionDiscoveryOnError read FOnErrorEvent write FOnErrorEvent;
    property OnEventEvent : TFunctionDiscoveryOnEvent read FOnEventEvent write FOnEventEvent;
  end;


{TFunctionDiscoveryNotificationSync}

constructor TFunctionDiscoveryNotificationSync.Create;
begin
  inherited;
  FOnUpdateEvent:=nil;
  //create the  events objects
  FEventAdd    := TEvent.Create(nil, False, False, '', true);
  FEventRemove := TEvent.Create(nil, False, False, '', true);
  FEventChange := TEvent.Create(nil, False, False, '', true);
end;

destructor TFunctionDiscoveryNotificationSync.Destroy;
begin
  //release the event objects
  FEventAdd.Free;
  FEventRemove.Free;
  FEventChange.Free;
  inherited;
end;

function TFunctionDiscoveryNotificationSync.OnError(hr: HRESULT;
  fdqcQueryContext: FDQUERYCONTEXT; pszProvider: PWCHAR): HRESULT;
begin
   //send the error notification if a callback method  was defined
   if @FOnErrorEvent<>nil then
    FOnErrorEvent(hr, fdqcQueryContext, pszProvider);
   Exit(S_OK);
end;

function TFunctionDiscoveryNotificationSync.OnEvent(dwEventID: DWORD;
  fdqcQueryContext: FDQUERYCONTEXT; pszProvider: PWCHAR): HRESULT;
begin
   //send the OnEvent notification if a callback method  was defined
   if @FOnEventEvent<>nil then
    FOnEventEvent(dwEventID, fdqcQueryContext, pszProvider);
   Exit(S_OK);
end;

function TFunctionDiscoveryNotificationSync.OnUpdate(
  enumQueryUpdateAction: QueryUpdateAction; fdqcQueryContext: FDQUERYCONTEXT;
  pIFunctionInstance: IFunctionInstance): HRESULT;
begin

    //signal the event object
    case enumQueryUpdateAction of
      QUA_ADD    : FEventAdd.SetEvent;
      QUA_REMOVE : FEventRemove.SetEvent;
      QUA_CHANGE : FEventChange.SetEvent;
    end;

   //send the OnEvent notification if a callback method  was defined
   if (@FOnUpdateEvent<>nil) and (FAction=enumQueryUpdateAction) then
    FOnUpdateEvent(enumQueryUpdateAction, fdqcQueryContext, pIFunctionInstance);
   Exit(S_OK);
end;

function TFunctionDiscoveryNotificationSync.WaitFor(dwTimeout : DWORD; pszCategory: PWCHAR; eAction : QueryUpdateAction) : HRESULT;
var
 hr : HRESULT;
 LEvent : TEvent;
 LWaitResult : TWaitResult;
 FFunctionDiscovery : IFunctionDiscovery;
 ppIFunctionInstanceCollection: IFunctionInstanceCollection;
 ppIFunctionInstanceCollectionQuery: IFunctionInstanceCollectionQuery;
begin
 FAction:=eAction;
 //reset the event objects
 FEventAdd.ResetEvent;
 FEventRemove.ResetEvent;
 FEventChange.ResetEvent;

 //create a instance to the IFunctionDiscovery
 FFunctionDiscovery := CreateComObject(CLSID_FunctionDiscovery) as IFunctionDiscovery;
 //create a new query passing the current class as callback
 hr := FFunctionDiscovery.CreateInstanceCollectionQuery(FCTN_CATEGORY_PNP, nil, true, Self, nil, ppIFunctionInstanceCollectionQuery);

 //instruct to the query to only receive notifications
 if hr=S_OK then
   hr := ppIFunctionInstanceCollectionQuery.AddQueryConstraint(PROVIDERPNP_QUERYCONSTRAINT_NOTIFICATIONSONLY,'TRUE');

 //execute the query
 if hr=S_OK then
   hr := ppIFunctionInstanceCollectionQuery.Execute(ppIFunctionInstanceCollection);

 if( hr=E_PENDING) then hr := S_OK;

    case eAction of
      QUA_ADD    : LEvent:=FEventAdd;
      QUA_REMOVE : LEvent:=FEventRemove;
      QUA_CHANGE : LEvent:=FEventChange;
      else
      LEvent := nil;
    end;

  if (hr=S_OK) and (LEvent<>nil) then
   LWaitResult:= LEvent.WaitFor(dwTimeout);

 // One device may correspond to multiple function instances
 // This sleep allows the OnUpdate call to output information
 // about each Function Instance.
 // THIS SLEEP IS MERELY FOR DISPLAY PURPOSES
 Sleep(1000);
 Exit(hr);
end;

Demo Application

Now using the above implementation we can receive notification about the devices, you can test the next sample app inserting a USB device and then removing.


type  
 TNotifier=class
    procedure  OnUpdate(enumQueryUpdateAction: QueryUpdateAction; fdqcQueryContext: FDQUERYCONTEXT;
      pIFunctionInstance: IFunctionInstance);
  end;

procedure NotificationDemo;
Const
  Timeout = 20000;
var
  hr : HResult;
  pIFunctionDiscoveryNotification : TFunctionDiscoveryNotificationSync;
  LNotifier : TNotifier;
begin
 LNotifier:=TNotifier.Create;
 try
   pIFunctionDiscoveryNotification:=TFunctionDiscoveryNotificationSync.Create;
   try
       //set the callback
       pIFunctionDiscoveryNotification.OnUpdateEvent:=LNotifier.OnUpdate;
       Writeln(Format('Waiting for %d ms, to plug in a PnP device',[Timeout]));
       pIFunctionDiscoveryNotification.WaitFor(Timeout, FCTN_CATEGORY_PNP, QUA_ADD);
       Writeln('Done');
   finally
     pIFunctionDiscoveryNotification:=nil;
   end;

   pIFunctionDiscoveryNotification:=TFunctionDiscoveryNotificationSync.Create;
   try
       //set the callback
       pIFunctionDiscoveryNotification.OnUpdateEvent:=LNotifier.OnUpdate;
       Writeln(Format('Waiting for %d ms, to remove a PnP device',[Timeout]));
       pIFunctionDiscoveryNotification.WaitFor(Timeout, FCTN_CATEGORY_PNP, QUA_REMOVE);
       Writeln('Done');
   finally
     pIFunctionDiscoveryNotification:=nil;
   end;
 finally
     LNotifier.Free;
 end;
end;

{ TNotifier }
procedure TNotifier.OnUpdate(enumQueryUpdateAction: QueryUpdateAction;
  fdqcQueryContext: FDQUERYCONTEXT; pIFunctionInstance: IFunctionInstance);
var
  ppIPropertyStore  : IPropertyStore;
  pv : TPropVariant;
begin
  case enumQueryUpdateAction of
    QUA_ADD    : Writeln(Format('Action : %s',['Add']));
    QUA_REMOVE : Writeln(Format('Action : %s',['Remove']));
    QUA_CHANGE : Writeln(Format('Action : %s',['Change']));
  end;
  if Succeeded(pIFunctionInstance.OpenPropertyStore(STGM_READ, ppIPropertyStore)) then
    if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_DeviceDesc, pv)) then
      Writeln(Format('Device Desc. %s',[pv.pwszVal]));
    if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Class, pv)) then
      Writeln(Format('Class        %s',[pv.pwszVal]));
    if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Manufacturer, pv)) then
      Writeln(Format('Manufacturer %s',[pv.pwszVal]));
end;

begin
 try
   ReportMemoryLeaksOnShutdown:=True;
   if (Win32MajorVersion >= 6) then  // available on Vista (or later)
   begin
    if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
    try
     NotificationDemo;
    finally
      CoUninitialize;
    end;
   end
   else
   Writeln('Windows version not compatible');
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.


1 Comment

Exploring Delphi XE3 – WinApi Additions – Winapi.Functiondiscovery Part 2

This is the part 2 of the Exploring Delphi XE3 – WinApi Additions – Winapi.Functiondiscovery Article

One of the nice features of the Function Discovery API is the posibility of filter the results for device enumeration, for this you must use the CreateInstanceCollectionQuery method and then add the conditions for the query using the AddPropertyConstraint method.

Try this sample Delphi code which enumerates all the processors devices where the manufacturer is Intel.

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Win.ComObj,
  Winapi.Windows,
  Winapi.Activex,
  Winapi.PropSys,
  Winapi.Functiondiscovery,
  System.SysUtils;

procedure Enumerate;
var
    LFunctionDiscovery : IFunctionDiscovery;
    LFunctionInstance  : IFunctionInstance;
    ppIFunctionInstanceCollection: IFunctionInstanceCollection;
    ppIFunctionInstanceCollectionQuery: IFunctionInstanceCollectionQuery;
    ppIPropertyStore  : IPropertyStore;
    pv : TPropVariant;
    pdwCount : DWORD;
    pszCategory: PWCHAR;
    hr : HResult;
    i : integer;
begin
  //create an instance to the  IFunctionDiscovery interface
  LFunctionDiscovery := CreateComObject(CLSID_FunctionDiscovery) as IFunctionDiscovery;
  try
    //set the provider to search
    pszCategory:=FCTN_CATEGORY_PNP;
    //get the devices collection
    hr := LFunctionDiscovery.CreateInstanceCollectionQuery(pszCategory, nil, false, nil, nil, ppIFunctionInstanceCollectionQuery);
      if Succeeded(hr)  then
      begin
       PropVariantClear(pv);
       pv.vt:=VT_LPWSTR;
       pv.pwszVal:='Intel';
       hr := ppIFunctionInstanceCollectionQuery.AddPropertyConstraint(PKEY_Device_Manufacturer, pv, QC_EQUALS);
       if not Succeeded(hr) then RaiseLastOSError;

       PropVariantClear(pv);
       pv.vt:=VT_LPWSTR;
       pv.pwszVal:='Processor';
       hr := ppIFunctionInstanceCollectionQuery.AddPropertyConstraint(PKEY_Device_Class, pv, QC_EQUALS);
       if not Succeeded(hr) then RaiseLastOSError;

        hr := ppIFunctionInstanceCollectionQuery.Execute(ppIFunctionInstanceCollection);
        if Succeeded(hr)  then
        begin
          //get the collection count
          ppIFunctionInstanceCollection.GetCount(pdwCount);
          if pdwCount=0 then
            Writeln(Format('No items was found for the %s category',[pszCategory]))
          else
          for i := 0 to pdwCount - 1 do begin
            //get the n Item of the collection
            if Succeeded(ppIFunctionInstanceCollection.Item(i, LFunctionInstance)) then
            begin
              //init the propertiess store
              LFunctionInstance.OpenPropertyStore(STGM_READ, ppIPropertyStore);
              //read the properties values
              if Succeeded(ppIPropertyStore.GetValue(PKEY_NAME, pv)) then
               Writeln(Format('Name          %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_InstanceId, pv)) then
               Writeln(Format('Instance Id   %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Driver, pv)) then
               Writeln(Format('Device Driver %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Model, pv)) then
               Writeln(Format('Model         %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Manufacturer, pv)) then
               Writeln(Format('Manufacturer  %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_LocationInfo, pv)) then
               Writeln(Format('Location      %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Class, pv)) then
               Writeln(Format('Class        %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_ClassGuid, pv)) then
               Writeln(Format('Class Guid   %s',[pv.puuid^.ToString]));
              Writeln;
            end
            else
             RaiseLastOSError;
           end;
        end;
      end
      else
       RaiseLastOSError;
  finally
    LFunctionDiscovery:=nil;
  end;
end;

begin
 try
   ReportMemoryLeaksOnShutdown:=True;
   if (Win32MajorVersion >= 6) then  // available on Vista (or later)
   begin
    if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
    try
     Enumerate;
    finally
      CoUninitialize;
    end;
   end
   else
   Writeln('Windows version not compatible');
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.


4 Comments

Exploring Delphi XE3 – WinApi Additions – Winapi.Functiondiscovery Part 1

Starting with Windows Vista The SetupDi and the WMI are not longer the only APIs to enumerate devices and receive notifications about hardware changes, with the introduction of the Function Discovery API you can access the installed devices using a unified API and interfaces for gathering functionality, properties, and notifications from various device types like PnP, PnP-X, Registry, NetBIOS and custom (third-party) providers.

Delphi XE3 include the translation of the headers for the Function Discovery API in the Winapi.Functiondiscovery unit. In this post I will show the basic code to enumerate the hardware devices.

To get a collection of the devices (function instances), you must use use the IFunctionDiscovery.GetInstanceCollection method. from here to get each function instance in the collection in order, use the IFunctionInstanceCollection.Item method and finally use the IFunctionInstance.OpenPropertyStore and IPropertyStore.GetValue methods to retrieve the value of each property.

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Win.ComObj,
  Winapi.Windows,
  Winapi.Activex,
  Winapi.PropSys,
  Winapi.Functiondiscovery,
  System.SysUtils;

procedure Enumerate;
var
    LFunctionDiscovery : IFunctionDiscovery;
    hr : HResult;
    i : integer;
    LFunctionInstance : IFunctionInstance;
    ppIFunctionInstanceCollection : IFunctionInstanceCollection;
    ppIPropertyStore  : IPropertyStore;
    pv : TPropVariant;
    pdwCount : DWORD;
    pszCategory: PWCHAR;
begin
  //create an instance to the  IFunctionDiscovery interface
  LFunctionDiscovery := CreateComObject(CLSID_FunctionDiscovery) as IFunctionDiscovery;
  try
    //set the provider to search
    pszCategory:=FCTN_CATEGORY_PNP;
    //get the devices collection
    hr := LFunctionDiscovery.GetInstanceCollection(pszCategory, nil, true, ppIFunctionInstanceCollection);
      //get the collection count
      if Succeeded(hr) and Succeeded(ppIFunctionInstanceCollection.GetCount(pdwCount)) then
      begin
        if pdwCount=0 then
          Writeln(Format('No items was found for the %s category',[pszCategory]))
        else
        for i := 0 to pdwCount - 1 do begin
          //get the n Item of the collection
          if Succeeded(ppIFunctionInstanceCollection.Item(i, LFunctionInstance)) then
          begin
            //init the propertiess store
            LFunctionInstance.OpenPropertyStore(STGM_READ, ppIPropertyStore);
            //read the properties values
            if Succeeded(ppIPropertyStore.GetValue(PKEY_NAME, pv)) then
             Writeln(Format('Name          %s',[pv.pwszVal]));
            if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_InstanceId, pv)) then
             Writeln(Format('Instance Id   %s',[pv.pwszVal]));
            if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Driver, pv)) then
             Writeln(Format('Device Driver %s',[pv.pwszVal]));
            if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Model, pv)) then
             Writeln(Format('Model         %s',[pv.pwszVal]));
            if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Manufacturer, pv)) then
             Writeln(Format('Manufacturer  %s',[pv.pwszVal]));
            if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_LocationInfo, pv)) then
             Writeln(Format('Location      %s',[pv.pwszVal]));
            Writeln;
          end
          else
           RaiseLastOSError;
        end;
      end
      else
       RaiseLastOSError;
  finally
    LFunctionDiscovery:=nil;
  end;
end;

begin
 try
   if (Win32MajorVersion >= 6) then  // available on Vista (or later)
   begin
    if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
    try
     Enumerate;
    finally
      CoUninitialize;
    end;
   end
   else
   Writeln('Windows version not compatible');
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

As you can see the code is very straightforward, Now the next sample show how retrieves all the properties of each device.

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Win.ComObj,
  Winapi.Windows,
  Winapi.Activex,
  Winapi.PropSys,
  Winapi.Functiondiscovery,
  System.Generics.Collections,
  System.SysUtils;

procedure Enumerate2;
var
    LFunctionDiscovery : IFunctionDiscovery;
    hr : HResult;
    i,j : integer;
    LFunctionInstance : IFunctionInstance;
    ppIFunctionInstanceCollection : IFunctionInstanceCollection;
    ppIPropertyStore  : IPropertyStore;
    pv : TPropVariant;
    pdwCount : DWORD;
    cProps: DWORD;
    pszCategory: PWCHAR;
    pkey: TPropertyKey;
    ListKeys : TDictionary<TPropertyKey, string>;
    KeyName : string;
begin
  //create a list with TPropertyKey descriptions
  ListKeys:=TDictionary<TPropertyKey, string>.Create;
  try
    ListKeys.Add(PKEY_NAME, 'Name');
{ Device properties }
{ These PKEYs correspond to the old setupapi SPDRP_XXX properties }
    ListKeys.Add(PKEY_Device_DeviceDesc, 'Device Desc');
    ListKeys.Add(PKEY_Device_HardwareIds, 'Hardware Id');
    ListKeys.Add(PKEY_Device_CompatibleIds, 'Compatible Id');
    ListKeys.Add(PKEY_Device_Service, 'Device Service');
    ListKeys.Add(PKEY_Device_Class, 'Class');
    ListKeys.Add(PKEY_Device_ClassGuid, 'Class GUID');
    ListKeys.Add(PKEY_Device_ConfigFlags, 'ConfigFlags');
    ListKeys.Add(PKEY_Device_Manufacturer, 'Manufacturer');
    ListKeys.Add(PKEY_Device_FriendlyName, 'Friendly Name');
    ListKeys.Add(PKEY_Device_LocationInfo, 'Location Info');
    ListKeys.Add(PKEY_Device_PDOName, 'PDO Name');
    ListKeys.Add(PKEY_Device_Capabilities, 'Capabilities');
    ListKeys.Add(PKEY_Device_UINumber, 'UI Number');
    ListKeys.Add(PKEY_Device_UpperFilters, 'Upper Filters');
    ListKeys.Add(PKEY_Device_LowerFilters, 'Lower Filters');
    ListKeys.Add(PKEY_Device_BusTypeGuid, 'Bus Type Guid');
    ListKeys.Add(PKEY_Device_LegacyBusType, 'Legacy Bus Type');
    ListKeys.Add(PKEY_Device_BusNumber, 'Bus Number');
    ListKeys.Add(PKEY_Device_EnumeratorName, 'Enumerator Name');
    ListKeys.Add(PKEY_Device_Security, 'Security');
    ListKeys.Add(PKEY_Device_SecuritySDS, 'Security SDS');
    ListKeys.Add(PKEY_Device_DevType, 'Dev Type');
    ListKeys.Add(PKEY_Device_Exclusive, 'Exclusive');
    ListKeys.Add(PKEY_Device_Characteristics, 'Characteristics');
    ListKeys.Add(PKEY_Device_Address, 'Address');
    ListKeys.Add(PKEY_Device_UINumberDescFormat, 'UI Number Desc. Format');
    ListKeys.Add(PKEY_Device_PowerData, 'Power Data');
    ListKeys.Add(PKEY_Device_RemovalPolicy, 'Removal Policy');
    ListKeys.Add(PKEY_Device_RemovalPolicyDefault, 'Removal Policy Default');
    ListKeys.Add(PKEY_Device_RemovalPolicyOverride, 'Removal Policy Override');
    ListKeys.Add(PKEY_Device_InstallState, 'Install State');
    ListKeys.Add(PKEY_Device_LocationPaths, 'Location Paths');
    ListKeys.Add(PKEY_Device_BaseContainerId, 'BaseContainer Id');
{ Device properties }
{ These PKEYs correspond to a device's status and problem code }

    ListKeys.Add(PKEY_Device_DevNodeStatus, 'Dev Node Status');
    ListKeys.Add(PKEY_Device_ProblemCode, 'Problem Code');
{ Device properties }
{ These PKEYs correspond to device relations }

    ListKeys.Add(PKEY_Device_EjectionRelations, 'Ejection Relations');
    ListKeys.Add(PKEY_Device_RemovalRelations, 'Removal Relations');
    ListKeys.Add(PKEY_Device_PowerRelations, 'Power Relations');
    ListKeys.Add(PKEY_Device_BusRelations, 'Bus Relations');
    ListKeys.Add(PKEY_Device_Parent, 'Parent');
    ListKeys.Add(PKEY_Device_Children, 'Children');
    ListKeys.Add(PKEY_Device_Siblings, 'Sibling');
    ListKeys.Add(PKEY_Device_TransportRelations, 'Transport Relations');
{ Other Device properties }
    ListKeys.Add(PKEY_Device_Reported, 'Reported');
    ListKeys.Add(PKEY_Device_Legacy, 'Legacy');
    ListKeys.Add(PKEY_Device_InstanceId, 'Instance Id');
    ListKeys.Add(PKEY_Device_ContainerId, 'Container Id');
    ListKeys.Add(PKEY_Device_ModelId, 'Model Id');
    ListKeys.Add(PKEY_Device_FriendlyNameAttributes, 'Friendly Name Attributes');
    ListKeys.Add(PKEY_Device_ManufacturerAttributes, 'Manufacturer Attributes');
    ListKeys.Add(PKEY_Device_PresenceNotForDevice, 'Presence Not For Device');
    ListKeys.Add(PKEY_Numa_Proximity_Domain, 'Numa Proximity Domain');
    ListKeys.Add(PKEY_Device_DHP_Rebalance_Policy, 'DHP Rebalance Policy');
    ListKeys.Add(PKEY_Device_Numa_Node, 'Numa Node');
    ListKeys.Add(PKEY_Device_BusReportedDeviceDesc, 'Bus Reported Device Desc');
    ListKeys.Add(PKEY_Device_InstallInProgress, 'Install In Progress');
{ Device driver properties }
    ListKeys.Add(PKEY_Device_DriverDate, 'Driver Date');
    ListKeys.Add(PKEY_Device_DriverVersion, 'Driver Version');
    ListKeys.Add(PKEY_Device_DriverDesc, 'Driver Desc');
    ListKeys.Add(PKEY_Device_DriverInfPath, 'Driver Inf Path');
    ListKeys.Add(PKEY_Device_DriverInfSection, 'Driver Inf Section');
    ListKeys.Add(PKEY_Device_DriverInfSectionExt, 'Driver Inf Section Ext');
    ListKeys.Add(PKEY_Device_MatchingDeviceId, 'Matching DeviceId');
    ListKeys.Add(PKEY_Device_DriverProvider, 'Driver Provider');
    ListKeys.Add(PKEY_Device_DriverPropPageProvider, 'Driver Prop Page Provider');
    ListKeys.Add(PKEY_Device_DriverCoInstallers, 'Driver CoInstallers');
    ListKeys.Add(PKEY_Device_ResourcePickerTags, 'Resource Picker Tags');
    ListKeys.Add(PKEY_Device_ResourcePickerExceptions, 'Resource Picker Exceptions');
    ListKeys.Add(PKEY_Device_DriverRank, 'Driver Rank');
    ListKeys.Add(PKEY_Device_DriverLogoLevel, 'Driver Logo Level');
    ListKeys.Add(PKEY_Device_NoConnectSound, 'No Connect Sound');
    ListKeys.Add(PKEY_Device_GenericDriverInstalled, 'Generic Driver Installed');
    ListKeys.Add(PKEY_Device_AdditionalSoftwareRequested, 'Additional Software Requested');
{Add more TPropertyKey here}

      //create a instance for the IFunctionDiscovery interface
      LFunctionDiscovery := CreateComObject(CLSID_FunctionDiscovery) as IFunctionDiscovery;
      try
        //set the provider
        pszCategory:=FCTN_CATEGORY_PNP;
        //get all the instances for the current provider
        hr := LFunctionDiscovery.GetInstanceCollection(pszCategory, nil, true, ppIFunctionInstanceCollection);
        if Succeeded(hr) then
          if Succeeded(ppIFunctionInstanceCollection.GetCount(pdwCount)) then
          begin
            if pdwCount=0 then
              Writeln(Format('No items was found for the %s category',[pszCategory]))
            else
            for i := 0 to pdwCount - 1 do begin
              if Succeeded(ppIFunctionInstanceCollection.Item(i, LFunctionInstance)) then
              begin
                //open the properties
                if Succeeded(LFunctionInstance.OpenPropertyStore(STGM_READ, ppIPropertyStore)) then
                begin
                   //get the num of properties for the current instance
                   ppIPropertyStore.GetCount(cProps);
                   for j := 0 to cProps - 1 do
                   begin
                      //get the TPropertyKey for the current index
                     if Succeeded(ppIPropertyStore.GetAt(j, pkey)) then
                      // get the value for the curent  TPropertyKey
                      if Succeeded(ppIPropertyStore.GetValue(pkey, pv)) then
                      begin
                       //resolves the key description or use the TGUID if is not found
                       KeyName:=pkey.fmtid.ToString;
                       if ListKeys.ContainsKey(pkey) then
                         KeyName:=ListKeys.Items[pkey];

                       //depending of the type of the property display the info
                       case pv.vt of
                         VT_BOOL    : Writeln(Format('%-40s %s',[KeyName , BoolToStr(pv.boolVal, True)]));
                         VT_UINT    : Writeln(Format('%-40s %d',[KeyName ,pv.ulVal]));
                         VT_INT     : Writeln(Format('%-40s %d',[KeyName ,pv.iVal]));
                         VT_I4,
                         VT_UI4     : Writeln(Format('%-40s %d',[KeyName ,pv.ulVal]));
                         VT_EMPTY   : Writeln(Format('%-40s %s',[KeyName ,'(Empty)']));
                         VT_LPWSTR  : Writeln(Format('%-40s %s',[KeyName ,pv.pwszVal]));
                         VT_CLSID   : Writeln(Format('%-40s %s',[KeyName ,pv.puuid^.ToString]));
                       else
                                    Writeln(Format('%-40s %s',[KeyName ,'(Type Unknow)']));
                       end;

                       PropVariantClear(pv);
                      end;
                   end;
                   Writeln;
                end;
              end
              else
               RaiseLastOSError;
            end;
          end
          else
           RaiseLastOSError
        else
         RaiseLastOSError;
      finally
        LFunctionDiscovery:=nil;
      end;
  finally
     ListKeys.Free;
  end;
end;


begin
 try
   if (Win32MajorVersion >= 6) then  // available on Vista (or later)
   begin
    if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
    try
     Enumerate2;
    finally
      CoUninitialize;
    end;
   end
   else
   Writeln('Windows version not compatible');
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

This is just a basic sample of the use of the Function Discovery API, in the next post I will show another features of this API.