The Road to Delphi

Delphi – Free Pascal – Oxygene

Tag Archives: Delphi


by Leave a comment

WMI Tasks using Delphi – Dates and Times

How do I convert WMI dates to standard dates and times?

Use the SWbemDateTime object to convert these to regular dates and times.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  FWbemDateObj  : OleVariant;
  Dt            : TDateTime;
begin;
  FWbemDateObj  := CreateOleObject('WbemScripting.SWbemDateTime');

  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT InstallDate FROM Win32_OperatingSystem','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    FWbemDateObj.Value:=FWbemObject.InstallDate;
    Dt:=FWbemDateObj.GetVarDate;
    Writeln(Format('InstallDate %s',[FormatDateTime('dd mmm yyyy',dt)]));
    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

How do I determine the time currently configured on a computer?

Use the Win32_LocalTime class.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_LocalTime','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Year          : %d',[Integer(FWbemObject.Year)]));
    Writeln(Format('Month         : %d',[Integer(FWbemObject.Month)]));
    Writeln(Format('Day           : %d',[Integer(FWbemObject.Day)]));
    Writeln(Format('Hour          : %d',[Integer(FWbemObject.Hour)]));
    Writeln(Format('Minute        : %d',[Integer(FWbemObject.Minute)]));
    Writeln(Format('Second        : %d',[Integer(FWbemObject.Second)]));

    Writeln(Format('Day Of Week   : %d',[Integer(FWbemObject.DayOfWeek)]));
    Writeln(Format('Quarter       : %d',[Integer(FWbemObject.Quarter)]));
    Writeln(Format('Week In Month : %d',[Integer(FWbemObject.WeekInMonth )]));
    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

How do I determine the name of the time zone in which a computer is running?

Use the Win32_TimeZone class and check the value of the Description property.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_TimeZone','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Description   : %s',[String(FWbemObject.Description)]));
    Writeln(Format('Daylight Name : %s',[String(FWbemObject.DaylightName)]));
    Writeln(Format('Standard Name : %s',[String(FWbemObject.StandardName)]));
    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

This post is based in the MSDN entry WMI Tasks: Dates and Times


by 3 Comments

WMI Tasks using Delphi – Computer Software

How do I uninstall software?

If the software was installed using Microsoft Windows Installer (MSI), use the WMI class Win32_Product and the Uninstall method.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM  Win32_Product Where Name="Software Name"','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Result %d',[Integer(FWbemObject.Uninstall())]));//if the returned value is 0 the uninstallation was Successful.
    FWbemObject:=Unassigned;
  end;
end;

How do I determine what version of Microsoft Office is installed?

Use the Win32_Product class and check the value of the Version property.
Note : The execution of this class can take time to run, depending of how many software entries exist.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT Name,Version FROM  Win32_Product Where Name LIKE "Microsoft Office%"','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Name    %s',[String(FWbemObject.Name)]));// String
    Writeln(Format('Version %s',[String(FWbemObject.Version)]));// String
    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

How I do inventory all the software installed on a computer?

If the software was installed using Microsoft Windows Installer (MSI) use the WMI class Win32_Product.

Note : The execution of this class can take time to run, depending of how many software entries exist.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT Name,Version FROM  Win32_Product','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Name    %s',[String(FWbemObject.Name)]));// String
    Writeln(Format('Version %s',[String(FWbemObject.Version)]));// String
    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

This post is based in the MSDN entry WMI Tasks: Computer Software


by 14 Comments

WMI Tasks using Delphi – Computer Hardware

Determine how much free memory a computer has

Use the class Win32_OperatingSystem and the FreePhysicalMemory property.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT FreePhysicalMemory FROM Win32_OperatingSystem','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Available Physical Memory %d',[Integer(FWbemObject.FreePhysicalMemory)]));
    FWbemObject:=Unassigned;
  end;
end;

Determine whether a computer has a DVD drive

Use the Win32_CDROMDrive class and check for the acronym DVD in the Name or DeviceID property.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_CDROMDrive','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('DeviceID    %s',[FWbemObject.DeviceID]));
    Writeln(Format('Description %s',[FWbemObject.Description]));
    Writeln(Format('Name        %s',[FWbemObject.Name]));
    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

Determine how much RAM is installed in a computer

Use the Win32_ComputerSystem class and check the value of the TotalPhysicalMemory property.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT TotalPhysicalMemory FROM Win32_ComputerSystem','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Total Physical Memory %d',[Integer(FWbemObject.TotalPhysicalMemory)]));
    FWbemObject:=Unassigned;
  end;
end;

Determine if a computer has more than one processor

Use the Win32_ComputerSystem class and the property NumberOfProcessors.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT NumberOfProcessors FROM Win32_ComputerSystem ','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Number Of Processors %d',[Integer(FWbemObject.NumberOfProcessors)]));
    FWbemObject:=Unassigned;
  end;
end;

Determine whether a computer has a PCMCIA slot

Use the Win32_PCMCIAController class.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  c             : Integer;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT DeviceID FROM Win32_PCMCIAController','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  c:=0;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    inc(c);
    FWbemObject:=Unassigned;
  end;
  Writeln(Format('Number of PCMCIA slots %d',[c]));
end;

Identify devices that are not working (those marked with an exclamation point icon in Device Manager)

Use the Win32_PnPEntity class and use the following clause in your WQL query. WHERE ConfigManagerErrorCode <> 0.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM  Win32_PnPEntity WHERE ConfigManagerErrorCode <> 0','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Class GUID %s',[String(FWbemObject.ClassGUID)]));
    Writeln(Format('Description %s',[String(FWbemObject.Description)]));
    Writeln(Format('Device ID %s',[String(FWbemObject.DeviceID)]));
    Writeln(Format('Manufacturer %s',[String(FWbemObject.Manufacturer)]));
    Writeln(Format('Name %s',[String(FWbemObject.Name)]));
    Writeln(Format('PNP Device ID %s',[String(FWbemObject.PNPDeviceID)]));
    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

Determine the properties of the mouse used on computer

Use the Win32_PointingDevice class. This returns the properties of all pointing devices, not just mouse devices.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM  Win32_PointingDevice','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Device ID               %s',[String(FWbemObject.DeviceID)]));
    Writeln(Format('Description             %s',[String(FWbemObject.Description)]));
    Writeln(Format('Manufacturer            %s',[String(FWbemObject.Manufacturer)]));
    Writeln(Format('Device Interface        %s',[String(FWbemObject.DeviceInterface)]));
    Writeln(Format('PNP Device ID           %s',[String(FWbemObject.PNPDeviceID)]));

    if not VarIsNull(FWbemObject.DoubleSpeedThreshold) then
      Writeln(Format('Double Speed Threshold  %d',[Integer(FWbemObject.DoubleSpeedThreshold)]));

    if not VarIsNull(FWbemObject.Resolution) then
      Writeln(Format('Resolution %d',[Integer(FWbemObject.Resolution)]));

    if not VarIsNull(FWbemObject.SampleRate) then
      Writeln(Format('Sample Rate  %d',[Integer(FWbemObject.SampleRate)]));

    if not VarIsNull(FWbemObject.Synch) then
      Writeln(Format('Synch  %d',[Integer(FWbemObject.Synch)]));

    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

Determine the speed of a processor installed in a computer

Use the Win32_Processor class and check the value of the MaxClockSpeed property.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM  Win32_Processor','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Processor Id     %s',[String(FWbemObject.ProcessorId)]));
    Writeln(Format('Max Clock Speed  %d',[Integer(FWbemObject.MaxClockSpeed)]));

    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

Determine whether a computer is a tower, a mini-tower, a laptop, and so on

Use the Win32_SystemEnclosure class and check the value of the ChassisType property.

Value Meaning
1
 Other
2
 Unknown
3
 Desktop
4
 Low Profile Desktop
5
 Pizza Box
6
 Mini Tower
7
 Tower
8
 Portable
9
 Laptop
10
 Notebook
11
 Hand Held
12
 Docking Station
13
 All in One
14
 Sub Notebook
15
 Space-Saving
16
 Lunch Box
17
 Main System Chassis
18
 Expansion Chassis
19
 SubChassis
20
 Bus Expansion Chassis
21
 Peripheral Chassis
22
 Storage Chassis
23
 Rack Mount Chassis
24
 Sealed-Case PC 
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  i             : integer;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM  Win32_SystemEnclosure','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    for i := VarArrayLowBound(FWbemObject.ChassisTypes, 1) to VarArrayHighBound(FWbemObject.ChassisTypes, 1) do
     Writeln(Format('Chassis Types %d',[Integer(FWbemObject.ChassisTypes[i])]));
    FWbemObject:=Unassigned;
  end;
end;

Get the serial number and asset tag of a computer

Use the Win32_SystemEnclosure class, and the properties SerialNumber and SMBIOSAssetTag.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM  Win32_SystemEnclosure','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    if not VarIsNull(FWbemObject.PartNumber) then
      Writeln(Format('Part Number      %s',[String(FWbemObject.PartNumber)]));
    if not VarIsNull(FWbemObject.SerialNumber) then
      Writeln(Format('Serial Number    %s',[String(FWbemObject.SerialNumber)]));
    if not VarIsNull(FWbemObject.SMBIOSAssetTag) then
      Writeln(Format('SMBIOS Asset Tag %s',[String(FWbemObject.SMBIOSAssetTag)]));
    FWbemObject:=Unassigned;
  end;
end;

Determine what kind of device is plugged into a USB port

Use the Win32_USBHub class and check the Description property. This property may have a value such as “Mass Storage Device” or “Printing Support”.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\cimv2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM  Win32_USBHub','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    if not VarIsNull(FWbemObject.DeviceID) then
      Writeln(Format('Device ID        %s',[String(FWbemObject.DeviceID)]));
    if not VarIsNull(FWbemObject.PNPDeviceID) then
      Writeln(Format('PNP Device ID    %s',[String(FWbemObject.PNPDeviceID)]));
    if not VarIsNull(FWbemObject.Description) then
      Writeln(Format('Description      %s',[String(FWbemObject.Description)]));

    Writeln;
    FWbemObject:=Unassigned;
  end;
end;

This post is based in the MSDN entry WMI Tasks: Computer Hardware


by 1 Comment

WMI Tasks using Delphi – Accounts and Domains

Determine the domain in which a computer belongs?

Use the Win32_ComputerSystem class and check the value of the Domain property. You can also use the DNSDomain property in Win32_NetworkAdapterConfiguration.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT Name,Domain FROM Win32_ComputerSystem','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Computer Name %s Domain %s',[FWbemObject.Name,FWbemObject.Domain]));
    FWbemObject:=Unassigned;
  end;
end;

Determine whether a computer is a server or a workstation?

Use the Win32_ComputerSystem class and the DomainRole property.

Value Meaning
0 (0x0)
 Standalone Workstation
1 (0x1)
 Member Workstation
2 (0x2)
 Standalone Server
3 (0x3)
 Member Server
4 (0x4)
 Backup Domain Controller
5 (0x5)
 Primary Domain Controller 
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT DomainRole FROM Win32_ComputerSystem','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    case FWbemObject.DomainRole  of
     0: Writeln('Standalone Workstation');
     1: Writeln('Member Workstation');
     2: Writeln('Standalone Server');
     3: Writeln('Member Server');
     4: Writeln('Backup Domain Controller');
     5: Writeln('Primary Domain Controller');
    end;
    FWbemObject:=Unassigned;
  end;
