The Road to Delphi – a Blog about programming

Delphi – Free Pascal – Oxygene


1 Comment

Change the drive letter using WMI and Delphi

Today i will show a short snippet to change the letter from a drive (Volume) using the WMI. the key is use the Win32_Volume class and set the value of the DriveLetter property. this property is read/write so we can update directly the value and then call the Put_ method of the SWbemObject object.

check this sample project

program ChangeVolumeLetter_WMI;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj;

procedure  ChangeDriveLetter(OldDrive,NewDrive:Char);
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(Format('SELECT * FROM Win32_Volume Where DriveLetter=%s',[QuotedStr(OldDrive+':')]),'WQL',0);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    //Assign the New letter
    FWbemObject.DriveLetter:=NewDrive+':';
    //Apply the changes
    FWbemObject.Put_();
  end;
end;

begin
 try
    CoInitialize(nil);
    try
      //This will change the letter of the drive E to Z
      ChangeDriveLetter('E','Z');
      Readln;
    finally
      CoUninitialize;
    end;
 except
    on E:Exception do
    begin
        Writeln(E.Classname, ':', E.Message);
        Readln;
    end;
  end;
end.


15 Comments

Getting the installed Antivirus, AntiSpyware and Firewall software using Delphi and the WMI

The WMI allow you to get the installed Antivirus, AntiSpyware and Firewall (third party)  software using the root\SecurityCenter or the root\SecurityCenter2 namespaces and the AntiVirusProduct , AntiSpywareProduct, FirewallProduct classes.

First you must know which these classes and namespaces are not documented by Microsoft and only are supported in Windows Desktops editions (Windows XP, Windows Vista and Windows 7).
Now depending of the Windows version the properties retrieved by the the same class can change. this is a summary of the classes and properties availables depending of the windows version

Windows XP

Namespace : SecurityCenter
Classes availables: AntiVirusProduct, FirewallProduct

AntiVirusProduct-Properties

  • companyName
  • displayName
  • enableOnAccessUIMd5Hash
  • enableOnAccessUIParameters
  • instanceGuid
  • onAccessScanningEnabled
  • pathToEnableOnAccessUI
  • pathToUpdateUI
  • productUptoDate
  • updateUIMd5Hash
  • updateUIParameters
  • versionNumber

FirewallProduct-Properties

  • companyName
  • displayName
  • enabled
  • enableUIMd5Hash
  • enableUIParameters
  • instanceGuid
  • pathToEnableUI
  • versionNumber

Windows Vista and Windows 7

Namespace : SecurityCenter2
Classes availables : AntiVirusProduct, AntiSpywareProduct, FirewallProduct

AntiVirusProduct, AntiSpywareProduct, FirewallProduct – Properties

  • displayName
  • instanceGuid
  • pathToSignedProductExe
  • pathToSignedReportingExe
  • productState

This is a sample project which determine the Antivirus, AntiSpyware and Firewall software installed in the system.

program GetSecurityCenterInfo;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows,
  ActiveX,
  ComObj,
  Variants;

type
  TSecurityCenterProduct = (AntiVirusProduct,AntiSpywareProduct,FirewallProduct);
const
  WmiRoot='root';
  WmiClassSCProduct     : array [TSecurityCenterProduct] of string = ('AntiVirusProduct','AntiSpywareProduct','FirewallProduct');
  WmiNamespaceSCProduct : array [Boolean] of string = ('SecurityCenter','SecurityCenter2');

function VerSetConditionMask(dwlConditionMask: int64;dwTypeBitMask: DWORD; dwConditionMask: Byte): int64; stdcall; external kernel32;

{$IFDEF UNICODE}
function VerifyVersionInfo(var LPOSVERSIONINFOEX : OSVERSIONINFOEX;dwTypeMask: DWORD;dwlConditionMask: int64): BOOL; stdcall; external kernel32 name 'VerifyVersionInfoW';
{$ELSE}
function VerifyVersionInfo(var LPOSVERSIONINFOEX : OSVERSIONINFOEX;dwTypeMask: DWORD;dwlConditionMask: int64): BOOL; stdcall; external kernel32 name 'VerifyVersionInfoA';
{$ENDIF}

