Installer of the Delphi IDE Theme Editor

The following changes was added to the 2.8 version:

• Processor Information (Type 4):

1. SMBIOSCR00106: processor family name correction (48h)
2. SMBIOSCR00107: new processor family types
3. SMBIOSCR00108: new processor family type
4. SMBIOSCR00110: correct typo in table 24 (processor upgrade)
5. SMBIOSCR00118: new processor family types
6. SMBIOSCR00121: new processor family type
7. SMBIOSCR00122: new processor upgrade type
8. SMBIOSCR00125: add new Intel socket type

• Memory Device (Type 17):

1. SMBIOSCR00109: add minimum, maximum and configured voltages
2. SMBIOSCR00114: add LRDIMM to memory device list

• Other:

1. SMBIOSCR00116: correct/clarify structure length fields
2. SMBIOSCR00120: add new supported processor architectures
3. SMBIOSCR00123: update referenced specifications
4. Wording updates for clarity and consistency

{$IFDEF FPC}{$mode objfpc}{$H+}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}

uses
  Classes,
  TypInfo,
  SysUtils,
  uSMBIOS;

function SetToString(Info: PTypeInfo; const Value): String;
var
  LTypeInfo  : PTypeInfo;
  LIntegerSet: TIntegerSet;
  I: Integer;

begin
  Result := '';

    Integer(LIntegerSet) := 0;
    case GetTypeData(Info)^.OrdType of
      otSByte, otUByte: Integer(LIntegerSet)  := Byte(Value);
      otSWord, otUWord: Integer(LIntegerSet)  := Word(Value);
      otSLong, otULong: Integer(LIntegerSet)  := Integer(Value);
    end;

  LTypeInfo  := GetTypeData(Info)^.CompType{$IFNDEF FPC}^{$ENDIF};
  for I := 0 to SizeOf(Integer) * 8 - 1 do
    if I in LIntegerSet then
    begin
      if Result <> '' then Result := Result + ',';
      Result := Result + GetEnumName(LTypeInfo, I);
    end;
end;


procedure GetProcessorInfo;
Var
  SMBios             : TSMBios;
  LProcessorInfo     : TProcessorInformation;
  LSRAMTypes         : TCacheSRAMTypes;