end;

Determine the computer name?

Use the Win32_ComputerSystem class and the Name property. You can also use the DNSHostName property in Win32_NetworkAdapterConfiguration.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT Name FROM Win32_ComputerSystem','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Computer Name %s',[FWbemObject.Name]));
    FWbemObject:=Unassigned;
  end;
end;

Find the name of the person currently logged on to a computer?

Use the Win32_ComputerSystem class and the UserName property.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT UserName FROM Win32_ComputerSystem','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    Writeln(Format('Current logged user %s',[FWbemObject.UserName]));
    FWbemObject:=Unassigned;
  end;
end;

Rename a computer

Use the Win32_ComputerSystem class, and the Rename method.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_ComputerSystem','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    FWbemObject.Rename('NewName');
    FWbemObject:=Unassigned;
  end;
end;

Retrieve only local groups using WMI

Use the Win32_Group class and include the following WHERE clause in your WQL query.

Where LocalAccount = True

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_Group Where LocalAccount = True','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Local Account %s - Name %s - SID %s - SID Type %s - Status %s', 
    [FWbemObject.LocalAccount, FWbemObject.Name, FWbemObject.SID, FWbemObject.SIDType, FWbemObject.Status ]));
    FWbemObject:=Unassigned;
  end;
end;

This post is based in the MSDN entry WMI Tasks: Accounts and Domains


by 10 Comments

All about WiFi Networks and WiFi Adapters using the WMI and Delphi

Some time ago I wrote an article about how list the Wifi networks using Delphi and the Native Wifi API, today I will show you how can you can gain  access  to even more info and stats about the Wifi Adapters and Networks in a local or remote machine using the WMI (Windows Management Instrumentation) and Delphi.

The WMI provides several classes to retrieve information about the WiFi networks and  adapters, which these classes you will able to know for example the list available wifi networks, transmition and reception Wifi Stats, TCP/IP IPV4 and IPv6 settings and so on.

In order to work with the next WMI classes your Wifi Network adapter must install a CIMWiFiProvider which implement these classes.

 

WiFi Networks Information

Current Wifi NetWork

To get the info (Name, AuthenAlgorithm, SSID) about the current Wifi Network (Profile) connected to the adapter you must use the WiFi_AdapterAssociationInfo class

procedure  GetWiFi_AdapterAssociationInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterAssociationInfo','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Associated         %s',[FWbemObject.Associated]));// Boolean
    Writeln(Format('AuthenAlgorithm    %s',[FWbemObject.AuthenAlgorithm]));// String
    Writeln(Format('AuthenEnabled      %s',[FWbemObject.AuthenEnabled]));// Boolean
    Writeln(Format('AuthenMode         %s',[FWbemObject.AuthenMode]));// String
    Writeln(Format('Caption            %s',[FWbemObject.Caption]));// String
    Writeln(Format('Channel            %s',[FWbemObject.Channel]));// String
    Writeln(Format('Description        %s',[FWbemObject.Description]));// String
    Writeln(Format('Encryption         %s',[FWbemObject.Encryption]));// String
    Writeln(Format('OpMode             %s',[FWbemObject.OpMode]));// String
    Writeln(Format('Profile            %s',[FWbemObject.Profile]));// String
    Writeln(Format('Rate               %s',[FWbemObject.Rate]));// String
    Writeln(Format('SettingID          %s',[FWbemObject.SettingID]));// String
    Writeln(Format('SSID               %s',[FWbemObject.SSID]));// String
    FWbemObject:=Unassigned;
  end;
end;

Stats of current Wifi NetWork

To get stats about the current wifi Network connected use the WiFi_AdapterAssocStats

procedure  GetWiFi_AdapterAssocStatsInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterAssocStats','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('ApDidNotTx              %s',[FWbemObject.ApDidNotTx]));// Uint32
    Writeln(Format('ApMacAddr               %s',[FWbemObject.ApMacAddr]));// String
    Writeln(Format('Caption                 %s',[FWbemObject.Caption]));// String
    Writeln(Format('CrcErrs                 %s',[FWbemObject.CrcErrs]));// Uint32
    Writeln(Format('Description             %s',[FWbemObject.Description]));// String
    Writeln(Format('DroppedByAp             %s',[FWbemObject.DroppedByAp]));// Uint32
    Writeln(Format('LoadBalancing           %s',[FWbemObject.LoadBalancing]));// Uint32
    Writeln(Format('LowRssi                 %s',[FWbemObject.LowRssi]));// Uint32
    Writeln(Format('NumAps                  %s',[FWbemObject.NumAps]));// Uint32
    Writeln(Format('NumAssociations         %s',[FWbemObject.NumAssociations]));// Uint32
    Writeln(Format('NumFullScans            %s',[FWbemObject.NumFullScans]));// Uint32
    Writeln(Format('NumPartialScans         %s',[FWbemObject.NumPartialScans]));// Uint32
    Writeln(Format('PercentMissedBeacons    %s',[FWbemObject.PercentMissedBeacons]));// Uint32
    Writeln(Format('PercentTxErrs           %s',[FWbemObject.PercentTxErrs]));// Uint32
    Writeln(Format('PoorBeaconQuality       %s',[FWbemObject.PoorBeaconQuality]));// Uint32
    Writeln(Format('PoorChannelQuality      %s',[FWbemObject.PoorChannelQuality]));// Uint32
    Writeln(Format('RoamCount               %s',[FWbemObject.RoamCount]));// Uint32
    Writeln(Format('Rssi                    %s',[FWbemObject.Rssi]));// String
    Writeln(Format('RxBeacons               %s',[FWbemObject.RxBeacons]));// Uint32
    Writeln(Format('SettingID               %s',[FWbemObject.SettingID]));// String
    Writeln(Format('TxRetries               %s',[FWbemObject.TxRetries]));// Uint32
    FWbemObject:=Unassigned;
  end;
end;

Signal Stats of current Wifi NetWork

To get the signal information (Quality, Crc Errors, RSSI) about current WiFi Network, use the WiFi_AdapterSignalParameters class.

procedure  GetWiFi_AdapterSignalParametersInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterSignalParameters','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Caption                 %s',[FWbemObject.Caption]));// String
    Writeln(Format('CrcErrors               %s',[FWbemObject.CrcErrors]));// Uint32
    Writeln(Format('Description             %s',[FWbemObject.Description]));// String
    Writeln(Format('PercentMissedBeacons    %s',[FWbemObject.PercentMissedBeacons]));// Uint32
    Writeln(Format('PercentTxRetries        %s',[FWbemObject.PercentTxRetries]));// Uint32
    Writeln(Format('RSSI                    %s',[FWbemObject.RSSI]));// String
    Writeln(Format('SettingID               %s',[FWbemObject.SettingID]));// String
    Writeln(Format('SignalQuality           %s',[FWbemObject.SignalQuality]));// String
    FWbemObject:=Unassigned;
  end;
end;

List the cached WiFi networks

To get the list of the cached wifi network availables (result of the last network scan) use the WiFi_AdapterCachedScanList class.


procedure  GetWiFi_AdapterCachedScanListInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterCachedScanList','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('AuthLevel                   %s',[FWbemObject.AuthLevel]));// String
    Writeln(Format('Band                        %s',[FWbemObject.Band]));// String
    Writeln(Format('Caption                     %s',[FWbemObject.Caption]));// String
    Writeln(Format('ChannelID                   %s',[FWbemObject.ChannelID]));// Uint32
    Writeln(Format('Description                 %s',[FWbemObject.Description]));// String
    Writeln(Format('Encrypted                   %s',[FWbemObject.Encrypted]));// Boolean
    Writeln(Format('MacAddress                  %s',[FWbemObject.MacAddress]));// String
    Writeln(Format('MulticastEncryptionLevel    %s',[FWbemObject.MulticastEncryptionLevel]));// String
    Writeln(Format('NetworkName                 %s',[FWbemObject.NetworkName]));// String
    Writeln(Format('OperationMode               %s',[FWbemObject.OperationMode]));// String
    Writeln(Format('RSSI                        %s',[FWbemObject.RSSI]));// String
    Writeln(Format('SettingID                   %s',[FWbemObject.SettingID]));// String
    Writeln(Format('Stealth                     %s',[FWbemObject.Stealth]));// Boolean
    Writeln(Format('UnicastEncryptionLevel      %s',[FWbemObject.UnicastEncryptionLevel]));// String
    FWbemObject:=Unassigned;
  end;
end;

List the available WiFi networks

Using the WiFi_AvailableNetwork class you can scan and get the list of the current wifi network availables.

procedure  GetWiFi_AvailableNetworkInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AvailableNetwork','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('AuthLevel                   %s',[FWbemObject.AuthLevel]));// String
    Writeln(Format('Band                        %s',[FWbemObject.Band]));// String
    Writeln(Format('Caption                     %s',[FWbemObject.Caption]));// String
    Writeln(Format('ChannelID                   %s',[FWbemObject.ChannelID]));// Uint32
    Writeln(Format('Description                 %s',[FWbemObject.Description]));// String
    Writeln(Format('Encrypted                   %s',[FWbemObject.Encrypted]));// Boolean
    Writeln(Format('MacAddress                  %s',[FWbemObject.MacAddress]));// String
    Writeln(Format('MulticastEncryptionLevel    %s',[FWbemObject.MulticastEncryptionLevel]));// String
    Writeln(Format('NetworkName                 %s',[FWbemObject.NetworkName]));// String
    Writeln(Format('OperationMode               %s',[FWbemObject.OperationMode]));// String
    Writeln(Format('RSSI                        %s',[FWbemObject.RSSI]));// String
    Writeln(Format('SettingID                   %s',[FWbemObject.SettingID]));// String
    Writeln(Format('Stealth                     %s',[FWbemObject.Stealth]));// Boolean
    Writeln(Format('UnicastEncryptionLevel      %s',[FWbemObject.UnicastEncryptionLevel]));// String
    FWbemObject:=Unassigned;
  end;
end;

List all the Stored WiFi networks profiles

If you want list all the stored WiFi networks profiles use the WiFi_PreferredProfile class.

procedure  GetWiFi_PreferredProfileInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_PreferredProfile','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Authentication    %s',[FWbemObject.Authentication]));// String
    Writeln(Format('Caption           %s',[FWbemObject.Caption]));// String
    Writeln(Format('Description       %s',[FWbemObject.Description]));// String
    Writeln(Format('Encryption        %s',[FWbemObject.Encryption]));// String
    Writeln(Format('MandatoryAp       %s',[FWbemObject.MandatoryAp]));// String
    Writeln(Format('Name              %s',[FWbemObject.Name]));// String
    Writeln(Format('OperationMode     %s',[FWbemObject.OperationMode]));// String
    Writeln(Format('SettingID         %s',[FWbemObject.SettingID]));// String
    Writeln(Format('SSID              %s',[FWbemObject.SSID]));// String
    Writeln(Format('Stealth           %s',[FWbemObject.Stealth]));// Boolean
    Writeln(Format('Type              %s',[FWbemObject.Type]));// String
    FWbemObject:=Unassigned;
  end;
end;

WiFi Adapters Information

Listing the Wifi Network Adapters

The WiFi_NetworkAdapter class give you access to the main information related to the WiFi network adpaters.

