The Road to Delphi

Delphi – Free Pascal – Oxygene


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.


9 Comments

Exploring Delphi XE3 – WinApi Additions – Winapi.Wbem

Delphi XE3 introduces a lot of new WinApi headers translations, between them is the Winapi.Wbem unit which is the Delphi (object pascal) translation for the wbemidl.h file which contains the WMI Component Object Model (COM) interface definitions. This means that from now you can access the WMI in a fastest way and directly using COM avoiding the use of the Microsoft WMIScripting Library and third party libraries.

Try this sample Delphi XE3 console application which access the Win32_Process WMI Class using the Winapi.Wbem unit.

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils,
  Winapi.ActiveX,
  Winapi.Wbem;

const
  //Impersonation Level Constants
  //http://msdn.microsoft.com/en-us/library/ms693790%28v=vs.85%29.aspx
  RPC_C_AUTHN_LEVEL_DEFAULT   = 0;
  RPC_C_IMP_LEVEL_ANONYMOUS   = 1;
  RPC_C_IMP_LEVEL_IDENTIFY    = 2;
  RPC_C_IMP_LEVEL_IMPERSONATE = 3;
  RPC_C_IMP_LEVEL_DELEGATE    = 4;

  //Authentication Service Constants
  //http://msdn.microsoft.com/en-us/library/ms692656%28v=vs.85%29.aspx
  RPC_C_AUTHN_WINNT      = 10;
  RPC_C_AUTHN_LEVEL_CALL = 3;
  RPC_C_AUTHN_DEFAULT    = Longint($FFFFFFFF);
  EOAC_NONE              = 0;

  //Authorization Constants
  //http://msdn.microsoft.com/en-us/library/ms690276%28v=vs.85%29.aspx
  RPC_C_AUTHZ_NONE       = 0;
  RPC_C_AUTHZ_NAME       = 1;
  RPC_C_AUTHZ_DCE        = 2;
  RPC_C_AUTHZ_DEFAULT    = Longint($FFFFFFFF);

  //Authentication-Level Constants
  //http://msdn.microsoft.com/en-us/library/aa373553%28v=vs.85%29.aspx
  RPC_C_AUTHN_LEVEL_PKT_PRIVACY   = 6;
  SEC_WINNT_AUTH_IDENTITY_UNICODE = 2;

 //COAUTHIDENTITY Structure
 //http://msdn.microsoft.com/en-us/library/ms693358%28v=vs.85%29.aspx
 type
    PCOAUTHIDENTITY    = ^TCOAUTHIDENTITY;
    _COAUTHIDENTITY    = Record
                          User           : PChar;
                          UserLength     : ULONG;
                          Domain         : PChar;
                          DomainLength   : ULONG;
                          Password       : PChar;
                          PassWordLength : ULONG;
                          Flags          : ULONG;
                          End;

   COAUTHIDENTITY      = _COAUTHIDENTITY;
   TCOAUTHIDENTITY     = _COAUTHIDENTITY;



function GetExtendedErrorInfo(hresErr: HRESULT):Boolean;
var
 pStatus    : IWbemStatusCodeText;
 hres       : HRESULT;
 MessageText: WideString;
begin
  Result:=False;
    hres := CoCreateInstance(CLSID_WbemStatusCodeText, nil, CLSCTX_INPROC_SERVER, IID_IWbemStatusCodeText, pStatus);
    if (hres = S_OK) then
    begin
     hres := pStatus.GetErrorCodeText(hresErr, 0, 0, MessageText);
     if(hres <> S_OK) then
       MessageText := 'Get last error failed';

     Result:=(hres = S_OK);
     if Result then
      Writeln(Format( 'ErrorCode %x Description %s',[hresErr,MessageText]));
    end;
end;


procedure  TestWbem;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  WbemLocale          ='';
  WbemAuthority       ='kERBEROS:'+WbemComputer;