begin
  SMBios:=TSMBios.Create;
  try
      WriteLn('Processor Information');
      if SMBios.HasProcessorInfo then
      for LProcessorInfo in SMBios.ProcessorInfo do
      begin
        WriteLn('Manufacturer       '+LProcessorInfo.ProcessorManufacturerStr);
        WriteLn('Socket Designation '+LProcessorInfo.SocketDesignationStr);
        WriteLn('Type               '+LProcessorInfo.ProcessorTypeStr);
        WriteLn('Familiy            '+LProcessorInfo.ProcessorFamilyStr);
        WriteLn('Version            '+LProcessorInfo.ProcessorVersionStr);
        WriteLn(Format('Processor ID       %x',[LProcessorInfo.RAWProcessorInformation^.ProcessorID]));
        WriteLn(Format('Voltaje            %n',[LProcessorInfo.GetProcessorVoltaje]));
        WriteLn(Format('External Clock     %d  Mhz',[LProcessorInfo.RAWProcessorInformation^.ExternalClock]));
        WriteLn(Format('Maximum processor speed %d  Mhz',[LProcessorInfo.RAWProcessorInformation^.MaxSpeed]));
        WriteLn(Format('Current processor speed %d  Mhz',[LProcessorInfo.RAWProcessorInformation^.CurrentSpeed]));
        WriteLn('Processor Upgrade   '+LProcessorInfo.ProcessorUpgradeStr);
        WriteLn(Format('External Clock     %d  Mhz',[LProcessorInfo.RAWProcessorInformation^.ExternalClock]));

        if SMBios.SmbiosVersion>='2.3' then
        begin
          WriteLn('Serial Number      '+LProcessorInfo.SerialNumberStr);
          WriteLn('Asset Tag          '+LProcessorInfo.AssetTagStr);
          WriteLn('Part Number        '+LProcessorInfo.PartNumberStr);
          if SMBios.SmbiosVersion>='2.5' then
          begin
            WriteLn(Format('Core Count         %d',[LProcessorInfo.RAWProcessorInformation^.CoreCount]));
            WriteLn(Format('Cores Enabled      %d',[LProcessorInfo.RAWProcessorInformation^.CoreEnabled]));
            WriteLn(Format('Threads Count      %d',[LProcessorInfo.RAWProcessorInformation^.ThreadCount]));
            WriteLn(Format('Processor Characteristics %.4x',[LProcessorInfo.RAWProcessorInformation^.ProcessorCharacteristics]));
          end;
        end;
        Writeln;

        if (LProcessorInfo.RAWProcessorInformation^.L1CacheHandle>0) and (LProcessorInfo.L2Chache<>nil)  then
        begin
          WriteLn('L1 Cache Handle Info');
          WriteLn('--------------------');
          WriteLn('  Socket Designation    '+LProcessorInfo.L1Chache.SocketDesignationStr);
          WriteLn(Format('  Cache Configuration   %.4x',[LProcessorInfo.L1Chache.RAWCacheInformation^.CacheConfiguration]));
          WriteLn(Format('  Maximum Cache Size    %d Kb',[LProcessorInfo.L1Chache.GetMaximumCacheSize]));
          WriteLn(Format('  Installed Cache Size  %d Kb',[LProcessorInfo.L1Chache.GetInstalledCacheSize]));
          LSRAMTypes:=LProcessorInfo.L1Chache.GetSupportedSRAMType;
          WriteLn(Format('  Supported SRAM Type   [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));
          LSRAMTypes:=LProcessorInfo.L1Chache.GetCurrentSRAMType;
          WriteLn(Format('  Current SRAM Type     [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));

          WriteLn(Format('  Error Correction Type %s',[ErrorCorrectionTypeStr[LProcessorInfo.L1Chache.GetErrorCorrectionType]]));
          WriteLn(Format('  System Cache Type     %s',[SystemCacheTypeStr[LProcessorInfo.L1Chache.GetSystemCacheType]]));
          WriteLn(Format('  Associativity         %s',[LProcessorInfo.L1Chache.AssociativityStr]));
        end;

        if (LProcessorInfo.RAWProcessorInformation^.L2CacheHandle>0)  and (LProcessorInfo.L2Chache<>nil)  then
        begin
          WriteLn('L2 Cache Handle Info');
          WriteLn('--------------------');
          WriteLn('  Socket Designation    '+LProcessorInfo.L2Chache.SocketDesignationStr);
          WriteLn(Format('  Cache Configuration   %.4x',[LProcessorInfo.L2Chache.RAWCacheInformation^.CacheConfiguration]));
          WriteLn(Format('  Maximum Cache Size    %d Kb',[LProcessorInfo.L2Chache.GetMaximumCacheSize]));
          WriteLn(Format('  Installed Cache Size  %d Kb',[LProcessorInfo.L2Chache.GetInstalledCacheSize]));
          LSRAMTypes:=LProcessorInfo.L2Chache.GetSupportedSRAMType;
          WriteLn(Format('  Supported SRAM Type   [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));
          LSRAMTypes:=LProcessorInfo.L2Chache.GetCurrentSRAMType;
          WriteLn(Format('  Current SRAM Type     [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));

          WriteLn(Format('  Error Correction Type %s',[ErrorCorrectionTypeStr[LProcessorInfo.L2Chache.GetErrorCorrectionType]]));
          WriteLn(Format('  System Cache Type     %s',[SystemCacheTypeStr[LProcessorInfo.L2Chache.GetSystemCacheType]]));
          WriteLn(Format('  Associativity         %s',[LProcessorInfo.L2Chache.AssociativityStr]));
        end;

        if (LProcessorInfo.RAWProcessorInformation^.L3CacheHandle>0) and (LProcessorInfo.L3Chache<>nil) then
        begin
          WriteLn('L3 Cache Handle Info');
          WriteLn('--------------------');
          WriteLn('  Socket Designation    '+LProcessorInfo.L3Chache.SocketDesignationStr);
          WriteLn(Format('  Cache Configuration   %.4x',[LProcessorInfo.L3Chache.RAWCacheInformation^.CacheConfiguration]));
          WriteLn(Format('  Maximum Cache Size    %d Kb',[LProcessorInfo.L3Chache.GetMaximumCacheSize]));
          WriteLn(Format('  Installed Cache Size  %d Kb',[LProcessorInfo.L3Chache.GetInstalledCacheSize]));
          LSRAMTypes:=LProcessorInfo.L3Chache.GetSupportedSRAMType;
          WriteLn(Format('  Supported SRAM Type   [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));
          LSRAMTypes:=LProcessorInfo.L3Chache.GetCurrentSRAMType;
          WriteLn(Format('  Current SRAM Type     [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));

          WriteLn(Format('  Error Correction Type %s',[ErrorCorrectionTypeStr[LProcessorInfo.L3Chache.GetErrorCorrectionType]]));
          WriteLn(Format('  System Cache Type     %s',[SystemCacheTypeStr[LProcessorInfo.L3Chache.GetSystemCacheType]]));
          WriteLn(Format('  Associativity         %s',[LProcessorInfo.L3Chache.AssociativityStr]));
        end;

        Readln;
      end
      else
      Writeln('No Processor Info was found');
  finally
   SMBios.Free;
  end;
end;        

QC 114032

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

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

QC 114040

The TComboBoxEx control have a similar issue.

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

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

Using the SMBIOS you can get most of the info related to the memory devices installed like manufacturer, type, speed, serial number and so on. The next snippet show how using the TSMBIOS and Delphi (or FPC) you can retrieve such data.

{$IFDEF FPC}{$mode objfpc}{$H+}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}

uses
  Classes,
  SysUtils,
  uSMBIOS;

procedure GetMemoryDeviceInfo;
Var
  SMBios : TSMBios;
  LMemoryDevice  : TMemoryDeviceInformation;
begin
  SMBios:=TSMBios.Create;
  try
      WriteLn('Memory Device Information');
      WriteLn('-------------------------');

      if SMBios.HasMemoryDeviceInfo then
      for LMemoryDevice in SMBios.MemoryDeviceInformation do
      begin
        WriteLn(Format('Total Width    %d bits',[LMemoryDevice.RAWMemoryDeviceInfo^.TotalWidth]));
        WriteLn(Format('Data Width     %d bits',[LMemoryDevice.RAWMemoryDeviceInfo^.DataWidth]));
        WriteLn(Format('Size           %d Mbytes',[LMemoryDevice.GetSize]));
        WriteLn(Format('Form Factor    %s',[LMemoryDevice.GetFormFactor]));
        WriteLn(Format('Device Locator %s',[LMemoryDevice.GetDeviceLocatorStr]));
        WriteLn(Format('Bank Locator   %s',[LMemoryDevice.GetBankLocatorStr]));
        WriteLn(Format('Memory Type    %s',[LMemoryDevice.GetMemoryTypeStr]));
        WriteLn(Format('Speed          %d MHz',[LMemoryDevice.RAWMemoryDeviceInfo^.Speed]));
        WriteLn(Format('Manufacturer   %s',[LMemoryDevice.ManufacturerStr]));
        WriteLn(Format('Serial Number  %s',[LMemoryDevice.SerialNumberStr]));
        WriteLn(Format('Asset Tag      %s',[LMemoryDevice.AssetTagStr]));
        WriteLn(Format('Part Number    %s',[LMemoryDevice.PartNumberStr]));

        WriteLn;

        if LMemoryDevice.RAWMemoryDeviceInfo^.PhysicalMemoryArrayHandle>0 then
        begin
          WriteLn('  Physical Memory Array');
          WriteLn('  ---------------------');
          WriteLn('  Location         '+LMemoryDevice.PhysicalMemoryArray.GetLocationStr);
          WriteLn('  Use              '+LMemoryDevice.PhysicalMemoryArray.GetUseStr);
          WriteLn('  Error Correction '+LMemoryDevice.PhysicalMemoryArray.GetErrorCorrectionStr);
          if LMemoryDevice.PhysicalMemoryArray.RAWPhysicalMemoryArrayInformation^.MaximumCapacity<>$80000000 then
            WriteLn(Format('  Maximum Capacity %d Kb',[LMemoryDevice.PhysicalMemoryArray.RAWPhysicalMemoryArrayInformation^.MaximumCapacity]))
          else
            WriteLn(Format('  Maximum Capacity %d bytes',[LMemoryDevice.PhysicalMemoryArray.RAWPhysicalMemoryArrayInformation^.ExtendedMaximumCapacity]));

          WriteLn(Format('  Memory devices   %d',[LMemoryDevice.PhysicalMemoryArray.RAWPhysicalMemoryArrayInformation^.NumberofMemoryDevices]));
        end;
        WriteLn;
      end
      else
      Writeln('No Memory Device Info was found');
  finally
   SMBios.Free;
  end;
end;

begin
 try
    GetMemoryDeviceInfo;
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Note: Remember if you uses FPC, you can use this library in linux as well :)

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

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

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

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

This is part of the code with the bug

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

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

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

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

The msdn documentation states

Firmware variables are not supported on a legacy BIOS-based system. The GetFirmwareEnvironmentVariable function will always fail on a legacy BIOS-based system, or if Windows was installed using legacy BIOS on a system that supports both legacy BIOS and UEFI. To identify these conditions, call the function with a dummy firmware environment name such as an empty string (“”) for the lpName parameter and a dummy GUID such as “{00000000-0000-0000-0000-000000000000}” for the lpGuid parameter. On a legacy BIOS-based system, or on a system that supports both legacy BIOS and UEFI where Windows was installed using legacy BIOS, the function will fail with ERROR_INVALID_FUNCTION. On a UEFI-based system, the function will fail with an error specific to the firmware, such as ERROR_NOACCESS, to indicate that the dummy GUID namespace does not exist.
.

So the Delphi code to detect such condition will be something like so

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils;

function GetFirmwareEnvironmentVariableA(lpName, lpGuid: LPCSTR; pBuffer: Pointer;
  nSize: DWORD): DWORD; stdcall; external kernel32 name 'GetFirmwareEnvironmentVariableA';

begin
  try
    GetFirmwareEnvironmentVariableA('','{00000000-0000-0000-0000-000000000000}', nil,0);
    if (GetLastError = ERROR_INVALID_FUNCTION) then
      Writeln('Legacy BIOS')
    else
      Writeln('UEFI Boot Mode');
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

Note : The TSMBIOS read the SMBIOS info using the /dev/mem device file  which provides access to system physical memory, so the code must be executed using a user with the proper permissions.

What is the SMBIOS?

SMBIOS stands for System Management BIOS , this standard is tightly related and developed by the DMTF (Desktop Management Task Force).

The SMBIOS contains a description of the system’s hardware components, the information stored in the SMBIOS typically includes system manufacturer, model name, serial numbers, BIOS version, asset tag, processors, ports, device memory installed and so on.

Note : The amount and accuracy of the SMBIOS information depends on the computer manufacturer.

Which are the advantages of use the SMBIOS?

• You can retrieve the information without having to probe for the actual hardware. this is a good point in terms of speed and safeness.
• The SMBIOS information is very well documented.
• You can avoid the use of undocumented functions to get hardware info (for example the RAM type and manufacturer).
• Useful for create a Hardware ID (machine fingerprint).

How it works?

The BIOS typically populates the SMBIOS structures at system boot time, and is not in control when the OS is running. Therefore, dynamically changing data is rarely represented in SMBIOS tables.

The SMBIOS Entry Point is located somewhere between the addresses 0xF0000 and 0xFFFFF, in early Windows systems (Win95, Win98) it was possible access this space address directly, but after with the introduction of the NT Systems and the new security changes the BIOS was accessible through section \Device\PhysicalMemory, but this last method was disabled as well in Windows Server 2003 Service Pack 1, and replaced with 2 new WinApi functions the EnumSystemFirmwareTables and GetSystemFirmwareTable, Additionally  the WMI supports reading the entire contents of SMBIOS data i using the MSSMBios_RawSMBiosTables class inside of the root\wmi namespace.

Note : you can find more information about the SMBIOS Support in Windows on this link.

The TSMBIOS can be compiled using a WinApi mode (uses the GetSystemFirmwareTable function) or using the WMI Mode (uses the MSSMBios_RawSMBiosTables class)

If you uses the WinApi Mode you  don’t need use COM and the final size of the Application will be smaller, but the WinAPI functions was introduced in Windows Vista and Windows XP x64 (So in Windows Xp x86 will fail). Otherwise using the WMI mode you will need use COM (CoInitialize and CoUninitialize), but also you will get two additional advantages 1) The WMI will work even in Windows Xp x86 systems, 2) You can read then SMBIOS data of local and remote computers.

In order to use the TSMBIOS in your application only you must add the uSMBIOS unit to your uses clause, then create a instance for the TSMBios class using the proper constructor

// Default constructor, used for populate the TSMBIOS class  using the current mode selected (WMI or WinApi)
constructor Create; overload;
// Use this constructor to load the SMBIOS data from a previously saved file.
constructor Create(const FileName : string); overload;
{$IFDEF USEWMI}
// Use this constructor to read the SMBIOS from a remote machine.
constructor Create(const RemoteMachine, UserName, Password : string); overload;
{$ENDIF}

and finally use the property which expose the SMBIOS info which you need. In this case as is show in the sample code the BatteryInformation property is used to get all the info of the batteries installed on the system.

{$APPTYPE CONSOLE}

uses
  Classes,
  SysUtils,
  uSMBIOS in '..\..\Common\uSMBIOS.pas';

procedure GetBatteryInfo;
Var
  SMBios : TSMBios;
  LBatteryInfo  : TBatteryInformation;
begin
  SMBios:=TSMBios.Create;
  try
      WriteLn('Battery Information');
      WriteLn('-------------------');
      if SMBios.HasBatteryInfo then
      for LBatteryInfo in SMBios.BatteryInformation do
      begin
        WriteLn('Location           '+LBatteryInfo.GetLocationStr);
        WriteLn('Manufacturer       '+LBatteryInfo.GetManufacturerStr);
        WriteLn('Manufacturer Date  '+LBatteryInfo.GetManufacturerDateStr);
        WriteLn('Serial Number      '+LBatteryInfo.GetSerialNumberStr);
        WriteLn('Device Name        '+LBatteryInfo.GetDeviceNameStr);
        WriteLn('Device Chemistry   '+LBatteryInfo.GetDeviceChemistry);
        WriteLn(Format('Design Capacity    %d mWatt/hours',[LBatteryInfo.RAWBatteryInfo.DesignCapacity*LBatteryInfo.RAWBatteryInfo.DesignCapacityMultiplier]));
        WriteLn(Format('Design Voltage     %d mVolts',[LBatteryInfo.RAWBatteryInfo.DesignVoltage]));
        WriteLn('SBDS Version Number  '+LBatteryInfo.GetSBDSVersionNumberStr);
        WriteLn(Format('Maximum Error in Battery Data %d%%',[LBatteryInfo.RAWBatteryInfo.MaximumErrorInBatteryData]));
        WriteLn(Format('SBDS Version Number           %.4x',[LBatteryInfo.RAWBatteryInfo.SBDSSerialNumber]));
        WriteLn('SBDS Manufacture Date  '+LBatteryInfo.GetSBDSManufactureDateStr);
        WriteLn('SBDS Device Chemistry  '+LBatteryInfo.GetSBDSDeviceChemistryStr);
        WriteLn(Format('OEM Specific                  %.8x',[LBatteryInfo.RAWBatteryInfo.OEM_Specific]));
        WriteLn;
      end
      else
      Writeln('No Battery Info was found');
  finally
   SMBios.Free;
  end;
end;

begin
 try
    GetBatteryInfo;
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

TSMBIOS Features

• Source Full documented compatible with the help insight feature, available since Delphi 2005.
• Supports SMBIOS Version from 2.1 to 2.7.1
• Supports Delphi 5, 6, 7, 2005, BDS/Turbo 2006 and RAD Studio 2007, 2009, 2010, XE, XE2, XE3, XE4.
• Compatible with FPC 2.6.0 (Windows and Linux)
• SMBIOS Data can be obtained using WinApi, WMI or loading a saved SMBIOS dump
• SMBIOS Data can be saved and load to a file
• SMBIOS Data can be obtained from remote machines

SMBIOS Tables supported

• BIOS Information (Type 0)
• System Information (Type 1)
• Baseboard (or Module) Information (Type 2)
• System Enclosure or Chassis (Type 3)
• Processor Information (Type 4)
• Cache Information (Type 7)
• Port Connector Information (Type 8)
• System Slots (Type 9)
• OEM Strings (Type 11)
• System Configuration Options (Type 12)
• BIOS Language Information (Type 13)
• Physical Memory Array (Type 16)
• Memory Device (Type 17)
• Memory Array Mapped Address (Type 19)
• Memory Device Mapped Address (Type 20)
• Built-in Pointing Device (Type 21)
• Portable Battery (Type 22)
• Voltage Probe (Type 26)
• Cooling Device (Type 27)
• Temperature Probe (Type 28)
• Electrical Current Probe (Type 29)

The TSMBIOS is a Open Source project is hosted in the code google site.