procedure  GetWiFi_NetworkAdapterInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_NetworkAdapter','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('AdapterType                    %s',[FWbemObject.AdapterType]));// String
    Writeln(Format('AdapterTypeId                  %s',[FWbemObject.AdapterTypeId]));// Uint16
    Writeln(Format('AssociationStatus              %s',[FWbemObject.AssociationStatus]));// String
    Writeln(Format('AuthenticationStatus           %s',[FWbemObject.AuthenticationStatus]));// String
    Writeln(Format('AutoSense                      %s',[FWbemObject.AutoSense]));// Boolean
    Writeln(Format('Availability                   %s',[FWbemObject.Availability]));// Uint16
    Writeln(Format('Band                           %s',[FWbemObject.Band]));// String
    Writeln(Format('Caption                        %s',[FWbemObject.Caption]));// String
    Writeln(Format('CcxPowerLevels                 %s',[FWbemObject.CcxPowerLevels]));// String
    Writeln(Format('CcxTpcPower                    %s',[FWbemObject.CcxTpcPower]));// String
    Writeln(Format('CcxVersion                     %s',[FWbemObject.CcxVersion]));// String
    Writeln(Format('ConfigManagerErrorCode         %s',[FWbemObject.ConfigManagerErrorCode]));// Uint32
    Writeln(Format('ConfigManagerUserConfig        %s',[FWbemObject.ConfigManagerUserConfig]));// Boolean
    Writeln(Format('Description                    %s',[FWbemObject.Description]));// String
    Writeln(Format('DeviceID                       %s',[FWbemObject.DeviceID]));// String
    Writeln(Format('DisableRfControl               %s',[FWbemObject.DisableRfControl]));// Boolean
    Writeln(Format('ErrorCleared                   %s',[FWbemObject.ErrorCleared]));// Boolean
    Writeln(Format('ErrorDescription               %s',[FWbemObject.ErrorDescription]));// String
    Writeln(Format('GUID                           %s',[FWbemObject.GUID]));// String
    Writeln(Format('HardwareRadioState             %s',[FWbemObject.HardwareRadioState]));// Boolean
    Writeln(Format('IBSSTxPower                    %s',[FWbemObject.IBSSTxPower]));// Uint16
    Writeln(Format('Index                          %s',[FWbemObject.Index]));// Uint32
    Writeln(Format('InstallDate                    %s',[FWbemObject.InstallDate]));// Datetime
    Writeln(Format('Installed                      %s',[FWbemObject.Installed]));// Boolean
    Writeln(Format('InterfaceIndex                 %s',[FWbemObject.InterfaceIndex]));// Uint32
    Writeln(Format('LastAppliedProfile             %s',[FWbemObject.LastAppliedProfile]));// String
    Writeln(Format('LastErrorCode                  %s',[FWbemObject.LastErrorCode]));// Uint32
    Writeln(Format('MACAddress                     %s',[FWbemObject.MACAddress]));// String
    Writeln(Format('Manufacturer                   %s',[FWbemObject.Manufacturer]));// String
    Writeln(Format('MaxNumberControlled            %s',[FWbemObject.MaxNumberControlled]));// Uint32
    Writeln(Format('MaxSpeed                       %s',[FWbemObject.MaxSpeed]));// Uint64
    Writeln(Format('Name                           %s',[FWbemObject.Name]));// String
    Writeln(Format('NetConnectionID                %s',[FWbemObject.NetConnectionID]));// String
    Writeln(Format('NetConnectionStatus            %s',[FWbemObject.NetConnectionStatus]));// Uint16
    Writeln(Format('NetEnabled                     %s',[FWbemObject.NetEnabled]));// Boolean
    Writeln(Format('NetworkAddresses               %s',[FWbemObject.NetworkAddresses]));// String
    Writeln(Format('PermanentAddress               %s',[FWbemObject.PermanentAddress]));// String
    Writeln(Format('PhysicalAdapter                %s',[FWbemObject.PhysicalAdapter]));// Boolean
    Writeln(Format('PNPDeviceID                    %s',[FWbemObject.PNPDeviceID]));// String
    Writeln(Format('PowerManagementCapabilities    %s',[FWbemObject.PowerManagementCapabilities]));// Uint16
    Writeln(Format('PowerManagementSupported       %s',[FWbemObject.PowerManagementSupported]));// Boolean
    Writeln(Format('ProductName                    %s',[FWbemObject.ProductName]));// String
    Writeln(Format('PSPMode                        %s',[FWbemObject.PSPMode]));// Uint16
    Writeln(Format('RadioState                     %s',[FWbemObject.RadioState]));// Boolean
    Writeln(Format('ServiceName                    %s',[FWbemObject.ServiceName]));// String
    Writeln(Format('Speed                          %s',[FWbemObject.Speed]));// Uint64
    Writeln(Format('Status                         %s',[FWbemObject.Status]));// String
    Writeln(Format('StatusInfo                     %s',[FWbemObject.StatusInfo]));// Uint16
    Writeln(Format('SupportedRates                 %s',[FWbemObject.SupportedRates]));// String
    Writeln(Format('TimeOfLastReset                %s',[FWbemObject.TimeOfLastReset]));// Datetime
    Writeln(Format('TxRate                         %s',[FWbemObject.TxRate]));// String
    Writeln(Format('WiFiAdapterType                %s',[FWbemObject.WiFiAdapterType]));// String
    Writeln(Format('XpZeroConfigEnabled            %s',[FWbemObject.XpZeroConfigEnabled]));// Boolean
    FWbemObject:=Unassigned;
  end;
end;

Get the version info about the Wifi Adapter

The WiFi_AdapterVersion class let you get the Driver and Firmware information about the WiFi Adapters.

procedure  GetWiFi_AdapterVersionInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterVersion','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Caption         %s',[FWbemObject.Caption]));// String
    Writeln(Format('Description     %s',[FWbemObject.Description]));// String
    Writeln(Format('Driver          %s',[FWbemObject.Driver]));// String
    Writeln(Format('EEPROM          %s',[FWbemObject.EEPROM]));// String
    Writeln(Format('Firmware11a     %s',[FWbemObject.Firmware11a]));// String
    Writeln(Format('Firmware11b     %s',[FWbemObject.Firmware11b]));// String
    Writeln(Format('Firmware11g     %s',[FWbemObject.Firmware11g]));// String
    Writeln(Format('Microcode11a    %s',[FWbemObject.Microcode11a]));// String
    Writeln(Format('Microcode11b    %s',[FWbemObject.Microcode11b]));// String
    Writeln(Format('Microcode11g    %s',[FWbemObject.Microcode11g]));// String
    Writeln(Format('SettingID       %s',[FWbemObject.SettingID]));// String
    FWbemObject:=Unassigned;
  end;
end;

Get Mac Address and Internal information about the Adapter

Use the WiFi_AdapterDevice class if you want get the Mac Address and internal info about the adapter.

procedure  GetWiFi_AdapterDeviceInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterDevice','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Caption              %s',[FWbemObject.Caption]));// String
    Writeln(Format('CardType             %s',[FWbemObject.CardType]));// String
    Writeln(Format('Description          %s',[FWbemObject.Description]));// String
    Writeln(Format('DeviceID             %s',[FWbemObject.DeviceID]));// String
    Writeln(Format('HardwareID           %s',[FWbemObject.HardwareID]));// String
    Writeln(Format('MacAddress           %s',[FWbemObject.MacAddress]));// String
    Writeln(Format('RevisionID           %s',[FWbemObject.RevisionID]));// String
    Writeln(Format('SettingID            %s',[FWbemObject.SettingID]));// String
    Writeln(Format('SubsystemID          %s',[FWbemObject.SubsystemID]));// String
    Writeln(Format('SubSystemVendorID    %s',[FWbemObject.SubSystemVendorID]));// String
    Writeln(Format('VendorID             %s',[FWbemObject.VendorID]));// String
    FWbemObject:=Unassigned;
  end;
end;

Get memory and I/O Address settings of the Adapter

To get the memory address, memory size and others items related to the internal settings of the adapter use the WiFi_AdapterConfigSettings class.

procedure  GetWiFi_AdapterConfigSettingsInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterConfigSettings','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('AddressingMode            %s',[FWbemObject.AddressingMode]));// String
    Writeln(Format('AttributeMemoryAddress    %s',[FWbemObject.AttributeMemoryAddress]));// String
    Writeln(Format('AttriuteMemorySize        %s',[FWbemObject.AttriuteMemorySize]));// String
    Writeln(Format('Caption                   %s',[FWbemObject.Caption]));// String
    Writeln(Format('ControllerIOAddress       %s',[FWbemObject.ControllerIOAddress]));// String
    Writeln(Format('Description               %s',[FWbemObject.Description]));// String
    Writeln(Format('InterruptNumber           %s',[FWbemObject.InterruptNumber]));// String
    Writeln(Format('IOAddress                 %s',[FWbemObject.IOAddress]));// String
    Writeln(Format('MemoryAddress             %s',[FWbemObject.MemoryAddress]));// String
    Writeln(Format('MemorySize                %s',[FWbemObject.MemorySize]));// String
    Writeln(Format('PacketFilterMask          %s',[FWbemObject.PacketFilterMask]));// String
    Writeln(Format('SettingID                 %s',[FWbemObject.SettingID]));// String
    Writeln(Format('SocketNumber              %s',[FWbemObject.SocketNumber]));// String
    FWbemObject:=Unassigned;
  end;
end;

TcpIp Settings IPv4

To get the WiFi Adapter TcpIp (IPv4) Settings use the WiFi_AdapterTcpIpSettings class

procedure  GetWiFi_AdapterTcpIpSettingsInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterTcpIpSettings','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Caption           %s',[FWbemObject.Caption]));// String
    Writeln(Format('DefaultGateway    %s',[FWbemObject.DefaultGateway]));// String
    Writeln(Format('Description       %s',[FWbemObject.Description]));// String
    Writeln(Format('DHCP_IP           %s',[FWbemObject.DHCP_IP]));// Boolean
    Writeln(Format('DHCP_WINS         %s',[FWbemObject.DHCP_WINS]));// Boolean
    Writeln(Format('DhcpServer        %s',[FWbemObject.DhcpServer]));// String
    Writeln(Format('DhcpSubnetMask    %s',[FWbemObject.DhcpSubnetMask]));// String
    Writeln(Format('DNS               %s',[FWbemObject.DNS]));// Boolean
    Writeln(Format('DNSPrim           %s',[FWbemObject.DNSPrim]));// String
    Writeln(Format('DNSSec            %s',[FWbemObject.DNSSec]));// String
    Writeln(Format('Domain            %s',[FWbemObject.Domain]));// String
    Writeln(Format('IPAddress         %s',[FWbemObject.IPAddress]));// String
    Writeln(Format('ScopeID           %s',[FWbemObject.ScopeID]));// String
    Writeln(Format('SettingID         %s',[FWbemObject.SettingID]));// String
    Writeln(Format('WINSPrim          %s',[FWbemObject.WINSPrim]));// String
    Writeln(Format('WINSSec           %s',[FWbemObject.WINSSec]));// String
    FWbemObject:=Unassigned;
  end;
end;

TcpIp Settings IPv6

To get the WiFi Adapter TcpIp (IPv6) Settings use the WiFi_AdapterTcpIpv6Settings class