var
  LWbemLocator         : IWbemLocator;
  LWbemServices        : IWbemServices;
  LUnsecuredApartment  : IUnsecuredApartment;
  ppEnum               : IEnumWbemClassObject;
  apObjects            : IWbemClassObject;
  puReturned           : ULONG;
  pVal                 : Variant;
  pType                : PCIMTYPE;
  plFlavor             : PInteger;
  OpResult             : HRESULT;
  LocalConnection      : Boolean;
  AuthInfo             : TCOAUTHIDENTITY;
begin
  ZeroMemory(@AuthInfo, 0);
  with AuthInfo do
  begin
    User           := PChar(WbemUser);
    UserLength     := Length(WbemUser);
    Domain         := '';
    DomainLength   := 0;
    Password       := PChar(WbemPassword);
    PasswordLength := Length(WbemPassword);
    Flags          := SEC_WINNT_AUTH_IDENTITY_UNICODE;
  end;

  LocalConnection:=WbemComputer.IsEmpty or (WbemComputer.CompareTo('localhost')=0);
  if LocalConnection then
   if Failed(CoInitializeSecurity(nil, -1, nil, nil, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE, nil)) then Exit
   else
  else
   if Failed(CoInitializeSecurity(nil, -1, nil, nil, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IDENTIFY, nil, EOAC_NONE, nil)) then Exit;


  OpResult:=CoCreateInstance(CLSID_WbemLocator, nil, CLSCTX_INPROC_SERVER, IID_IWbemLocator, LWbemLocator);
  if Succeeded(OpResult) then
  begin
    try
      Writeln('Connecting to the WMI Service');
      if LocalConnection then
        OpResult:=LWbemLocator.ConnectServer(Format('\\%s\root\CIMV2',[WbemComputer]), WbemUser, WbemPassword, WbemLocale,  WBEM_FLAG_CONNECT_USE_MAX_WAIT, '', nil, LWbemServices)
      else
        OpResult:=LWbemLocator.ConnectServer(Format('\\%s\root\CIMV2',[WbemComputer]), WbemUser, WbemPassword, WbemLocale,  WBEM_FLAG_CONNECT_USE_MAX_WAIT, '', nil, LWbemServices);


      if Succeeded(OpResult) then
      begin
        Writeln('Connected');
        try
          // Set security levels on a WMI connection
          if LocalConnection then
            if Failed(CoSetProxyBlanket(LWbemServices, RPC_C_AUTHN_WINNT, RPC_C_AUTHZ_NONE, nil, RPC_C_AUTHN_LEVEL_CALL, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE)) then Exit
             else
          else
            if Failed(CoSetProxyBlanket(LWbemServices, RPC_C_AUTHN_DEFAULT, RPC_C_AUTHZ_DEFAULT, PWideChar(Format('\\%s',[WbemComputer])), RPC_C_AUTHN_LEVEL_PKT_PRIVACY, RPC_C_IMP_LEVEL_IMPERSONATE, @AuthInfo, EOAC_NONE)) then Exit;

          if Succeeded(CoCreateInstance(CLSID_UnsecuredApartment, nil, CLSCTX_LOCAL_SERVER, IID_IUnsecuredApartment, LUnsecuredApartment)) then
          try
            Writeln('Running Wmi Query');
            OpResult := LWbemServices.ExecQuery('WQL', 'SELECT Name, ProcessId FROM Win32_Process', WBEM_FLAG_FORWARD_ONLY, nil, ppEnum);
            if Succeeded(OpResult) then
            begin
               // Set security for the enumerator proxy
               if not LocalConnection then
                if Failed(CoSetProxyBlanket(ppEnum, RPC_C_AUTHN_DEFAULT, RPC_C_AUTHZ_DEFAULT, PWideChar(Format('\\%s',[WbemComputer])), RPC_C_AUTHN_LEVEL_PKT_PRIVACY, RPC_C_IMP_LEVEL_IMPERSONATE, @AuthInfo, EOAC_NONE)) then Exit;

               while (ppEnum.Next(Integer(WBEM_INFINITE), 1, apObjects, puReturned)=0) do
               begin
                 pType:=nil;
                 plFlavor:=nil;

                 apObjects.Get('Name', 0, pVal, pType, plFlavor);// String
                 Writeln(Format('Name         %s',[String(pVal)]));//String
                 VarClear(pVal);

                 apObjects.Get('ProcessId', 0, pVal, pType, plFlavor);// Uint32
                 Writeln(Format('ProcessId    %d',[Integer(pVal)]));//Uint32
                 VarClear(pVal);
               end;
            end
            else
            if not GetExtendedErrorInfo(OpResult) then
            Writeln(Format('Error executing WQL sentence %x',[OpResult]));
          finally
            LUnsecuredApartment := nil;
          end;
        finally
          LWbemServices := nil;
        end;
      end
      else
        if not GetExtendedErrorInfo(OpResult) then
        Writeln(Format('Error Connecting to the Server %x',[OpResult]));
    finally
      LWbemLocator := nil;
    end;
  end
  else
   if not GetExtendedErrorInfo(OpResult) then
     Writeln(Format('Failed to create IWbemLocator object %x',[OpResult]));