//verifies that the application is running on Windows 2000 Server or a later server, such as Windows Server 2003 or Windows Server 2008.
function Is_Win_Server : Boolean;
const
   VER_NT_SERVER      = $0000003;
   VER_EQUAL          = 1;
   VER_GREATER_EQUAL  = 3;
var
   osvi             : OSVERSIONINFOEX;
   dwlConditionMask : DWORDLONG;
   op               : Integer;
begin
   dwlConditionMask := 0;
   op:=VER_GREATER_EQUAL;

   ZeroMemory(@osvi, sizeof(OSVERSIONINFOEX));
   osvi.dwOSVersionInfoSize := sizeof(OSVERSIONINFOEX);
   osvi.dwMajorVersion := 5;
   osvi.dwMinorVersion := 0;
   osvi.wServicePackMajor := 0;
   osvi.wServicePackMinor := 0;
   osvi.wProductType := VER_NT_SERVER;

   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_MAJORVERSION, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_MINORVERSION, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_SERVICEPACKMAJOR, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_SERVICEPACKMINOR, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_PRODUCT_TYPE, VER_EQUAL );

   Result:=VerifyVersionInfo(osvi,VER_MAJORVERSION OR VER_MINORVERSION OR
      VER_SERVICEPACKMAJOR OR VER_SERVICEPACKMINOR OR VER_PRODUCT_TYPE, dwlConditionMask);
end;

procedure  GetSCProductInfo(SCProduct:TSecurityCenterProduct);
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  osVerInfo     : TOSVersionInfo;
begin
  osVerInfo.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
  GetVersionEx(osVerInfo);
  if (SCProduct=AntiSpywareProduct) and (osVerInfo.dwMajorVersion<6)  then exit;   FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');   FWMIService   := FSWbemLocator.ConnectServer('localhost',Format('%s\%s',[WmiRoot,WmiNamespaceSCProduct[osVerInfo.dwMajorVersion>=6]]), '', '');
  FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM %s',[WmiClassSCProduct[SCProduct]]),'WQL',0);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    if osVerInfo.dwMajorVersion>=6 then  //windows vista or newer
    begin
      Writeln(Format('displayName                    %s',[FWbemObject.displayName]));// String
      Writeln(Format('instanceGuid                   %s',[FWbemObject.instanceGuid]));// String
      Writeln(Format('pathToSignedProductExe         %s',[FWbemObject.pathToSignedProductExe]));// String
      Writeln(Format('pathToSignedReportingExe       %s',[FWbemObject.pathToSignedReportingExe]));// String
      Writeln(Format('productState                   %s',[FWbemObject.productState]));// Uint32
    end
    else
    begin
     case SCProduct of

        AntiVirusProduct :
         begin
            Writeln(Format('companyName                    %s',[FWbemObject.companyName]));// String
            Writeln(Format('displayName                    %s',[FWbemObject.displayName]));// String
            Writeln(Format('enableOnAccessUIMd5Hash        %s',[FWbemObject.enableOnAccessUIMd5Hash]));// Uint8
            Writeln(Format('enableOnAccessUIParameters     %s',[FWbemObject.enableOnAccessUIParameters]));// String
            Writeln(Format('instanceGuid                   %s',[FWbemObject.instanceGuid]));// String
            Writeln(Format('onAccessScanningEnabled        %s',[FWbemObject.onAccessScanningEnabled]));// Boolean
            Writeln(Format('pathToEnableOnAccessUI         %s',[FWbemObject.pathToEnableOnAccessUI]));// String
            Writeln(Format('pathToUpdateUI                 %s',[FWbemObject.pathToUpdateUI]));// String
            Writeln(Format('productUptoDate                %s',[FWbemObject.productUptoDate]));// Boolean
            Writeln(Format('updateUIMd5Hash                %s',[FWbemObject.updateUIMd5Hash]));// Uint8
            Writeln(Format('updateUIParameters             %s',[FWbemObject.updateUIParameters]));// String
            Writeln(Format('versionNumber                  %s',[FWbemObject.versionNumber]));// String
         end;

       FirewallProduct  :
         begin
            Writeln(Format('companyName                    %s',[FWbemObject.companyName]));// String
            Writeln(Format('displayName                    %s',[FWbemObject.displayName]));// String
            Writeln(Format('enabled                        %s',[FWbemObject.enabled]));// Boolean
            Writeln(Format('enableUIMd5Hash                %s',[FWbemObject.enableUIMd5Hash]));// Uint8
            Writeln(Format('enableUIParameters             %s',[FWbemObject.enableUIParameters]));// String
            Writeln(Format('instanceGuid                   %s',[FWbemObject.instanceGuid]));// String
            Writeln(Format('pathToEnableUI                 %s',[FWbemObject.pathToEnableUI]));// String
            Writeln(Format('versionNumber                  %s',[FWbemObject.versionNumber]));// String
         end;
     end;
    end;
    Writeln('');
    FWbemObject:=Unassigned;
  end;