procedure  GetWiFi_AdapterTcpIpv6SettingsInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterTcpIpv6Settings','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Caption           %s',[FWbemObject.Caption]));// String
    Writeln(Format('DefaultGateway    %s',[FWbemObject.DefaultGateway]));// String
    Writeln(Format('Description       %s',[FWbemObject.Description]));// String
    Writeln(Format('DHCP_IP           %s',[FWbemObject.DHCP_IP]));// Boolean
    Writeln(Format('DHCP_WINS         %s',[FWbemObject.DHCP_WINS]));// Boolean
    Writeln(Format('DhcpServer        %s',[FWbemObject.DhcpServer]));// String
    Writeln(Format('DhcpSubnetMask    %s',[FWbemObject.DhcpSubnetMask]));// String
    Writeln(Format('DNS               %s',[FWbemObject.DNS]));// Boolean
    Writeln(Format('DNSPrim           %s',[FWbemObject.DNSPrim]));// String
    Writeln(Format('DNSSec            %s',[FWbemObject.DNSSec]));// String
    Writeln(Format('Domain            %s',[FWbemObject.Domain]));// String
    Writeln(Format('IPAddress         %s',[FWbemObject.IPAddress]));// String
    Writeln(Format('ScopeID           %s',[FWbemObject.ScopeID]));// String
    Writeln(Format('SettingID         %s',[FWbemObject.SettingID]));// String
    Writeln(Format('WINSPrim          %s',[FWbemObject.WINSPrim]));// String
    Writeln(Format('WINSSec           %s',[FWbemObject.WINSSec]));// String
    FWbemObject:=Unassigned;
  end;
end;

Global Adpater stats

To get the global stats about the adapter like use the WiFi_AdapterTxRxStats class.

procedure  GetWiFi_AdapterTxRxStatsInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WiFi_AdapterTxRxStats','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Caption                              %s',[FWbemObject.Caption]));// String
    Writeln(Format('Description                          %s',[FWbemObject.Description]));// String
    //Writeln(Format('Rates                                %s',[FWbemObject.Rates]));//array of String
    Writeln(Format('RxDirectPackets                      %s',[FWbemObject.RxDirectPackets]));// String
    //Writeln(Format('RxDirectPacketsRate                  %s',[FWbemObject.RxDirectPacketsRate]));// array of String
    Writeln(Format('RxHighThroughputDirectPackets        %s',[FWbemObject.RxHighThroughputDirectPackets]));// String
    //Writeln(Format('RxHighThroughputDirectPacketsRate    %s',[FWbemObject.RxHighThroughputDirectPacketsRate]));// array of String
    Writeln(Format('RxNonDirectPackets                   %s',[FWbemObject.RxNonDirectPackets]));// String
    //Writeln(Format('RxNonDirectPacketsRate               %s',[FWbemObject.RxNonDirectPacketsRate]));// array of String
    Writeln(Format('RxTotalBytes                         %s',[FWbemObject.RxTotalBytes]));// String
    Writeln(Format('RxTotalPackets                       %s',[FWbemObject.RxTotalPackets]));// String
    Writeln(Format('SettingID                            %s',[FWbemObject.SettingID]));// String
    Writeln(Format('TxDirectPackets                      %s',[FWbemObject.TxDirectPackets]));// String
    //Writeln(Format('TxDirectPacketsRate                  %s',[FWbemObject.TxDirectPacketsRate]));// array of String
    Writeln(Format('TxHighThroughputDirectPackets        %s',[FWbemObject.TxHighThroughputDirectPackets]));// String
    //Writeln(Format('TxHighThroughputDirectPacketsRate    %s',[FWbemObject.TxHighThroughputDirectPacketsRate]));// array of String
    Writeln(Format('TxNonDirectPackets                   %s',[FWbemObject.TxNonDirectPackets]));// String
    //Writeln(Format('TxNonDirectPacketsRate               %s',[FWbemObject.TxNonDirectPacketsRate]));// array of String
    Writeln(Format('TxTotalBytes                         %s',[FWbemObject.TxTotalBytes]));// String
    Writeln(Format('TxTotalPackets                       %s',[FWbemObject.TxTotalPackets]));// String
    FWbemObject:=Unassigned;
  end;
end;

Check the source code of the console application with all the snippets included of this article on Github


by 10 Comments

Exploring Delphi XE2 – Tweaking the FireMonkey Styles

Maybe you’ve seen   articles about how use the FireMonkey Styles, and how you can set almost every aspect of a visual control, today I will go a step  forward to show how you can adjust the HSL (Hue, Saturation, and Lightness) values or a particular RGB component of the colors that belongs to a FireMonkey style.

Introduction

Fortunately the format of the styles used by FireMonkey is stored in a human readable format very similar to our old dfm format (Delphi forms), this allows us to understand how FireMonkey store, read and use these styles and of course make cool stuff with this.

Now look the next piece of a FireMonkey style and pays attention to the highlighted values

  object TRectangle
    StyleName = 'backgroundstyle'
    Position.Point = '(396,476)'
    Width = 50.000000000000000000
    Height = 50.000000000000000000
    HitTest = False
    DesignVisible = False
    Fill.Color = xFF505050
    Stroke.Kind = bkNone
  end
  object TRectangle
    StyleName = 'panelstyle'
    Position.Point = '(396,476)'
    Width = 50.000000000000000000
    Height = 50.000000000000000000
    HitTest = False
    DesignVisible = False
    Fill.Color = xFF404040
    Stroke.Kind = bkNone
    XRadius = 3.000000000000000000
    YRadius = 3.000000000000000000
  end
  object TCalloutRectangle
    StyleName = 'calloutpanelstyle'
    Position.Point = '(396,476)'
    Width = 50.000000000000000000
    Height = 50.000000000000000000
    HitTest = False
    DesignVisible = False
    Fill.Color = xFF404040
    Stroke.Kind = bkNone
    XRadius = 3.000000000000000000
    YRadius = 3.000000000000000000
    CalloutWidth = 23.000000000000000000
    CalloutLength = 11.000000000000000000
  end
      object TText
        StyleName = 'text'
        Position.Point = '(15,-8)'
        Locked = True
        Width = 50.000000000000000000
        Height = 17.000000000000000000
        ClipParent = True
        HitTest = False
        AutoSize = True
        Fill.Color = claWhite
        Text = 'Groupbox'
        WordWrap = False
      end

As you can see the colors of the FireMonkey style elements are stored in a hexadecimal format or using the name of the predefined FireMonkey colors , and these are the values ​​we need to modify.

The FireMonkey styles can be embedded in the resource property of a TStyleBook component or in a .Style file. In order to modify these values we need to parse the style and locate all entries which represent a TAlphaColor.

Parsing a FireMonkey Style

The first thing that jumps out is that the root component of is a TLayout object and the style format only defines a tree of objects. So the general idea is iterate over all the TAlphaColor properties, modify the colors and then write back to the TStyleBook.Resource property the modified TLayout.

So the first idea is, Hey I can load this tree of objects in a TLayout and then using the RTTI and a recursive function I can set all the properties which are of the type TAlphaColor.

So you will write something like this to create the TLayout object

 Stream:=TStringStream.Create;
 try
   s:=FStyleBook.Resource.Text;
   Stream.WriteString(s);
   Stream.Position:=0;
   FLayout:=TLayout(CreateObjectFromStream(nil,Stream));
 finally
  Stream.Free;
 end;

And now you will write a nice recursive function using the RTTI to set all the Colors of all the children objects. you will check which works ok (the colors are modified as you want) and then you will write the modified Style to the TLayout.Resource property. But stop we can’t use this method to do this task because the properties stored in FireMonkey Style is just a subset of all the properties of each object let me explain :

This is a TText object

  TText = class(TShape)
   //only showing the published properties.
  published
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    property Fill;
    property Font: TFont read FFont write SetFont;
    property HorzTextAlign: TTextAlign read FHorzTextAlign write SetHorzTextAlign
      default TTextAlign.taCenter;
    property VertTextAlign: TTextAlign read FVertTextAlign write SetVertTextAlign
      default TTextAlign.taCenter;
    property Text: string read FText write SetText;
    property Stretch: Boolean read FStretch write SetStretch default False;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  end;

And this is how a TText object is stored in a FireMonkey Style

    object TText
      StyleName = 'text'
      Align = alClient
      Locked = True
      Width = 49.000000000000000000
      Height = 20.000000000000000000
      HitTest = False
      Fill.Color = xFFE0E0E0
      Text = 'label'
    end

As you can see if you use the RTTI way to set the new color values and then write the object back you will passing all the properties to the object and finally you will create a giant modified
FireMonkey style which will slow down our application. So what is the solution? well just parse the text of the style manually and determine using a simple algorithm if the entry (line) to process is a TAlphaColor or not.

In this point you have many options, you can use a regular expression, or create an array with the name of all possible entries to process like Fill.Color, Color, Stroke.Color and so on, and all this just to process a line like Fill.Color = xFFE0E0E0. But I choose more simple option, just dividing a line in 2 components called Name and Value.

Let me show you with a piece of code.

First define a structure to hold the data of the style to modify.

 TFMStyleLine=record
  Index   : Integer;
 IsColor : Boolean;
  Name    : string;
  Value   : string;
 Color : TAlphaColor;
 end;

 FLines : TList<TFMStyleLine>;

and then write a procedure to parse the FireMonkey Style


//this function determine if a particular line of the resource property is a AlphaColor
function PropIsColor(const Name, Value: string): Boolean;
begin
 Result:=(CompareText(Name,'Color')=0) or (Pos('.Color',Name)>0) or (StartsText('cla',Value)) or (Length(Value)=9) and (Value[1]='x'));
end;

//Fill a generic list with the lines which have a color property
procedure FillList;
var
  i : integer;
  ALine : TFMStyleLine;
  p : integer;
begin
  FLines.Clear;
  for i := 0 to FStyleBook.Resource.Count-1 do
  begin
    ALine.IsColor:=False;
    ALine.Name:='';
    ALine.Value:='';
    ALine.Color:=claNull;
    //Determine if the line has a = sign
    p:=Pos('=',FStyleBook.Resource[i]);
     if p>0 then
     begin
       //get the name of the property
       ALine.Name :=Trim(Copy(FStyleBook.Resource[i],1,p-1));
       //get the value of the property
       ALine.Value:=Trim(Copy(FStyleBook.Resource[i],p+1));
       //check if is the line has a color
       ALine.IsColor:=PropIsColor(ALine.Name, ALine.Value);
       if ALine.IsColor then
       begin
         //store the index of the line from the resource to modify
         ALine.Index:=i;
         ALine.Color :=StringToAlphaColor(ALine.Value);
         //add the record to the collection
         FLines.Add(ALine);
       end;
     end;
  end;
end;

As you can see the logic is very simple (sure can be improved) and works.

Making the changes

In this point we have a list with all the colors to modify, so we can to start applying the operations over the colors to change the HSL and RGB components.

//this procedure modify the RGB components of the colors stored in the generics list, adding a delta value (1..255) for each component (R, G, B)
procedure ChangeRGB(dR, dG, dB: Byte);
var
  i : Integer;
  v : TFMStyleLine;