end;


begin
 try
    if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
    try
      TestWbem;
    finally
      CoUninitialize;
    end;
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.


19 Comments

Exploring Delphi XE3 – Record Helpers for simple types – System.SysUtils.TStringHelper

Delphi X3 introduces a very cool language extension, which is Record Helpers for simple types. So you can add a set of fields, properties or methods to strings, integers, Double, TDateTime and so on.

In this post I will show you the TStringHelper record helper for the string type defined in the System.SysUtils unit. Take a look to the definition of this record helper.

  TStringHelper = record helper for string
  private
    function GetChars(Index: Integer): Char; inline;
    function GetLength: Integer; inline;
    class function CharInArray(const C: Char; const InArray: array of Char): Boolean; static;
    function IndexOfAny(const Values: array of string; var Index: Integer): Integer; overload;
  public
    const Empty = '';
    // Methods
    class function Create(C: Char; Count: Integer): string; overload; inline; static;
    class function Create(const Value: array of Char; StartIndex: Integer; Length: Integer): string; overload; static;
    class function Create(const Value: array of Char): string; overload; static;
    class function Compare(const StrA: string; const StrB: string): Integer; overload; static;
    class function Compare(const StrA: string; const StrB: string; IgnoreCase: Boolean): Integer; overload; static;
    class function Compare(const StrA: string; IndexA: Integer; const StrB: string; IndexB: Integer; Length: Integer): Integer; overload; static;
    class function Compare(const StrA: string; IndexA: Integer; const StrB: string; IndexB: Integer; Length: Integer; IgnoreCase: Boolean): Integer; overload; static;
    class function CompareOrdinal(const strA: string; const strB: string): Integer; overload; static;
    class function CompareOrdinal(const strA: string; indexA: Integer; const strB: string; indexB: Integer; length: Integer): Integer; overload; static;
    function CompareTo(const strB: string): Integer;
    function Contains(const Value: string): Boolean;
    class function Copy(const Str: string): string; inline; static;
    procedure CopyTo(SourceIndex: Integer; var destination: array of Char; DestinationIndex: Integer; Count: Integer);
    class function EndsText(const ASubText, AText: string): Boolean; static;
    function EndsWith(const Value: string): Boolean; overload;
    function EndsWith(const Value: string; IgnoreCase: Boolean): Boolean; overload;
    function Equals(const Value: string): Boolean; overload;
    class function Equals(const a: string; const b: string): Boolean; overload; static;
    class function Format(const Format: string; const args: array of const): string; overload; static;
    function GetHashCode: Integer;
    function IndexOf(value: Char): Integer; overload; inline;
    function IndexOf(const Value: string): Integer; overload; inline;
    function IndexOf(Value: Char; StartIndex: Integer): Integer; overload;
    function IndexOf(const Value: string; StartIndex: Integer): Integer; overload;
    function IndexOf(Value: Char; StartIndex: Integer; Count: Integer): Integer; overload;
    function IndexOf(const Value: string; StartIndex: Integer; Count: Integer): Integer; overload;
    function IndexOfAny(const AnyOf: array of Char): Integer; overload;
    function IndexOfAny(const AnyOf: array of Char; StartIndex: Integer): Integer; overload;
    function IndexOfAny(const AnyOf: array of Char; StartIndex: Integer; Count: Integer): Integer; overload;
    function Insert(StartIndex: Integer; const Value: string): string;
    function IsDelimiter(const Delimiters: string; Index: Integer): Boolean;
    function IsEmpty: Boolean;
    class function IsNullOrEmpty(const Value: string): Boolean; static;
    class function IsNullOrWhiteSpace(const Value: string): Boolean; static;
    class function Join(const Separator: string; const values: array of const): string; overload; static;
    class function Join(const Separator: string; const Values: array of string): string; overload; static;
    class function Join(const Separator: string; const Values: IEnumerable): string; overload; static;
    class function Join(const Separator: string; const value: array of string; StartIndex: Integer; Count: Integer): string; overload; static;
    function LastDelimiter(const Delims: string): Integer;
    function LastIndexOf(Value: Char): Integer; overload;
    function LastIndexOf(const Value: string): Integer; overload;
    function LastIndexOf(Value: Char; StartIndex: Integer): Integer; overload;
    function LastIndexOf(const Value: string; StartIndex: Integer): Integer; overload;
    function LastIndexOf(Value: Char; StartIndex: Integer; Count: Integer): Integer; overload;
    function LastIndexOf(const Value: string; StartIndex: Integer; Count: Integer): Integer; overload;
    function LastIndexOfAny(const AnyOf: array of Char): Integer; overload;
    function LastIndexOfAny(const AnyOf: array of Char; StartIndex: Integer): Integer; overload;
    function LastIndexOfAny(const AnyOf: array of Char; StartIndex: Integer; Count: Integer): Integer; overload;
    function PadLeft(TotalWidth: Integer): string; overload; inline;
    function PadLeft(TotalWidth: Integer; PaddingChar: Char): string; overload; inline;
    function PadRight(TotalWidth: Integer): string; overload; inline;
    function PadRight(TotalWidth: Integer; PaddingChar: Char): string; overload; inline;
    function Remove(StartIndex: Integer): string; overload; inline;
    function Remove(StartIndex: Integer; Count: Integer): string; overload; inline;
    function Replace(OldChar: Char; NewChar: Char): string; overload;
    function Replace(OldChar: Char; NewChar: Char; ReplaceFlags: TReplaceFlags): string; overload;
    function Replace(const OldValue: string; const NewValue: string): string; overload;
    function Replace(const OldValue: string; const NewValue: string; ReplaceFlags: TReplaceFlags): string; overload;
    function Split(const Separator: array of Char): TArray; overload;
    function Split(const Separator: array of Char; Count: Integer): TArray; overload;
    function Split(const Separator: array of Char; Options: TStringSplitOptions): TArray; overload;
    function Split(const Separator: array of string; Options: TStringSplitOptions): TArray; overload;
    function Split(const Separator: array of Char; Count: Integer; Options: TStringSplitOptions): TArray; overload;
    function Split(const Separator: array of string; Count: Integer; Options: TStringSplitOptions): TArray; overload;
    function StartsWith(const Value: string): Boolean; overload;
    function StartsWith(const Value: string; IgnoreCase: Boolean): Boolean; overload;
    function Substring(StartIndex: Integer): string; overload;
    function Substring(StartIndex: Integer; Length: Integer): string; overload;
    function ToCharArray: TArray; overload;
    function ToCharArray(StartIndex: Integer; Length: Integer): TArray; overload;
    function ToLower: string;
    function ToLowerInvariant: string;
    function ToUpper: string;
    function ToUpperInvariant: string;
    function Trim: string; overload;
    function Trim(const TrimChars: array of Char): string; overload;
    function TrimEnd(const TrimChars: array of Char): string;
    function TrimStart(const TrimChars: array of Char): string;
    property Chars[Index: Integer]: Char read GetChars;
    property Length: Integer read GetLength;
  end;