end;

begin
 try
    if Is_Win_Server then
    begin
     Writeln('Sorry this app only can run in desktop operating systems.');
     Halt;
    end;

    CoInitialize(nil);
    try
      Writeln('AntiVirus Info');
      Writeln('--------------');
      GetSCProductInfo(AntiVirusProduct);
      Writeln('AntiSpyware Info');
      Writeln('----------------');
      GetSCProductInfo(AntiSpywareProduct);
      Writeln('Firewall Info');
      Writeln('-------------');
      GetSCProductInfo(FirewallProduct);
      Readln;
    finally
      CoUninitialize;
    end;
 except
    on E:Exception do
    begin
        Writeln(E.Classname, ':', E.Message);
        Readln;
    end;
  end;
end.

And here is the result of the app.


2 Comments

Changing Screen Orientation Programmatically using Delphi

In this post  i will show you how you can change the screen orientation using Delphi. to do this task you must use 2 winapi functions EnumDisplaySettings and ChangeDisplaySettings.

EnumDisplaySettings: this function retrieves information about the graphics modes supported by the display device.

for example to obtain the current display settings we must call this function in this way:

var
  dm      : TDeviceMode;

  ZeroMemory(@dm, sizeof(dm));
  dm.dmSize   := sizeof(dm);
  if EnumDisplaySettings(nil, DWORD(ENUM_CURRENT_SETTINGS), dm) then
  begin
   //some code
  end;

Now , to use the ChangeDisplaySettings function to change the Screen Orientation we need to pass a valid DEVMODE structure, setting the value of the dmDisplayOrientation field, unfortunately the declaration in the Windows.pas for this record does not include this field.

this is the declaration for the DEVMODE structure in the Windows unit.

  _devicemodeA = record
    dmDeviceName: array[0..CCHDEVICENAME - 1] of AnsiChar;
    dmSpecVersion: Word;
    dmDriverVersion: Word;
    dmSize: Word;
    dmDriverExtra: Word;
    dmFields: DWORD;
    dmOrientation: SHORT;
    dmPaperSize: SHORT;
    dmPaperLength: SHORT;
    dmPaperWidth: SHORT;
    dmScale: SHORT;
    dmCopies: SHORT;
    dmDefaultSource: SHORT;
    dmPrintQuality: SHORT;
    dmColor: SHORT;
    dmDuplex: SHORT;
    dmYResolution: SHORT;
    dmTTOption: SHORT;
    dmCollate: SHORT;
    dmFormName: array[0..CCHFORMNAME - 1] of AnsiChar;
    dmLogPixels: Word;
    dmBitsPerPel: DWORD;
    dmPelsWidth: DWORD;
    dmPelsHeight: DWORD;
    dmDisplayFlags: DWORD;
    dmDisplayFrequency: DWORD;
    dmICMMethod: DWORD;
    dmICMIntent: DWORD;
    dmMediaType: DWORD;
    dmDitherType: DWORD;
    dmICCManufacturer: DWORD;
    dmICCModel: DWORD;
    dmPanningWidth: DWORD;
    dmPanningHeight: DWORD;
  end;

and this is the full declaration including the dmDisplayOrientation field