begin
  for i := 0 to FLines.Count-1 do
   //only modify the lines which contains a Color <>  claNull
   if FLines[i].IsColor and (FLines[i].Color<>claNull) then
    begin
      v:=FLines[i];
      TAlphaColorRec(v.Color).R:=TAlphaColorRec(v.Color).R+dR;
      TAlphaColorRec(v.Color).G:=TAlphaColorRec(v.Color).G+dG;
      TAlphaColorRec(v.Color).B:=TAlphaColorRec(v.Color).B+dB;
      if v.Color<>FMod[i].Color then
        FMod[i]:=v;
    end;
end;

//this procedure modify the HSL values from the colors stored in generic list
procedure ChangeHSL(dH, dS, dL: Single);
var
  i : Integer;
  v : TFMStyleLine;
begin
  for i := 0 to FLines.Count-1 do
   //only modify the lines which contains a Color <>  claNull
   if FLines[i].IsColor and (FLines[i].Color<>claNull) then
    begin
      v:=FLines[i];
      v.Color:=(FMX.Types.ChangeHSL(v.Color,dH,dS,dL));
      if v.Color<>FMod[i].Color then
        FMod[i]:=v;
    end;
end;

And now an example of how use this code. check the next form which has the Blend style (included with Delphi XE)

Now executing this code for the HSL transformation

Var
 Eq : TStyleEqualizer;
begin
 Eq:= TStyleEqualizer.Create;
 try
  Eq.StyleBook:=StyleBook1;
  Eq.ChangeHSL(130/360,5/100,0);
  Eq.Refresh;
 finally
  Eq.Free;
 end;
end;

we have this result

Now executing this code for the RGB transformation

Var
 Eq : TStyleEqualizer;
begin
 Eq:= TStyleEqualizer.Create;
 try
  Eq.StyleBook:=StyleBook1;
  Eq.ChangeRGB(50,0,0);
  Eq.Refresh;
 finally
  Eq.Free;
 end;
end;

The Application

Finally I wrote an application that uses the functions described above to modify in runtime any FireMonkey Style and let you save the changes creating a new style in just a few clicks.

Check this video to see the application in action

Check the source code on Github.


by 60 Comments

Exploring Delphi XE2 – VCL Styles Part I

The new version of Rad Studio include a very nice  feature called VCL Styles,  this functionality allows you to apply a skin (theme) to any VCL Form application. So in this post I will show you the basics about how load in runtime an embedded style or read the style file directly from the disk. besides as how you can easily create a new style.

Working with VCL Styles

You can add  a VCL Style to your application directly from the Delphi IDE menu entry    Project-> Options -> Application -> Appearance Selecting the styles which you want to include in your Application and choosing a default style to apply. when you select a style, this is stored in the exe as a resource of the type VCLSTYLE with a 80 kb size approx by style.


In order to work with the VCL Styles you must use the TStyleManager class located in the Themes unit and include the Vcl.Styles  unit to enable the VCL styles support.

Registering a Style

To load (register) a VCL Style from a File you must use the LoadFromFile  function of the TStyleManager class.

procedure RegisterStyleFromDisk(const StyleFileName: string);
begin
 try
   if TStyleManager.IsValidStyle(StyleFileName) then
     TStyleManager.LoadFromFile(StyleFileName); //beware in this line you are only loading and registering a VCL Style and not setting as the current style.
   else
     ShowMessage('the Style is not valid');
end;

And to load an style from a resource use the LoadFromResource or TryLoadFromResource

procedure RegisterStyleFromResource(const StyleResource: string);
begin
   TStyleManager.LoadFromResource(HInstance, StyleResource); //beware in this line you are only loading and registering a VCL Style and not setting as the current style.
end;

Setting a Style

To set in Runtime an already loaded (registered) style you must use the SetStyle(or TrySetStyle) procedure.

The SetStyle function has 3 overloaded versions

Use this version when you want set a registered style using his name

//class procedure SetStyle(const Name: string); overload;
TStyleManager.SetStyle('StyleName');

Use this version when you want set registered style using a instance to the style

//class procedure SetStyle(Style: TCustomStyleServices); overload;
TStyleManager.SetStyle(TStyleManager.Style['StyleName']);

And finally use this version when you has a handle to the style returned by the functions LoadFromFile and LoadFromResource 

//class procedure SetStyle(Handle: TStyleServicesHandle); overload;
TStyleManager.SetStyle(TStyleManager.LoadFromFile(StyleFileName))

Finally using the above functions I wrote a simple app to register and set VCL Styles


Download the source code and binaries from here

Creating New Styles

The Rad Studio XE2 includes the VCL Style designer which is a very handy tool to edit and create new VCL Styles, you can call this tool from the IDE Menu Tools -> VCL Style designer or executing directly (the file VclStyleDesigner.exe) form the bin directory where the Rad Studio is installed. this is an image of the tool

The main element is the image under the images category, which define how the control will be drawn, also you can edit every single aspect of the Style like the buttons, checkboxes, scrollbars and so on.

The Rad Studio XE2 only includes 5 predefined styles in the <Documents>\RAD Studio\9.0\Styles folder, But you can easily create your own styles using a predefined theme as template, check the next list of steps to create a New Style.

  • First from the VCL Style designer load the style to use as template using the File->Open option
  • Now go to the Image->Export option to save the image as png

  •  Then Load the Image in your prefered image editor and play a little, for example changing the hue and saturation of the image.


  • Now back in the VCL Style designer go to the option Image->Update , select the modified image and then press ok in the dialog


  • Then go to the Style->Assign Colors option to let the application adjust the colors of the style according to the new image.
  • Now press F9 or Test->Style to check the result


  • Finally modify the name of the Style and use the option File->Save As to store your new creation.

Following these simple steps in a few minutes I create a set of new styles ready to use.

Download the Styles from here

Tip : you can copy the styles  to the <Documents>\RAD Studio\9.0\Styles folder and these will be recognized by Rad Studio XE2 when your open the Project-> Options -> Application -> Appearance option)


by 20 Comments

Reading the SMBios Tables using Delphi

UPDATE : If you want access the SMBIOS using Delphi or Free Pascal try the TSMBIOS project.

 

The system management BIOS (SMBIOS)   is a specification of how the system vendors present management information about their products in a standard format, so you can use the  SMBIOS to discover information about the hardware platform, such as the system manufacturer, the system BIOS version, processor installed characteristics  and so on. From windows you can acceess the SMBIOS tables using the WMI or the WinApi. In this article I will show how  you can gain access to the SMBios tables using the WMI and Delphi.

The SMBIOS Tables

The tables are located directly adjacent to each other in memory. Each table is composed of a 4-byte header, a specific structure , and an optional string table.

Header

This is the header description of each table

The type field present in the header define how each table must be interpreted, this is a list of a few table types

  • BIOS Information (Type 0)
  • System Information (Type 1)
  • System Enclosure (Type 3)
  • Processor Information (Type 4)
  • Cache Information (Type 7)
  • System Slots (Type 9)
  • Physical Memory Array (Type 16)
  • Memory Device (Type 17)
  • Memory Array Mapped Address (Type 19)
  • System Boot Information (Type 32)

Text Strings

The text strings associated with a given SMBIOS table are appended directly after the formatted portion of the structure. Each string is terminated with a null (00h) BYTE and the set of strings is terminated with an additional null (00h) BYTE. When the formatted portion of a SMBIOS structure references a string, it does so by specifying a non-zero string number within the structure’s string-set. For example, if a string field contains 02h, it references the second string following the formatted portion of the SMBIOS structure. If a string field references no string, a null (0) is placed in that string field.

