This entry is just for announce which the Delphi IDE Theme Editor now supports RAD Studio XE4.
Added support to TSMBIOS for SMBIOS 2.8 spec.
A few weeks ago (3 Apr 2013) a new update to the System Management BIOS (SMBIOS) Reference Specification was introduced by the DMTF. So the TSMBIOS project was updated to support the SMBIOS 2.8.
The following changes was added to the 2.8 version:
- Processor Information (Type 4):
- SMBIOSCR00106: processor family name correction (48h)
- SMBIOSCR00107: new processor family types
- SMBIOSCR00108: new processor family type
- SMBIOSCR00110: correct typo in table 24 (processor upgrade)
- SMBIOSCR00118: new processor family types
- SMBIOSCR00121: new processor family type
- SMBIOSCR00122: new processor upgrade type
- SMBIOSCR00125: add new Intel socket type
- Memory Device (Type 17):
- SMBIOSCR00109: add minimum, maximum and configured voltages
- SMBIOSCR00114: add LRDIMM to memory device list
- Other:
- SMBIOSCR00116: correct/clarify structure length fields
- SMBIOSCR00120: add new supported processor architectures
- SMBIOSCR00123: update referenced specifications
- Wording updates for clarity and consistency
Getting Processor Info using Object Pascal (Delphi / FPC) and the TSMBIOS
The SMBIOS expose the info about the installed processors in the table type 4. Check the next snippet that shows how obtain such data using the TSMBIOS (remember, if you are using FPC, you can use this library in Windows and Linux).
{$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;
Vcl Styles Utils updated to fix QC #114040, #114032 (XE2 and XE3)
I just commit in the Vcl Styles Project two new fixes to patch the QC 114040 and QC 114032 (these issues exist in Delphi XE2 and XE3), both reports are related to the Highlight colors used to draw the TColorBox and TComboBoxEx components when the Vcl Styles are active.
QC 114032
As you can see in the below image the TColorBox component doesn’t use the proper highlight color, but the TColorListBox uses the highlight color of the current Vcl Style.
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.
Getting Memory Device Info using Object Pascal (Delphi / FPC) and the TSMBIOS
If you need to know what type of RAM is installed in your system or how is the manufacturer of your memory device, you can try reading the SPD (Serial presence detect) info directly (but not all the memory devices exposes the SPD info and reading the SPD require Kernel Mode access) , use the Win32_PhysicalMemory WMI class (but depending of the manufacturer the WMI fails to get info about some memory properties like the memory type) or using the SMBIOS.
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 :)
Added new vcl style hook to the Vcl Styles Utils to fix QC #108678, #108875 (XE2 and XE3)
I just added a new vcl style hook (TListViewStyleHookFix) for the TListView component in the Vcl Styles Utils project to fix the QC #108678, #108875 (XE2 and XE3)
The issue reported in both reports, is that the images are not displayed in the TListView header with the VCL Styles enabled.
When you uses the Windows Theme in a TListView with images in the header will look like so
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);
How distinguish when Windows was installed in Legacy BIOS or UEFI mode using Delphi?
As part of the TSMBIOS project, I needed a method to distinguish when Windows was installed in Legacy BIOS or UEFI mode. The solution was provided by the GetFirmwareEnvironmentVariable function.
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.