typedef struct _devicemode {
  TCHAR dmDeviceName[CCHDEVICENAME];
  WORD  dmSpecVersion;
  WORD  dmDriverVersion;
  WORD  dmSize;
  WORD  dmDriverExtra;
  DWORD dmFields;
  union {
    struct {
      short dmOrientation;
      short dmPaperSize;
      short dmPaperLength;
      short dmPaperWidth;
      short dmScale;
      short dmCopies;
      short dmDefaultSource;
      short dmPrintQuality;
    };
    struct {
      POINTL dmPosition;
      DWORD  dmDisplayOrientation;
      DWORD  dmDisplayFixedOutput;
    };
  };
  short dmColor;
  short dmDuplex;
  short dmYResolution;
  short dmTTOption;
  short dmCollate;
  TCHAR dmFormName[CCHFORMNAME];
  WORD  dmLogPixels;
  DWORD dmBitsPerPel;
  DWORD dmPelsWidth;
  DWORD dmPelsHeight;
  union {
    DWORD dmDisplayFlags;
    DWORD dmNup;
  };
  DWORD dmDisplayFrequency;
#if (WINVER >= 0x0400)
  DWORD dmICMMethod;
  DWORD dmICMIntent;
  DWORD dmMediaType;
  DWORD dmDitherType;
  DWORD dmReserved1;
  DWORD dmReserved2;
#if (WINVER >= 0x0500) || (_WIN32_WINNT >= 0x0400)
  DWORD dmPanningWidth;
  DWORD dmPanningHeight;
#endif
#endif
} DEVMODE, *PDEVMODE, *LPDEVMODE;

As you can see the missing fields are dmPosition, dmDisplayOrientation and dmDisplayFixedOutput. to handle this situation we can declare a new devicemode record including these fields or another option is determine the offset of the missing fields in the _devicemode record an then use the Move procedure to Get a Set the desired value.

If we choose create a new record including the missing fields, the new devicemode record will look like this.

type
  _devicemode = record
    dmDeviceName: array [0..CCHDEVICENAME - 1] of {$IFDEF UNICODE} WideChar {$ELSE} AnsiChar {$ENDIF};
    dmSpecVersion: WORD;
    dmDriverVersion: WORD;
    dmSize: WORD;
    dmDriverExtra: WORD;
    dmFields: DWORD;
    union1: record
    case Integer of
      0: (
        dmOrientation: Smallint;
        dmPaperSize: Smallint;
        dmPaperLength: Smallint;
        dmPaperWidth: Smallint;
        dmScale: Smallint;
        dmCopies: Smallint;
        dmDefaultSource: Smallint;
        dmPrintQuality: Smallint);
      1: (
        dmPosition: TPointL;
        dmDisplayOrientation: DWORD;
        dmDisplayFixedOutput: DWORD);
    end;
    dmColor: Shortint;
    dmDuplex: Shortint;
    dmYResolution: Shortint;
    dmTTOption: Shortint;
    dmCollate: Shortint;
    dmFormName: array [0..CCHFORMNAME - 1] of {$IFDEF UNICODE} WideChar {$ELSE} AnsiChar {$ENDIF};
    dmLogPixels: WORD;
    dmBitsPerPel: DWORD;
    dmPelsWidth: DWORD;
    dmPelsHeight: DWORD;
    dmDiusplayFlags: DWORD;
    dmDisplayFrequency: DWORD;
    dmICMMethod: DWORD;
    dmICMIntent: DWORD;
    dmMediaType: DWORD;
    dmDitherType: DWORD;
    dmReserved1: DWORD;
    dmReserved2: DWORD;
    dmPanningWidth: DWORD;
    dmPanningHeight: DWORD;
  end;
  devicemode  = _devicemode;
  Pdevicemode = ^devicemode;

Now we can write our function to change the display orientation.

Option 1) using the the new version of the devicemode record.