Note : The same rules for the class and record helpers applies, so you can define multiple helpers with a single type. However, only zero or one helper applies in any specific location in source code and only the record helper defined in the nearest scope will apply. The record helper scope is determined in the normal Delphi fashion (for example, right to left in the unit’s uses clause).

As you can see most of the strings related methods now are part of the string type, so now you can write code like this.

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

var
  s,s1 :string;
begin
  try
    // Length property
    s:='Hello Delphi XE3';
    Writeln(Format('the string Length is %d',[s.Length]));
    Writeln('The length of this literal string is '.Length);

    //function Contains
    if s.Contains('Delphi') then
      Writeln(Format('the string "%s" contains the string "%s"',[s,'Delphi']));

    //function EndsWith
    if s.EndsWith('XE3') then
      Writeln(Format('the string "%s" ends with the string "%s"',[s,'XE3']));

    //function ToLower
    Writeln(Format('using ToLower %s',[s.ToLower]));

    //function ToUpper
    Writeln(Format('using ToUpper %s',[s.ToUpper]));

    //function IndexOf
    Writeln(Format('The index of H is %d',[s.IndexOf('H')]));   //the value is based in a zero index

    //function LastDelimiter
    Writeln(Format('The first occurence of any of these chars "abcdef" is %d',[s.IndexOfAny(['a','b','c','d','e','f'])]));   //the value is based in a zero index

    //function LastDelimiter
    Writeln(Format('The last occurence of any of these chars "abcdef" is %d',[s.LastDelimiter('abcdef')]));   //the value is based in a zero index

    //function Remove
    Writeln(Format('The string with only the first 5 chars is %s',[s.Remove(5)]));   //the value is based in a zero index

    //function Replace
    Writeln(Format('Replacing the white spaces for "-", the string  becomes %s',[s.Replace(' ','-')]));   //the value is based in a zero index

    //function split
    Writeln;
    Writeln('Testing the split function');
    for s1 in s.Split([' ']) do
      Writeln(s1);
    Writeln;

    //function Substring
    Writeln(Format('The sub string starting in the index 6 is "%s"',[s.Substring(6)]));   //the value is based in a zero index
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln;
end.