Check the next representation of a BIOS Table (Type


 db 0 ; Indicates BIOS Structure Type            |
 db 13h ; Length of information in bytes         | Header of the table
 dw ? ; Reserved for handle                      |

 db 01h ; String 1 is the Vendor Name            |
 db 02h ; String 2 is the BIOS version           |
 dw 0E800h ; BIOS Starting Address               |
 db 03h ; String 3 is the BIOS Build Date        | formatted portion
 db 1 ; Size of BIOS ROM is 128K (64K * (1 + 1)) |
 dq BIOS_Char ; BIOS Characteristics             |
 db 0 ; BIOS Characteristics Extension Byte 1    |

 db ‘System BIOS Vendor Name’,0 ;                |
 db ‘4.04’,0 ;                                   | Text Strings (unformatted portion)
 db ‘00/00/0000’,0 ;                             |

 db 0 ; End of structure

WMI

Now which you know the basics about the SMBios table structures, you need a way to retrieve such tables.  the WMI provides a way to get  the raw SMBIOS data in a single buffer using the class MSSmBios_RawSMBiosTables this class is in the root\WMI namespace and is available since Windows XP.

Check this small snippet to retrieve the SMBios tables buffer contained in the SMBiosData property

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  vArray        : variant;
  Value         : integer;
  i             : integer;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  //connect to the Wmi service
  FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\WMI', '', '');
  //execute the WQL sentence
  FWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM MSSmBios_RawSMBiosTables', 'WQL', wbemFlagForwardOnly);
  oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumvariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    //store the size of the buffer
    FSize := FWbemObject.Size;
    GetMem(FBuffer, FSize);
    //get the addtional properties like the SMBIos version
    FDmiRevision:= FWbemObject.DmiRevision;
    FSmbiosMajorVersion :=FWbemObject.SmbiosMajorVersion;
    FSmbiosMinorVersion :=FWbemObject.SmbiosMinorVersion;

    //get the buffer of the SMBios tables
    vArray := FWbemObject.SMBiosData;

    FWbemObject := Unassigned;
  end;
end;

Delphi

From the Delphi side we need to create a few structures to hold the data of the tables and write some helper functions to parse the information.

type
  // http://www.dmtf.org/standards/smbios
  SMBiosTables = (
    BIOSInformation = 0,
    SystemInformation = 1,
    BaseBoardInformation = 2,
    EnclosureInformation = 3,
    ProcessorInformation = 4,
    MemoryControllerInformation = 5,
    MemoryModuleInformation = 6,
    CacheInformation = 7,
    PortConnectorInformation = 8,
    SystemSlotsInformation = 9,
    OnBoardDevicesInformation = 10,
    OEMStrings = 11,
    SystemConfigurationOptions = 12,
    BIOSLanguageInformation = 13,
    GroupAssociations = 14,
    SystemEventLog = 15,
    PhysicalMemoryArray = 16,
    MemoryDevice = 17,
    MemoryErrorInformation = 18,
    MemoryArrayMappedAddress = 19,
    MemoryDeviceMappedAddress = 20,
    EndofTable = 127); //for more tables check the official specifications http://www.dmtf.org/standards/smbios

  //the header of each SMBios table
  TSmBiosTableHeader = packed record
    TableType: Byte;
    Length: Byte;
    Handle: Word;
  end;

  //this is a helper record to store the header and index of each table stored in the buffer
  TSMBiosTableEntry = record
    Header: TSmBiosTableHeader;
    Index : Integer;
  end;

  //this is the record to store Bios information about the table Type 0
  TBiosInfo = packed record
    Header: TSmBiosTableHeader;
    Vendor: Byte;
    Version: Byte;
    StartingSegment: Word;
    ReleaseDate: Byte;
    BiosRomSize: Byte;
    Characteristics: Int64;
    ExtensionBytes : array [0..1] of Byte;
  end;

The next code show how you can parse the buffer with the raw data and fill a Generic TList of TSMBiosTableEntry records.

function GetSMBiosTablesList(Buffer : PByteArray): TList;
Var
  Index : integer;
  Header: TSmBiosTableHeader;
  Entry : TSMBiosTableEntry;
begin
  Result    := TList.Create;
  Index     := 0;
  repeat
    //read the header
    Move(Buffer[Index], Header, SizeOf(Header));
    Entry.Header:=Header;
    Entry.Index:=Index;
    //add to the list
    Result.Add(Entry);

    //check if the tale type is 127 (end of tables)
    if Header.TableType=Ord(SMBiosTables.EndofTable) then break;

    //increase the Index in the length of the formatted data
    inc(Index, Header.Length);

    //Text strings zone

    //check for the boundaries of the buffer
    if Index+1>FSize then
      Break;

    //check for $00 $00 -> table termination
    while not((Buffer[Index] = 0) and (Buffer[Index + 1] = 0)) do
    if Index+1>FSize then
     Break
    else
     inc(Index);

    inc(Index, 2);
  until (Index>FSize);
end;

Now to retrieve a text string from a SMBios table

//the Entry Parameter is the buffer to the unformatted data
//The index is the number of the text string to retrieve
function GetSMBiosString(Entry, Index: integer): AnsiString;
var
  i: integer;
  p: PAnsiChar;
begin
  Result := '';
  for i := 1 to Index do
  begin
    p := PAnsiChar(@Buffer[Entry]);
    if i = Index then
    begin
      Result := p;
      break;
    end
    else
      inc(Entry, StrLen(p) + 1);
  end;
end;

A unit to retrieve the Smbios tables

Here I leave a unit to retrieve and parse the SMBios tables, the unit does not cover all the tables types (you can read the official specification)

//Author Rodrigo Ruz V.
//2011-08-01

unit uSMBIOS;

interface

uses
  SysUtils,
  Windows,
  Generics.Collections,
  Classes;

type
  // http://www.dmtf.org/standards/smbios
  SMBiosTables = (
    BIOSInformation = 0,
    SystemInformation = 1,
    BaseBoardInformation = 2,
    EnclosureInformation = 3,
    ProcessorInformation = 4,
    MemoryControllerInformation = 5,
    MemoryModuleInformation = 6,
    CacheInformation = 7,
    PortConnectorInformation = 8,
    SystemSlotsInformation = 9,
    OnBoardDevicesInformation = 10,
    OEMStrings = 11,
    SystemConfigurationOptions = 12,
    BIOSLanguageInformation = 13,
    GroupAssociations = 14,
    SystemEventLog = 15,
    PhysicalMemoryArray = 16,
    MemoryDevice = 17,
    MemoryErrorInformation = 18,
    MemoryArrayMappedAddress = 19,
    MemoryDeviceMappedAddress = 20,
    EndofTable = 127);

  TSmBiosTableHeader = packed record
    TableType: Byte;
    Length: Byte;
    Handle: Word;
  end;

  TBiosInfo = packed record
    Header: TSmBiosTableHeader;
    Vendor: Byte;
    Version: Byte;
    StartingSegment: Word;
    ReleaseDate: Byte;
    BiosRomSize: Byte;
    Characteristics: Int64;
    ExtensionBytes : array [0..1] of Byte;
  end;

  TSysInfo = packed record
    Header: TSmBiosTableHeader;
    Manufacturer: Byte;
    ProductName: Byte;
    Version: Byte;
    SerialNumber: Byte;
    UUID: array [0 .. 15] of Byte;
    WakeUpType: Byte;
  end;

  TBaseBoardInfo = packed record
    Header: TSmBiosTableHeader;
    Manufacturer: Byte;
    Product: Byte;
    Version: Byte;
    SerialNumber: Byte;
  end;

  TEnclosureInfo = packed record
    Header: TSmBiosTableHeader;
    Manufacturer: Byte;
    &Type: Byte;
    Version: Byte;
    SerialNumber: Byte;
    AssetTagNumber: Byte;
    BootUpState: Byte;
    PowerSupplyState: Byte;
    ThermalState: Byte;
    SecurityStatus: Byte;
    OEM_Defined: DWORD;
  end;

  TProcessorInfo = packed record
    Header: TSmBiosTableHeader;
    SocketDesignation: Byte;
    ProcessorType: Byte;
    ProcessorFamily: Byte;
    ProcessorManufacturer: Byte;
    ProcessorID: Int64; // QWORD;
    ProcessorVersion: Byte;
    Voltaje: Byte;
    ExternalClock: Word;
    MaxSpeed: Word;
    CurrentSpeed: Word;
    Status: Byte;
    ProcessorUpgrade: Byte;
    L1CacheHandler: Word;
    L2CacheHandler: Word;
    L3CacheHandler: Word;
    SerialNumber: Byte;
    AssetTag: Byte;
    PartNumber: Byte;
  end;

  TCacheInfo = packed record
    Header: TSmBiosTableHeader;
    SocketDesignation: Byte;
    CacheConfiguration: DWORD;
    MaximumCacheSize: Word;
    InstalledSize: Word;
    SupportedSRAMType: Word;
    CurrentSRAMType: Word;
    CacheSpeed: Byte;
    ErrorCorrectionType: Byte;
    SystemCacheType: Byte;
    Associativity: Byte;
  end;

  TSMBiosTableEntry = record
    Header: TSmBiosTableHeader;
    Index : Integer;
  end;

  TSMBios = class
  private
    FSize: integer;
    FBuffer: PByteArray;
    FDataString: AnsiString;
    FBiosInfo: TBiosInfo;
    FSysInfo: TSysInfo;
    FBaseBoardInfo: TBaseBoardInfo;
    FEnclosureInfo: TEnclosureInfo;
    FProcessorInfo: TProcessorInfo;
    FBiosInfoIndex: Integer;
    FSysInfoIndex: Integer;
    FBaseBoardInfoIndex: Integer;
    FEnclosureInfoIndex: Integer;
    FProcessorInfoIndex: Integer;
    FDmiRevision: Integer;
    FSmbiosMajorVersion: Integer;
    FSmbiosMinorVersion: Integer;
    FSMBiosTablesList: TList;
    procedure LoadSMBIOS;
    procedure ReadSMBiosTables;
    function GetHasBiosInfo: Boolean;
    function GetHasSysInfo: Boolean;
    function GetHasBaseBoardInfo: Boolean;
    function GetHasEnclosureInfo: Boolean;
    function GetHasProcessorInfo: Boolean;
    function GetSMBiosTablesList:TList;
  public
    constructor Create;
    destructor Destroy; override;

    function SearchSMBiosTable(TableType: SMBiosTables): integer;
    function GetSMBiosTableIndex(TableType: SMBiosTables): integer;
    function GetSMBiosString(Entry, Index: integer): AnsiString;

    property Size: integer read FSize;
    property Buffer: PByteArray read FBuffer;
    property DataString: AnsiString read FDataString;
    property DmiRevision: Integer read FDmiRevision;
    property SmbiosMajorVersion : Integer read FSmbiosMajorVersion;
    property SmbiosMinorVersion : Integer read FSmbiosMinorVersion;
    property SMBiosTablesList : TList read FSMBiosTablesList;

    property BiosInfo: TBiosInfo read FBiosInfo Write FBiosInfo;
    property BiosInfoIndex: Integer read FBiosInfoIndex Write FBiosInfoIndex;
    property HasBiosInfo : Boolean read GetHasBiosInfo;
    property SysInfo: TSysInfo read FSysInfo Write FSysInfo;
    property SysInfoIndex: Integer read FSysInfoIndex Write FSysInfoIndex;
    property HasSysInfo : Boolean read GetHasSysInfo;
    property BaseBoardInfo: TBaseBoardInfo read FBaseBoardInfo write FBaseBoardInfo;
    property BaseBoardInfoIndex: Integer read FBaseBoardInfoIndex Write FBaseBoardInfoIndex;
    property HasBaseBoardInfo : Boolean read GetHasBaseBoardInfo;
    property EnclosureInfo: TEnclosureInfo read FEnclosureInfo write FEnclosureInfo;
    property EnclosureInfoIndex: Integer read FEnclosureInfoIndex Write FEnclosureInfoIndex;
    property HasEnclosureInfo : Boolean read GetHasEnclosureInfo;
    property ProcessorInfo: TProcessorInfo read FProcessorInfo write FProcessorInfo;
    property ProcessorInfoIndex: Integer read FProcessorInfoIndex Write FProcessorInfoIndex;
    property HasProcessorInfo : Boolean read GetHasProcessorInfo;
  end;

implementation

uses
  ComObj,
  ActiveX,
  Variants;

{ TSMBios }
constructor TSMBios.Create;
begin
  Inherited;
  FBuffer := nil;
  FSMBiosTablesList:=nil;
  LoadSMBIOS;
  ReadSMBiosTables;
end;

destructor TSMBios.Destroy;
begin
  if Assigned(FBuffer) and (FSize > 0) then
    FreeMem(FBuffer);

  if Assigned(FSMBiosTablesList) then
    FSMBiosTablesList.Free;

  Inherited;
end;

function TSMBios.GetHasBaseBoardInfo: Boolean;
begin
  Result:=FBaseBoardInfoIndex>=0;
end;

function TSMBios.GetHasBiosInfo: Boolean;
begin
  Result:=FBiosInfoIndex>=0;
end;

function TSMBios.GetHasEnclosureInfo: Boolean;
begin
  Result:=FEnclosureInfoIndex>=0;
end;

function TSMBios.GetHasProcessorInfo: Boolean;
begin
  Result:=FProcessorInfoIndex>=0;
end;

function TSMBios.GetHasSysInfo: Boolean;
begin
  Result:=FSysInfoIndex>=0;
end;

function TSMBios.SearchSMBiosTable(TableType: SMBiosTables): integer;
Var
  Index  : integer;
  Header : TSmBiosTableHeader;
begin
  Index     := 0;
  repeat
    Move(Buffer[Index], Header, SizeOf(Header));

    if Header.TableType = Ord(TableType) then
      break
    else
    begin
       inc(Index, Header.Length);
       if Index+1>FSize then
       begin
         Index:=-1;
         Break;
       end;

      while not((Buffer[Index] = 0) and (Buffer[Index + 1] = 0)) do
       if Index+1>FSize then
       begin
         Index:=-1;
         Break;
       end
       else
       inc(Index);

       inc(Index, 2);
    end;
  until (Index>FSize);
  Result := Index;
end;

function TSMBios.GetSMBiosString(Entry, Index: integer): AnsiString;
var
  i: integer;
  p: PAnsiChar;
begin
  Result := '';
  for i := 1 to Index do
  begin
    p := PAnsiChar(@Buffer[Entry]);
    if i = Index then
    begin
      Result := p;
      break;
    end
    else
      inc(Entry, StrLen(p) + 1);
  end;
end;

function TSMBios.GetSMBiosTableIndex(TableType: SMBiosTables): integer;
Var
 Entry : TSMBiosTableEntry;
begin
 Result:=-1;
  for Entry in FSMBiosTablesList do
    if Entry.Header.TableType=Ord(TableType)  then
    begin
      Result:=Entry.Index;
      Break;
    end;
end;

function TSMBios.GetSMBiosTablesList: TList;
Var
  Index : integer;
  Header: TSmBiosTableHeader;
  Entry    : TSMBiosTableEntry;
begin
  Result    := TList.Create;
  Index     := 0;
  repeat
    Move(Buffer[Index], Header, SizeOf(Header));
    Entry.Header:=Header;
    Entry.Index:=Index;
    Result.Add(Entry);

    if Header.TableType=Ord(SMBiosTables.EndofTable) then break;

    inc(Index, Header.Length);// + 1);
    if Index+1>FSize then
      Break;

    while not((Buffer[Index] = 0) and (Buffer[Index + 1] = 0)) do
    if Index+1>FSize then
     Break
    else
     inc(Index);

    inc(Index, 2);
  until (Index>FSize);
end;

procedure TSMBios.LoadSMBIOS;
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator: OLEVariant;
  FWMIService: OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject: OLEVariant;
  oEnum: IEnumvariant;
  iValue: LongWord;
  vArray: variant;
  Value: integer;
  i: integer;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\WMI', '', '');
  FWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM MSSmBios_RawSMBiosTables', 'WQL', wbemFlagForwardOnly);
  oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumvariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    FSize := FWbemObject.Size;
    GetMem(FBuffer, FSize);

    FDmiRevision:= FWbemObject.DmiRevision;
    FSmbiosMajorVersion :=FWbemObject.SmbiosMajorVersion;
    FSmbiosMinorVersion :=FWbemObject.SmbiosMinorVersion;

    vArray := FWbemObject.SMBiosData;

    if (VarType(vArray) and VarArray) <> 0 then
      for i := VarArrayLowBound(vArray, 1) to VarArrayHighBound(vArray, 1) do
      begin
        Value := vArray[i];
        Buffer[i] := Value;
        if Value in [$20..$7E] then
          FDataString := FDataString + AnsiString(Chr(Value))
        else
          FDataString := FDataString + '.';
      end;

    FSMBiosTablesList:=GetSMBiosTablesList;
    FWbemObject := Unassigned;
  end;
end;

procedure TSMBios.ReadSMBiosTables;
begin
  FBiosInfoIndex := GetSMBiosTableIndex(BIOSInformation);
  if FBiosInfoIndex >= 0 then
    Move(Buffer[FBiosInfoIndex], FBiosInfo, SizeOf(FBiosInfo));

  FSysInfoIndex := GetSMBiosTableIndex(SystemInformation);
  if FSysInfoIndex >= 0 then
    Move(Buffer[FSysInfoIndex], FSysInfo, SizeOf(FSysInfo));

  FBaseBoardInfoIndex := GetSMBiosTableIndex(BaseBoardInformation);
  if FBaseBoardInfoIndex >= 0 then
    Move(Buffer[FBaseBoardInfoIndex], FBaseBoardInfo, SizeOf(FBaseBoardInfo));

  FEnclosureInfoIndex := GetSMBiosTableIndex(EnclosureInformation);
  if FEnclosureInfoIndex >= 0 then
    Move(Buffer[FEnclosureInfoIndex], FEnclosureInfo, SizeOf(FEnclosureInfo));

  FProcessorInfoIndex := GetSMBiosTableIndex(ProcessorInformation);
  if FProcessorInfoIndex >= 0 then
    Move(Buffer[FProcessorInfoIndex], FProcessorInfo, SizeOf(FProcessorInfo));
end;

end.

Sample project

This console application show how use this unit

{$APPTYPE CONSOLE}

uses
  Classes,
  SysUtils,
  ActiveX,
  ComObj,
  uSMBIOS in 'uSMBIOS.pas';

procedure GetMSSmBios_RawSMBiosTablesInfo;
Var
  SMBios : TSMBios;
  UUID   : Array[0..31] of Char;
  Entry  : TSMBiosTableEntry;
begin
  SMBios:=TSMBios.Create;
  try
    With SMBios do
    begin
        Writeln(Format('%d SMBios tables found',[SMBiosTablesList.Count]));
        Writeln('');

        Writeln('Type Handle Length Index');
        for Entry in SMBiosTablesList do
          Writeln(Format('%3d  %4x   %3d    %4d',[Entry.Header.TableType, Entry.Header.Handle, Entry.Header.Length, Entry.Index]));

      Readln;

      if HasBiosInfo then
      begin
        WriteLn('Bios Information');
        WriteLn('Vendor        '+GetSMBiosString(BiosInfoIndex + BiosInfo.Header.Length, BiosInfo.Vendor));
        WriteLn('Version       '+GetSMBiosString(BiosInfoIndex + BiosInfo.Header.Length, BiosInfo.Version));
        WriteLn('Start Segment '+IntToHex(BiosInfo.StartingSegment,4));
        WriteLn('ReleaseDate   '+GetSMBiosString(BiosInfoIndex + BiosInfo.Header.Length, BiosInfo.ReleaseDate));
        WriteLn(Format('Bios Rom Size %d k',[64*(BiosInfo.BiosRomSize+1)]));
        WriteLn('');
      end;

      if HasSysInfo then
      begin
        WriteLn('System Information');
        WriteLn('Manufacter    '+GetSMBiosString(SysInfoIndex + SysInfo.Header.Length, SysInfo.Manufacturer));
        WriteLn('Product Name  '+GetSMBiosString(SysInfoIndex + SysInfo.Header.Length, SysInfo.ProductName));
        WriteLn('Version       '+GetSMBiosString(SysInfoIndex + SysInfo.Header.Length, SysInfo.Version));
        WriteLn('Serial Number '+GetSMBiosString(SysInfoIndex + SysInfo.Header.Length, SysInfo.SerialNumber));
        BinToHex(@SysInfo.UUID,UUID,SizeOf(SysInfo.UUID));
        WriteLn('UUID          '+UUID);

        WriteLn('');
      end;

      if HasBaseBoardInfo then
      begin
        WriteLn('BaseBoard Information');
        WriteLn('Manufacter    '+GetSMBiosString(BaseBoardInfoIndex + BaseBoardInfo.Header.Length, BaseBoardInfo.Manufacturer));
        WriteLn('Product       '+GetSMBiosString(BaseBoardInfoIndex + BaseBoardInfo.Header.Length, BaseBoardInfo.Product));
        WriteLn('Version       '+GetSMBiosString(BaseBoardInfoIndex + BaseBoardInfo.Header.Length, BaseBoardInfo.Version));
        WriteLn('Serial Number '+GetSMBiosString(BaseBoardInfoIndex + BaseBoardInfo.Header.Length, BaseBoardInfo.SerialNumber));
        WriteLn('');
      end;

      if HasEnclosureInfo then
      begin
        WriteLn('Enclosure Information');
        WriteLn('Manufacter    '+GetSMBiosString(EnclosureInfoIndex + EnclosureInfo.Header.Length, EnclosureInfo.Manufacturer));
        WriteLn('Version       '+GetSMBiosString(EnclosureInfoIndex + EnclosureInfo.Header.Length, EnclosureInfo.Version));
        WriteLn('Serial Number '+GetSMBiosString(EnclosureInfoIndex + EnclosureInfo.Header.Length, EnclosureInfo.SerialNumber));
        WriteLn('Asset Tag Number '+GetSMBiosString(EnclosureInfoIndex + EnclosureInfo.Header.Length, EnclosureInfo.AssetTagNumber));
        WriteLn('');
      end;

      if HasProcessorInfo then
      begin
        WriteLn('Processor Information');
        WriteLn('Socket Designation     '+GetSMBiosString(ProcessorInfoIndex + ProcessorInfo.Header.Length, ProcessorInfo.SocketDesignation));
        WriteLn('Processor Manufacturer '+GetSMBiosString(ProcessorInfoIndex + ProcessorInfo.Header.Length, ProcessorInfo.ProcessorManufacturer));
        WriteLn('Serial Number          '+GetSMBiosString(ProcessorInfoIndex + ProcessorInfo.Header.Length, ProcessorInfo.SerialNumber));
        WriteLn('Asset Tag              '+GetSMBiosString(ProcessorInfoIndex + ProcessorInfo.Header.Length, ProcessorInfo.AssetTag));
        WriteLn('Part Number            '+GetSMBiosString(ProcessorInfoIndex + ProcessorInfo.Header.Length, ProcessorInfo.PartNumber));
        WriteLn('');
      end;
    end;
  finally
   SMBios.Free;
  end;
end;

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

Check these samples images of the console App.

Additional Information

Check the next resources to get more info about the SMBios


by 14 Comments

Manipulating local/remote files and folders using Delphi and WMI

Some days ago a question in stackoverflow.com was made, about how list the contents of a folder of a remote machine. I answer that question using a WMI approach mentioning the CIM_DataFile and CIM_Directory WMI Classes, these classes  can be used to retrieve information about files, folders and perform many task like copy, rename, delete and  compress.  So today I will show you how you can use these classes form Delphi.

First you must know which in order to access any file or folder  in a remote machine need not be a shared resource, only just must enable the WMI remote access in the machine to access, check these articles for more details about how enable the remote wmi access.

After of enabling the WMI remote access in the client machine you are ready to access the files and folders.

Before to begin

Now some tips which can help you to deal both classes

  1. When you make a WMI query against these classes always you must use filters (Where conditions) to restrict the result of these WMI classes.
  2. Always you must use the Drive field as condition, due to two reasons, first these classes will scan all directories on any available storage device. So this task can take some time. and second to diffentiate for example a folder called Windows located in the Drive C: and in the Drive D:.
  3. The Wmi interprets the \ (Backslash) character as a reserved symbol so you need to escape that character to avoid problems with the WQL sentence.
  4. You can use these classes to find files or folders which match with a criteria, but remember if you not specify the Path property the WMI will scan the entire drive. so try to avoid  sentences like
FWMIService.ExecQuery(Format('SELECT * FROM CIM_DataFile Where Drive="%s" AND Extension="%s"',['C:','jpg']),'WQL',wbemFlagForwardOnly);//this will return all the jpg files in the C Drive

Note :
The code showed in this article uses Late binding to access the WMI, if you want use another way to access the WMI from delphi (like direct COM access or importing th e Microsoft scripting library) take a look to the Delphi WMI Code creator.

Listing Folder and Files

//list the files and folders of a specified Path (non recursive)
procedure  ListFolderContent(Const WbemComputer,WbemUser,WbemPassword,Path:string);
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  WmiPath       : string;
  Drive         : string;
begin;
  //Extract the drive from the Path
  Drive   :=ExtractFileDrive(Path);
  //add a back slash to the end of the folder
  WmiPath :=IncludeTrailingPathDelimiter(Copy(Path,3,Length(Path)));
  //escape the folder name
  WmiPath :=StringReplace(WmiPath,'\','\\',[rfReplaceAll]);

  Writeln('Connecting');
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  //establish the connection
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);

  Writeln('Files');
  //get the files
  FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM CIM_DataFile Where Drive="%s" AND Path="%s"',[Drive,WmiPath]),'WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('%s',[FWbemObject.Name]));// String
    FWbemObject:=Unassigned;
  end;

  Writeln('Folders');
  //get the folders
  FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM CIM_Directory Where Drive="%s" AND Path="%s"',[Drive,WmiPath]),'WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('%s',[FWbemObject.Name]));// String
    FWbemObject:=Unassigned;
  end;