procedure ChangeOrientation(NewOrientation:DWORD);
type
  _devicemode = record
    dmDeviceName: array [0..CCHDEVICENAME - 1] of {$IFDEF UNICODE} WideChar {$ELSE} AnsiChar {$ENDIF};
    dmSpecVersion: WORD;
    dmDriverVersion: WORD;
    dmSize: WORD;
    dmDriverExtra: WORD;
    dmFields: DWORD;
    union1: record
    case Integer of
      // printer only fields
      0: (
        dmOrientation: Smallint;
        dmPaperSize: Smallint;
        dmPaperLength: Smallint;
        dmPaperWidth: Smallint;
        dmScale: Smallint;
        dmCopies: Smallint;
        dmDefaultSource: Smallint;
        dmPrintQuality: Smallint);
      // display only fields
      1: (
        dmPosition: TPointL;
        dmDisplayOrientation: DWORD;
        dmDisplayFixedOutput: DWORD);
    end;
    dmColor: Shortint;
    dmDuplex: Shortint;
    dmYResolution: Shortint;
    dmTTOption: Shortint;
    dmCollate: Shortint;
    dmFormName: array [0..CCHFORMNAME - 1] of {$IFDEF UNICODE} WideChar {$ELSE} AnsiChar {$ENDIF};
    dmLogPixels: WORD;
    dmBitsPerPel: DWORD;
    dmPelsWidth: DWORD;
    dmPelsHeight: DWORD;
    dmDiusplayFlags: DWORD;
    dmDisplayFrequency: DWORD;
    dmICMMethod: DWORD;
    dmICMIntent: DWORD;
    dmMediaType: DWORD;
    dmDitherType: DWORD;
    dmReserved1: DWORD;
    dmReserved2: DWORD;
    dmPanningWidth: DWORD;
    dmPanningHeight: DWORD;
  end;
  devicemode  = _devicemode;
  Pdevicemode = ^devicemode;
var
  dm       : TDeviceMode;
  dwTemp  : DWORD;
begin
   ZeroMemory(@dm, sizeof(dm));
   dm.dmSize := sizeof(dm);
   //get the current settings
   if EnumDisplaySettings(nil, DWORD(ENUM_CURRENT_SETTINGS), dm) then
   begin
      //Now this part is very important :
      //when we change the orientation also we are changing resolution of the screen
      //example : if the current orientation is 1024x768x0 (0 is the default orientation) and we need set the orientation to 90 degrees we must swap the values of the width and height , so the new
      //resolution will be (768x1024x90)
      //the next lines makes this trick using the values of the current and new orientation
      if Odd(Pdevicemode(@dm)^.union1.dmDisplayOrientation)<>Odd(NewOrientation) then
      begin
       dwTemp := dm.dmPelsHeight;
       dm.dmPelsHeight:= dm.dmPelsWidth;
       dm.dmPelsWidth := dwTemp;
      end;

      //Now casting the Windows.TDeviceMode record with our devicemode record
      if Pdevicemode(@dm)^.union1.dmDisplayOrientation<>NewOrientation then
      begin
        //casting again to set the new orientation
        Pdevicemode(@dm)^.union1.dmDisplayOrientation := NewOrientation;
        //setting the new orientation
        if (ChangeDisplaySettings(dm, 0)<>DISP_CHANGE_SUCCESSFUL) then
         RaiseLastOSError;
      end;
   end;
end;

Option 2) using the offset of the fields of the TDeviceMode record

procedure ChangeOrientation(NewOrientation:DWORD);
var
 dm      : TDeviceMode;
 dwTemp  : DWORD;
 dmDisplayOrientation : DWORD;
begin
 ZeroMemory(@dm, sizeof(dm));
 dm.dmSize   := sizeof(dm);
 if EnumDisplaySettings(nil, DWORD(ENUM_CURRENT_SETTINGS), dm) then
 begin
 //In the TDevMode record the offset of the dmScale field is equal to the position of the dmDisplayOrientation field
 //so using the move procedure we can get the value of the dmDisplayOrientation field
 Move(dm.dmScale,dmDisplayOrientation,SizeOf(dmDisplayOrientation));
 //See the coments in the pprevious method
 // swap width and height
 if Odd(dmDisplayOrientation)<>Odd(NewOrientation) then
 begin
 dwTemp := dm.dmPelsHeight;
 dm.dmPelsHeight:= dm.dmPelsWidth;
 dm.dmPelsWidth := dwTemp;
 end;

 if dmDisplayOrientation<>NewOrientation then
 begin
 //set the value of the   dmDisplayOrientation
 Move(NewOrientation,dm.dmScale,SizeOf(NewOrientation));
 if (ChangeDisplaySettings(dm, 0)<>DISP_CHANGE_SUCCESSFUL) then
 RaiseLastOSError;
 end;
 end;
end;

finally this is a sample console application to test the previous method

this code will only work if your device supports the respective display settings.

program AppChangeOrientation;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils;

const
  DM_DISPLAYORIENTATION = $00800000;
  ENUM_CURRENT_SETTINGS =-1;
  DMDO_DEFAULT : DWORD  = 0;
  DMDO_90      : DWORD  = 1;
  DMDO_180     : DWORD  = 2;
  DMDO_270     : DWORD  = 3;