Note : All the methods and properties of the System.SysUtils.TStringHelper are zero based index, so be careful when you uses functions like CopyTo, IndexOf, IndexOfAny, Insert, Join, LastDelimiter, LastIndexOf, LastIndexOfAny, Remove, Substring, ToCharArray and the Chars property.

Finally exist a few set of record helpers included in the RTL code which you can use

  • System.Classes – TUInt32Helper = record helper for UInt32
  • System.SyncObjs – TCriticalSectionHelper = record helper for TRTLCriticalSection
  • System.SyncObjs – TConditionVariableHelper = record helper for TRTLConditionVariable
  • System.Mac.CFUtils – CFGregorianDateHelper = record helper for CFGregorianDate
  • System.SysUtils – TGuidHelper = record helper for TGUID
  • System – TSingleHelper = record helper for Single
  • System – TDoubleHelper = record helper for Double
  • System – TExtendedHelper = record helper for Extended
  • Winapi.D2D1 – D2DMatrix3x2FHelper = record helper for TD2DMatrix3X2F
  • Vcl.Themes – TElementMarginsHelper = record helper for TElementMargins


13 Comments

Disabling the Embedded Designer in RAD Studio XE3

In RAD Studio XE3 the option (located in Tools > Options > Environment Options > VCL Designer > Embedded Designer ) to disable the Embedded Designer was hide. Personally I still using the old floating designer when I work in VCL projects.

So if you want disable the Embedded Designer just go to the the windows registry key HKEY_CURRENT_USER\Software\Embarcadero\BDS\10.0\Form Design and set the Embedded Designer value to False

Note : Remember which FireMonkey only supports the embedded form designer.