end;

How to use

begin
 try
    CoInitialize(nil);
    try
      //ListFolderContent('.','','','C:\data'); //get the content of the folder Data in he local machine
      ListFolderContent('remotemachine','user_name','password','C:\Data');
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Get info about a particular file or folder


This code will list the type, size, creation date, attributes, etc. of any file which you pass as parameter

procedure  GetCIM_DataFileInfo(const FileName:string);
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Writeln(Format('AccessMask               %s',[FWbemObject.AccessMask]));// Uint32
  Writeln(Format('Archive                  %s',[FWbemObject.Archive]));// Boolean
  Writeln(Format('Caption                  %s',[FWbemObject.Caption]));// String
  Writeln(Format('Compressed               %s',[FWbemObject.Compressed]));// Boolean
  Writeln(Format('CompressionMethod        %s',[FWbemObject.CompressionMethod]));// String
  Writeln(Format('CreationClassName        %s',[FWbemObject.CreationClassName]));// String
  Writeln(Format('CreationDate             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.CreationDate))]));// Datetime
  Writeln(Format('CSCreationClassName      %s',[FWbemObject.CSCreationClassName]));// String
  Writeln(Format('CSName                   %s',[FWbemObject.CSName]));// String
  Writeln(Format('Description              %s',[FWbemObject.Description]));// String
  Writeln(Format('Drive                    %s',[FWbemObject.Drive]));// String
  Writeln(Format('EightDotThreeFileName    %s',[FWbemObject.EightDotThreeFileName]));// String
  Writeln(Format('Encrypted                %s',[FWbemObject.Encrypted]));// Boolean
  Writeln(Format('EncryptionMethod         %s',[FWbemObject.EncryptionMethod]));// String
  Writeln(Format('Extension                %s',[FWbemObject.Extension]));// String
  Writeln(Format('FileName                 %s',[FWbemObject.FileName]));// String
  Writeln(Format('FileSize                 %s',[FWbemObject.FileSize]));// Uint64
  Writeln(Format('FileType                 %s',[FWbemObject.FileType]));// String
  Writeln(Format('FSCreationClassName      %s',[FWbemObject.FSCreationClassName]));// String
  Writeln(Format('FSName                   %s',[FWbemObject.FSName]));// String
  Writeln(Format('Hidden                   %s',[FWbemObject.Hidden]));// Boolean
  Writeln(Format('InstallDate              %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.InstallDate))]));// Datetime
  Writeln(Format('InUseCount               %s',[FWbemObject.InUseCount]));// Uint64
  Writeln(Format('LastAccessed             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.LastAccessed))]));// Datetime
  Writeln(Format('LastModified             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.LastModified))]));// Datetime
  Writeln(Format('Manufacturer             %s',[FWbemObject.Manufacturer]));// String
  Writeln(Format('Name                     %s',[FWbemObject.Name]));// String
  Writeln(Format('Path                     %s',[FWbemObject.Path]));// String
  Writeln(Format('Readable                 %s',[FWbemObject.Readable]));// Boolean
  Writeln(Format('Status                   %s',[FWbemObject.Status]));// String
  Writeln(Format('System                   %s',[FWbemObject.System]));// Boolean
  Writeln(Format('Version                  %s',[FWbemObject.Version]));// String
  Writeln(Format('Writeable                %s',[FWbemObject.Writeable]));// Boolean
  Writeln('');
end;

In the above code you note two things, first I’m using the SWbemServices.Get method instead SWbemServices.ExecQuery this is because the Get function retrieve a single instance of the wmi object path passed as parameter  (the wmi object path is a string that uniquely identifies a instances of a class). The second
which you must note is the WbemTimeToDateTime  function, this is a helper function to convert the returned WMI datetime values in UTC format to TDateTime.

This is the code of that function, for more info check the documentation about the WbemScripting.SWbemDateTime object.

function WbemTimeToDateTime(const V : OleVariant): TDateTime;
var
  Dt : OleVariant;
begin
  Result:=0;
  if VarIsNull(V) then exit;
  Dt:=CreateOleObject('WbemScripting.SWbemDateTime');
  Dt.Value := V;
  Result:=Dt.GetVarDate;
end;

This code will list the size, creation date, atributes, etc. of any folder which you pass as parameter

procedure  GetCIM_DirectoryInfo(const FolderName:string);
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  Writeln(Format('AccessMask               %s',[FWbemObject.AccessMask]));// Uint32
  Writeln(Format('Archive                  %s',[FWbemObject.Archive]));// Boolean
  Writeln(Format('Caption                  %s',[FWbemObject.Caption]));// String
  Writeln(Format('Compressed               %s',[FWbemObject.Compressed]));// Boolean
  Writeln(Format('CompressionMethod        %s',[FWbemObject.CompressionMethod]));// String
  Writeln(Format('CreationClassName        %s',[FWbemObject.CreationClassName]));// String
  Writeln(Format('CreationDate             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.CreationDate))]));// Datetime
  Writeln(Format('CSCreationClassName      %s',[FWbemObject.CSCreationClassName]));// String
  Writeln(Format('CSName                   %s',[FWbemObject.CSName]));// String
  Writeln(Format('Description              %s',[FWbemObject.Description]));// String
  Writeln(Format('Drive                    %s',[FWbemObject.Drive]));// String
  Writeln(Format('EightDotThreeFileName    %s',[FWbemObject.EightDotThreeFileName]));// String
  Writeln(Format('Encrypted                %s',[FWbemObject.Encrypted]));// Boolean
  Writeln(Format('EncryptionMethod         %s',[FWbemObject.EncryptionMethod]));// String
  Writeln(Format('Extension                %s',[FWbemObject.Extension]));// String
  Writeln(Format('FileName                 %s',[FWbemObject.FileName]));// String
  Writeln(Format('FileSize                 %s',[FWbemObject.FileSize]));// Uint64
  Writeln(Format('FileType                 %s',[FWbemObject.FileType]));// String
  Writeln(Format('FSCreationClassName      %s',[FWbemObject.FSCreationClassName]));// String
  Writeln(Format('FSName                   %s',[FWbemObject.FSName]));// String
  Writeln(Format('Hidden                   %s',[FWbemObject.Hidden]));// Boolean
  Writeln(Format('InstallDate              %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.InstallDate))]));// Datetime
  Writeln(Format('InUseCount               %s',[FWbemObject.InUseCount]));// Uint64
  Writeln(Format('LastAccessed             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.LastAccessed))]));// Datetime
  Writeln(Format('LastModified             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.LastModified))]));// Datetime
  Writeln(Format('Name                     %s',[FWbemObject.Name]));// String
  Writeln(Format('Path                     %s',[FWbemObject.Path]));// String
  Writeln(Format('Readable                 %s',[FWbemObject.Readable]));// Boolean
  Writeln(Format('Status                   %s',[FWbemObject.Status]));// String
  Writeln(Format('System                   %s',[FWbemObject.System]));// Boolean
  Writeln(Format('Writeable                %s',[FWbemObject.Writeable]));// Boolean
  Writeln('');
end;

Compress a File or Folder using the NTFS compression

function  CompressFile(const FileName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Compress();
end;

function  CompressFolder(const FolderName:string;Recursive:Boolean):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
  StopFileName  : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  if Recursive then
   Result:=FWbemObject.CompressEx(StopFileName, Null, Recursive)
  else
   Result:=FWbemObject.Compress();
end;

UnCompress a File or Folder using the NTFS compression

function  UnCompressFile(const FileName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.UnCompress();
end;

function  UnCompressFolder(const FolderName:string;Recursive:Boolean):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
  StopFileName  : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  if Recursive then
   Result:=FWbemObject.UnCompressEx(StopFileName, Variants.Null, Recursive)
  else
   Result:=FWbemObject.UnCompress();
end;

Copy a single File or Folder

function  CopyFile(const SourceFileName,DestFileName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(SourceFileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Copy(DestFileName);
end;

function  CopyFolder(const SourceFolder,DestFolder:string;Recursive:Boolean):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
  StopFileName  : OleVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(SourceFolder,'\','\\',[rfReplaceAll])]));
  if Recursive then
    Result:=FWbemObject.CopyEx(DestFolder,StopFileName, Variants.Null, Recursive)
  else
    Result:=FWbemObject.Copy(DestFolder);
end;

Delete a File or Folder

function  DeleteFile(const FileName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Delete();
end;

//remove all the contents of the folder recursivily
function  DeleteFolder(const FolderName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Delete();
end;

Rename a File or Folder

function RenameFile(const OldName, NewName: string): Integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(OldName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Rename(NewName);
end;

function RenameFolder(const OldName, NewName: string): Integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(OldName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Rename(NewName);
end;

Getting the permissions over a CIM_DataFile or CIM_Directory object

In order to get whether the caller has the permissions on the CIM_DataFile or CIM_Directory object you must use the GetEffectivePermission function with these flags

Value (Dec/Hex) Meaning
FILE_READ_DATA (file)FILE_LIST_DIRECTORY (directory)
1 (0x1)
 Grants the right to read data from the file. For a directory, this value grants the right to list the contents of the directory.
FILE_WRITE_DATA (file)FILE_ADD_FILE (directory)
2 (0x2)
 Grants the right to write data to the file. For a directory, this value grants the right to create a file in the directory.
FILE_APPEND_DATA (file)FILE_ADD_SUBDIRECTORY (directory)
4 (0x4)
 Grants the right to append data to the file. For a directory, this value grants the right to create a subdirectory.
FILE_READ_EA
8 (0x8)
 Grants the right to read extended attributes.
FILE_WRITE_EA
16 (0x10)
 Grants the right to write extended attributes.
FILE_EXECUTE (file)FILE_TRAVERSE (directory)
32 (0x20)
 Grants the right to execute a file. For a directory, the directory can be traversed.
FILE_DELETE_CHILD (directory)
64 (0x40)
 Grants the right to delete a directory and all the files it contains, even if the files are read-only.
FILE_READ_ATTRIBUTES
128 (0x80)
 Grants the right to read file attributes.
FILE_WRITE_ATTRIBUTES
256 (0x100)
 Grants the right to change file attributes.
DELETE
65536 (0x10000)
 Grants delete access.
READ_CONTROL
131072 (0x20000)
 Grants read access to the security descriptor and owner.
WRITE_DAC
262144 (0x40000)
 Grants write access to the discretionary ACL.
WRITE_OWNER
524288 (0x80000)
 Assigns the write owner.
SYNCHRONIZE
1048576 (0x100000)
 Synchronizes access and allows a process to wait for an object to enter the signaled state. 
function GetEffectivePermission(const FileName:string;Flags:integer):Boolean;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.GetEffectivePermission(Flags);
end;

And use like this

GetEffectivePermission('C:\FooFolder\Foo_Filename.ext',FILE_READ_DATA or FILE_READ_ATTRIBUTES);

Getting the Status of a task

The functions Compress, UnCompress, Copy, Rename and Delete return a Result code which can be translated to a message using this function

function GetResultMessage(ResultCode:Integer) : string;
begin
  case ResultCode of
     0 : Result:='Success';
     2 : Result:='Access denied';
     8 : Result:='Unspecified failure';
     9 : Result:='Invalid object';
    10 : Result:='Object already exists';
    11 : Result:='File system not NTFS';
    12 : Result:='Platform not Windows NT or Windows 2000';
    13 : Result:='Drive not the same';
    14 : Result:='Directory not empty';
    15 : Result:='Sharing violation';
    16 : Result:='Invalid start file';
    17 : Result:='Privilege not held';
    21 : Result:='Invalid parameter'
  else
    Result := 'Unknown';
  end;
end;

Demo Application

Check this demo application which can list all the files and folders in a remote or local machine only using the WMI

checkout the full source code on Github.