procedure ChangeOrientation(NewOrientation:DWORD);
var
  dm      : TDeviceMode;
  dwTemp  : DWORD;
  dmDisplayOrientation : DWORD;
begin
   ZeroMemory(@dm, sizeof(dm));
   dm.dmSize   := sizeof(dm);
   if EnumDisplaySettings(nil, DWORD(ENUM_CURRENT_SETTINGS), dm) then
   begin
      Move(dm.dmScale,dmDisplayOrientation,SizeOf(dmDisplayOrientation));
      // swap width and height
      if Odd(dmDisplayOrientation)<>Odd(NewOrientation) then
      begin
       dwTemp := dm.dmPelsHeight;
       dm.dmPelsHeight:= dm.dmPelsWidth;
       dm.dmPelsWidth := dwTemp;
      end;

      if dmDisplayOrientation<>NewOrientation then
      begin
        Move(NewOrientation,dm.dmScale,SizeOf(NewOrientation));
        if (ChangeDisplaySettings(dm, 0)<>DISP_CHANGE_SUCCESSFUL) then
         RaiseLastOSError;
      end;
   end;
end;

begin
  try
    ChangeOrientation(DMDO_180);
    Writeln('Changed to 180');
    Readln;

    ChangeOrientation(DMDO_270);
    Writeln('Changed to 270');
    Readln;

    ChangeOrientation(DMDO_90);
    Writeln('Changed to 90');
    Readln;

    ChangeOrientation(DMDO_DEFAULT);
    Writeln('Default Orientation restored');
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
     readln;
end.


2 Comments

Determine when Windows is a Desktop or Server edition using Delphi

Sometimes we need determine when a windows version is a server edition (2000, 2003 or 2008) or a Desktop edition. to do this we can use the VerifyVersionInfo function. this function compares a set of operating system version requirements to the corresponding values for the currently running version of the system.

but exist a problem, the version of this function declared in the Windows unit uses a OSVERSIONINFO parameter.

function VerifyVersionInfo(var lpVersionInformation: TOSVersionInfo;
  dwTypeMask: DWORD; dwlConditionMask: DWORDLONG): BOOL; stdcall; 

And in this case we need pass a OSVERSIONINFOEX Structure, so we must re-declare this function in this way.

{$IFDEF UNICODE}
function VerifyVersionInfo(var LPOSVERSIONINFOEX : OSVERSIONINFOEX;dwTypeMask: DWORD;dwlConditionMask: int64): BOOL; stdcall; external kernel32 name 'VerifyVersionInfoW';
{$ELSE}
function VerifyVersionInfo(var LPOSVERSIONINFOEX : OSVERSIONINFOEX;dwTypeMask: DWORD;dwlConditionMask: int64): BOOL; stdcall; external kernel32 name 'VerifyVersionInfoA';
{$ENDIF}

Now to work with the VerifyVersionInfo function we need establish the requirements to check .


   ZeroMemory(@osvi, sizeof(OSVERSIONINFOEX));
   osvi.dwOSVersionInfoSize := sizeof(OSVERSIONINFOEX);
   osvi.dwMajorVersion := 5; //at least windows 2000
   osvi.dwMinorVersion := 0;
   osvi.wServicePackMajor := 0;
   osvi.wServicePackMinor := 0;
   osvi.wProductType := VER_NT_SERVER; // Check windows server edition

then we need set the flags to interrogate the VerifyVersionInfo function using the VerSetConditionMask function

   op:=VER_GREATER_EQUAL;
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_MAJORVERSION, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_MINORVERSION, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_SERVICEPACKMAJOR, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_SERVICEPACKMINOR, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_PRODUCT_TYPE, VER_EQUAL );

and finally call the function in this way

   VerifyVersionInfo(osvi,VER_MAJORVERSION OR VER_MINORVERSION OR
      VER_SERVICEPACKMAJOR OR VER_SERVICEPACKMINOR OR VER_PRODUCT_TYPE, dwlConditionMask);

this is the source code of the demo console application.

program ISWindowsServer;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils;

{$IFDEF UNICODE}
function VerifyVersionInfo(var LPOSVERSIONINFOEX : OSVERSIONINFOEX;dwTypeMask: DWORD;dwlConditionMask: int64): BOOL; stdcall; external kernel32 name 'VerifyVersionInfoW';
{$ELSE}
function VerifyVersionInfo(var LPOSVERSIONINFOEX : OSVERSIONINFOEX;dwTypeMask: DWORD;dwlConditionMask: int64): BOOL; stdcall; external kernel32 name 'VerifyVersionInfoA';
{$ENDIF}
function VerSetConditionMask(dwlConditionMask: int64;dwTypeBitMask: DWORD; dwConditionMask: Byte): int64; stdcall; external kernel32;

function IsWinServer : Boolean;
const
   VER_NT_SERVER      = $0000003;
   VER_EQUAL          = 1;
   VER_GREATER_EQUAL  = 3;
var
   osvi             : OSVERSIONINFOEX;
   dwlConditionMask : DWORDLONG;
   op               : Integer;
begin
   dwlConditionMask := 0;
   op:=VER_GREATER_EQUAL;

   ZeroMemory(@osvi, sizeof(OSVERSIONINFOEX));
   osvi.dwOSVersionInfoSize := sizeof(OSVERSIONINFOEX);
   osvi.dwMajorVersion := 5;
   osvi.dwMinorVersion := 0;
   osvi.wServicePackMajor := 0;
   osvi.wServicePackMinor := 0;
   osvi.wProductType := VER_NT_SERVER;

   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_MAJORVERSION, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_MINORVERSION, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_SERVICEPACKMAJOR, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_SERVICEPACKMINOR, op );
   dwlConditionMask:=VerSetConditionMask( dwlConditionMask, VER_PRODUCT_TYPE, VER_EQUAL );

   Result:=VerifyVersionInfo(osvi,VER_MAJORVERSION OR VER_MINORVERSION OR
      VER_SERVICEPACKMAJOR OR VER_SERVICEPACKMINOR OR VER_PRODUCT_TYPE, dwlConditionMask);
end;

const
WindowsEditionStr : array [boolean] of string = ('Desktop','Server');

begin
  try
    Writeln( Format('Running in Windows %s edition',[WindowsEditionStr[IsWinServer]]));
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln;
end.


8 Comments

Avoiding the memory leak caused by the delphi intellimouse support

Since the Delphi 2006 version, you can activate the full mouse wheel support (Intellimouse) by adding to the Uses statement the IMouse unit. for example to activate the Intellimouse support to a TMemo component you must set the ScrollBars property to ssHorizontal, ssVertical or ssBoth and add the IMouse unit to your project.

and the result will look like this.

So far all will work ok, but if you add the next line to your project, to report the memory leaks.

 ReportMemoryLeaksOnShutdown:=True;

you will receive a awful message like this

this is due which in the IMouse unit the Mouse.PanningWindow is never released. to avoid this memory leak you must add these lines to your project in the finalization part of your main unit or in the unit where your declare the IMouse unit.

  if Assigned(Mouse.PanningWindow) then
    Mouse.PanningWindow := nil;


29 Comments

Making a PING with Delphi and the WMI

Typically we use the IcmpSendEcho function or a component like TIdIcmpClient to make a ping request from Delphi. Today I will show you another way to do this using the WMI (Windows Management Instrumentation).

The WMI class which allow you to make a ping request is Win32_PingStatus, to use this class you only need to pass the parameter Address value in your WQL sentence , the form of the Address parameter can be either the computer name (ACCOUNT-PC), IPv4 address (192.168.154.102), or IPv6 address (2010:836B:4179::836B:4179).

SELECT * FROM Win32_PingStatus where Address='www.google.com'

Some of the advantages of use this class to make a ping is which supports IPv4 addresses and IPv6 addresses (Starting with Windows Vista) , and you can set the ping parameters in a single WQL sentence.

For example if you want send a Buffer of 64 bytes (instead of the 32 default size) and resolve the address of the host server you only need to write a sentence like this :

SELECT * FROM Win32_PingStatus where Address='192.168.1.221' AND BufferSize=64 AND ResolveAddressNames=TRUE

Now check this sample console application.

program WMIPing;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj,
  Variants;

function GetStatusCodeStr(statusCode:integer) : string;
begin
  case statusCode of
    0     : Result:='Success';
    11001 : Result:='Buffer Too Small';
    11002 : Result:='Destination Net Unreachable';
    11003 : Result:='Destination Host Unreachable';
    11004 : Result:='Destination Protocol Unreachable';
    11005 : Result:='Destination Port Unreachable';
    11006 : Result:='No Resources';
    11007 : Result:='Bad Option';
    11008 : Result:='Hardware Error';
    11009 : Result:='Packet Too Big';
    11010 : Result:='Request Timed Out';
    11011 : Result:='Bad Request';
    11012 : Result:='Bad Route';
    11013 : Result:='TimeToLive Expired Transit';
    11014 : Result:='TimeToLive Expired Reassembly';
    11015 : Result:='Parameter Problem';
    11016 : Result:='Source Quench';
    11017 : Result:='Option Too Big';
    11018 : Result:='Bad Destination';
    11032 : Result:='Negotiating IPSEC';
    11050 : Result:='General Failure'
    else
    result:='Unknow';
  end;
end;


//The form of the Address parameter can be either the computer name (wxyz1234), IPv4 address (192.168.177.124), or IPv6 address (2010:836B:4179::836B:4179).
procedure  Ping(const Address:string;Retries,BufferSize:Word);
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  i             : Integer;

  PacketsReceived : Integer;
  Minimum         : Integer;
  Maximum         : Integer;
  Average         : Integer;
begin;
  PacketsReceived:=0;
  Minimum        :=0;
  Maximum        :=0;
  Average        :=0;
  Writeln('');
  Writeln(Format('Pinging %s with %d bytes of data:',[Address,BufferSize]));
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  //FWMIService   := FSWbemLocator.ConnectServer('192.168.52.130', 'root\CIMV2', 'user', 'password');
  for i := 0 to Retries-1 do
  begin
    FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM Win32_PingStatus where Address=%s AND BufferSize=%d',[QuotedStr(Address),BufferSize]),'WQL',0);
    oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
    if oEnum.Next(1, FWbemObject, iValue) = 0 then
    begin
      if FWbemObject.StatusCode=0 then
      begin
        if FWbemObject.ResponseTime>0 then
          Writeln(Format('Reply from %s: bytes=%s time=%sms TTL=%s',[FWbemObject.ProtocolAddress,FWbemObject.ReplySize,FWbemObject.ResponseTime,FWbemObject.TimeToLive]))
        else
          Writeln(Format('Reply from %s: bytes=%s time=<1ms TTL=%s',[FWbemObject.ProtocolAddress,FWbemObject.ReplySize,FWbemObject.TimeToLive]));

        Inc(PacketsReceived);

        if FWbemObject.ResponseTime>Maximum then
        Maximum:=FWbemObject.ResponseTime;

        if Minimum=0 then
        Minimum:=Maximum;

        if FWbemObject.ResponseTime<Minimum then
        Minimum:=FWbemObject.ResponseTime;

        Average:=Average+FWbemObject.ResponseTime;
      end
      else
      if not VarIsNull(FWbemObject.StatusCode) then
        Writeln(Format('Reply from %s: %s',[FWbemObject.ProtocolAddress,GetStatusCodeStr(FWbemObject.StatusCode)]))
      else
        Writeln(Format('Reply from %s: %s',[Address,'Error processing request']));
    end;
    FWbemObject:=Unassigned;
    FWbemObjectSet:=Unassigned;
    //Sleep(500);
  end;

  Writeln('');
  Writeln(Format('Ping statistics for %s:',[Address]));
  Writeln(Format('    Packets: Sent = %d, Received = %d, Lost = %d (%d%% loss),',[Retries,PacketsReceived,Retries-PacketsReceived,Round((Retries-PacketsReceived)*100/Retries)]));
  if PacketsReceived>0 then
  begin
   Writeln('Approximate round trip times in milli-seconds:');
   Writeln(Format('    Minimum = %dms, Maximum = %dms, Average = %dms',[Minimum,Maximum,Round(Average/PacketsReceived)]));
  end;
end;


begin
 try
    CoInitialize(nil);
    try
      //Ping('192.168.52.130',4,32);
      Ping('theroadtodelphi.wordpress.com',4,32);
    finally
      CoUninitialize;
    end;
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Readln;
end.

And the output

Follow

Get every new post delivered to your Inbox.

Join 707 other followers