The Road to Delphi – a Blog about programming

Delphi – Free Pascal – Oxygene


11 Comments

WMI Tasks using Delphi – Networking

How do I disable a network connection using WMI?

If you are using DHCP, use the Win32_NetworkAdapterConfiguration and the ReleaseDHCPLease method to release the IP address. If you are not using DHCP, you cannot use WMI to disable a network connection. To re-enable the network connection, use objNetCard.RenewDHCPLease. You can also release or renew all of the DHCP leases using the ReleaseDHCPLeaseAll and RenewDHCPLeaseAll methods.

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_NetworkAdapterConfiguration Where IPEnabled = True','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    FWbemObject.ReleaseDHCPLease();
    FWbemObject:=Unassigned;
  end;
end;

How do I disable or enable a NIC?

Use the Win32_NetworkAdapter class and the Disable or Enable methods.

//Disable a NIC
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_NetworkAdapter Where NetEnabled=True','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    FWbemObject.Disable();
    FWbemObject:=Unassigned;
  end;
end;
//Enable a NIC
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_NetworkAdapter Where NetEnabled=False','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    FWbemObject.Enable();
    FWbemObject:=Unassigned;
  end;
end;

How do I determine which IP address has been assigned to a given network connection?

Use the Win32_NetworkAdapter class and the NetConnectionID property to determine the MAC address of the network connection. Then, use the Win32_NetworkAdapterConfiguration class to find the IP address associated with the MAC address.

const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  strMACAddress : string;
  i             : Integer;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');

  FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT MACAddress FROM Win32_NetworkAdapter Where NetConnectionID="%s"',['Local Area Connection 2']),'WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    strMACAddress:=String(FWbemObject.MACAddress);
    FWbemObject:=Unassigned;
  end;

  FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT IPAddress FROM Win32_NetworkAdapterConfiguration Where MACAddress="%s"',[strMACAddress]),'WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    if not VarIsClear(FWbemObject.IPAddress) then
    for i := VarArrayLowBound(FWbemObject.IPAddress, 1) to VarArrayHighBound(FWbemObject.IPAddress, 1) do
     Writeln(Format('IP Address %s',[String(FWbemObject.IPAddress[i])]));
    FWbemObject:=Unassigned;
  end;
end;

How do I determine the MAC address of a network adapter?

Use the Win32_NetworkAdapterConfiguration class and check the value of the MACAddress 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 Description,MACAddress FROM Win32_NetworkAdapterConfiguration','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('Description %s',[String(FWbemObject.Description)]));
    if not VarIsNull(FWbemObject.MACAddress) then
      Writeln(Format('  MAC Address %s',[String(FWbemObject.MACAddress)]))
    else
      Writeln(Format('  MAC Address %s',['Empty']));
    FWbemObject:=Unassigned;
  end;
end;

How do I determine the IP address(es) of a computer?

Use the Win32_NetworkAdapterConfiguration class and check the value of the IPAddress property.

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 IPAddress FROM Win32_NetworkAdapterConfiguration','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    if not VarIsClear(FWbemObject.IPAddress) and not VarIsNull(FWbemObject.IPAddress) then
    for i := VarArrayLowBound(FWbemObject.IPAddress, 1) to VarArrayHighBound(FWbemObject.IPAddress, 1) do
     Writeln(Format('IP Address %s',[String(FWbemObject.IPAddress[i])]));
    FWbemObject:=Unassigned;
  end;
end;

How do I configure a computer to start getting its IP address through DHCP?

Use the Win32_NetworkAdapterConfiguration class and the EnableDHCP 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_NetworkAdapterConfiguration Where IPEnabled=True','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    FWbemObject.EnableDHCP();
    FWbemObject:=Unassigned;
  end;
end;

How do I assign a computer a static IP address?

Use the Win32_NetworkAdapterConfiguration class and the EnableStatic method.

function ArrayToVarArray(Arr : Array Of string):OleVariant; overload;
var
 i : integer;
begin
    Result   :=VarArrayCreate([0, High(Arr)], varVariant);
    for i:=Low(Arr) to High(Arr) do
     Result[i]:=Arr[i];
end;

function ArrayToVarArray(Arr : Array Of Word):OleVariant;overload;
var
 i : integer;
begin
    Result   :=VarArrayCreate([0, High(Arr)], varVariant);
    for i:=Low(Arr) to High(Arr) do
     Result[i]:=Arr[i];
end;

procedure  SetStaticIP;
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  vIPAddress         : OleVariant;
  vSubnetMask        : OleVariant;
  vDefaultIPGateway  : OleVariant;
  vGatewayCostMetric : OleVariant;
begin
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_NetworkAdapterConfiguration Where IPEnabled=True','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    vIPAddress   := ArrayToVarArray(['192.168.1.141']);
    vSubnetMask  := ArrayToVarArray(['255.255.255.0']);
    if FWbemObject.EnableStatic(vIPAddress, vSubnetMask) = 0 then
    begin
      vDefaultIPGateway  := ArrayToVarArray(['192.168.1.100']);
      vGatewayCostMetric := ArrayToVarArray([1]);
      FWbemObject.SetGateways(vDefaultIPGateway,vGatewayCostMetric);
    end;

    VarClear(vIPAddress);
    VarClear(vSubnetMask);
    VarClear(vDefaultIPGateway);
    VarClear(vGatewayCostMetric);
    FWbemObject:=Unassigned;
  end;
end;

How do I ping a computer without using Ping.exe?

Use the Win32_PingStatus class. Starting with Windows Vista, Win32_PingStatus can return data for computers that have both IPv4 addresses and IPv6 addresses.

For a delphi sample code check this article Making a PING with Delphi and the WMI.

This post is based in the MSDN entry WMI Tasks: Networking


6 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;

Download the source code of the console application with all the snippets included in this article from here.


7 Comments

Using Delphi and ADSI to enumerate local and remote shared resources

One of the most rich Directory Access Technologies of Microsoft is the Active Directory Service Interfaces (ADSI) which is a set of interfaces designed to access the features of directory services from different network providers, in this case we will use the WinNT Provider to access the shared resources of a local or remote machine.  The aim of this post is show you how you can obtain the information related to the shared resources from a Delphi application.

Getting the interfaces

The common way to access the ADSI Interfaces from Delphi is importing the Active DS type library.

After of import the type library you will got a large unit file with many interfaces , constants and types which we will not need in this case, and only increase the final size of our application. So we can extract the interfaces for access the network shared resources (see the next source that shows the interfaces to the task)

const
  IID_IADsContainer: TGUID = '{001677D0-FD16-11CE-ABC4-02608C9E7553}';
  IID_IADsFileServiceOperations: TGUID = '{A02DED10-31CA-11CF-A98A-00AA006BC149}';
  ADS_SECURE_AUTHENTICATION = $00000001;
type
  IADsCollection = interface(IDispatch)
    ['{72B945E0-253B-11CF-A988-00AA006BC149}']
    function Get__NewEnum: IUnknown; safecall;
    procedure Add(const bstrName: WideString; vItem: OleVariant); safecall;
    procedure Remove(const bstrItemToBeRemoved: WideString); safecall;
    function GetObject(const bstrName: WideString): OleVariant; safecall;
    property _NewEnum: IUnknown read Get__NewEnum;
  end;

  IADs = interface(IDispatch)
    ['{FD8256D0-FD15-11CE-ABC4-02608C9E7553}']
    function Get_Name: WideString; safecall;
    function Get_Class_: WideString; safecall;
    function Get_GUID: WideString; safecall;
    function Get_ADsPath: WideString; safecall;
    function Get_Parent: WideString; safecall;
    function Get_Schema: WideString; safecall;
    procedure GetInfo; safecall;
    procedure SetInfo; safecall;
    function Get(const bstrName: WideString): OleVariant; safecall;
    procedure Put(const bstrName: WideString; vProp: OleVariant); safecall;
    function GetEx(const bstrName: WideString): OleVariant; safecall;
    procedure PutEx(lnControlCode: Integer; const bstrName: WideString; vProp: OleVariant); safecall;
    procedure GetInfoEx(vProperties: OleVariant; lnReserved: Integer); safecall;
    property Name: WideString read Get_Name;
    property Class_: WideString read Get_Class_;
    property GUID: WideString read Get_GUID;
    property ADsPath: WideString read Get_ADsPath;
    property Parent: WideString read Get_Parent;
    property Schema: WideString read Get_Schema;
  end;

  IADsContainer = interface(IDispatch)
    ['{001677D0-FD16-11CE-ABC4-02608C9E7553}']
    function Get_Count: Integer; safecall;
    function Get__NewEnum: IUnknown; safecall;
    function Get_Filter: OleVariant; safecall;
    procedure Set_Filter(pVar: OleVariant); safecall;
    function Get_Hints: OleVariant; safecall;
    procedure Set_Hints(pvFilter: OleVariant); safecall;
    function GetObject(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
    function Create(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
    procedure Delete(const bstrClassName: WideString; const bstrRelativeName: WideString); safecall;
    function CopyHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
    function MoveHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
    property Count: Integer read Get_Count;
    property _NewEnum: IUnknown read Get__NewEnum;
    property Filter: OleVariant read Get_Filter write Set_Filter;
    property Hints: OleVariant read Get_Hints write Set_Hints;
  end;

  IADsServiceOperations = interface(IADs)
    ['{5D7B33F0-31CA-11CF-A98A-00AA006BC149}']
    function Get_Status: Integer; safecall;
    procedure Start; safecall;
    procedure Stop; safecall;
    procedure Pause; safecall;
    procedure Continue; safecall;
    procedure SetPassword(const bstrNewPassword: WideString); safecall;
    property Status: Integer read Get_Status;
  end;

  IADsFileServiceOperations = interface(IADsServiceOperations)
    ['{A02DED10-31CA-11CF-A98A-00AA006BC149}']
    function Sessions: IADsCollection; safecall;
    function Resources: IADsCollection; safecall;
  end;

  IADsResource = interface(IADs)
    ['{34A05B20-4AAB-11CF-AE2C-00AA006EBFB9}']
    function Get_User: WideString; safecall;
    function Get_UserPath: WideString; safecall;
    function Get_Path: WideString; safecall;
    function Get_LockCount: Integer; safecall;
    property User: WideString read Get_User;
    property UserPath: WideString read Get_UserPath;
    property Path: WideString read Get_Path;
    property LockCount: Integer read Get_LockCount;
  end;

  IADsSession = interface(IADs)
    ['{398B7DA0-4AAB-11CF-AE2C-00AA006EBFB9}']
    function Get_User: WideString; safecall;
    function Get_UserPath: WideString; safecall;
    function Get_Computer: WideString; safecall;
    function Get_ComputerPath: WideString; safecall;
    function Get_ConnectTime: Integer; safecall;
    function Get_IdleTime: Integer; safecall;
    property User: WideString read Get_User;
    property UserPath: WideString read Get_UserPath;
    property Computer: WideString read Get_Computer;
    property ComputerPath: WideString read Get_ComputerPath;
    property ConnectTime: Integer read Get_ConnectTime;
    property IdleTime: Integer read Get_IdleTime;
  end;

  IADsFileShare = interface(IADs)
    ['{EB6DCAF0-4B83-11CF-A995-00AA006BC149}']
    function Get_CurrentUserCount: Integer; safecall;
    function Get_Description: WideString; safecall;
    procedure Set_Description(const retval: WideString); safecall;
    function Get_HostComputer: WideString; safecall;
    procedure Set_HostComputer(const retval: WideString); safecall;
    function Get_Path: WideString; safecall;
    procedure Set_Path(const retval: WideString); safecall;
    function Get_MaxUserCount: Integer; safecall;
    procedure Set_MaxUserCount(retval: Integer); safecall;
    property CurrentUserCount: Integer read Get_CurrentUserCount;
    property Description: WideString read Get_Description write Set_Description;
    property HostComputer: WideString read Get_HostComputer write Set_HostComputer;
    property Path: WideString read Get_Path write Set_Path;
    property MaxUserCount: Integer read Get_MaxUserCount write Set_MaxUserCount;
  end;

In addition to the interfaces we need the ADsOpenObject function which allow you binds to an ADSI interface.

check the syntax of this function

HRESULT ADsOpenObject(
  __in   LPCWSTR lpszPathName,
  __in   LPCWSTR lpszUserName,
  __in   LPCWSTR lpszPassword,
  __in   DWORD dwReserved,
  __in   REFIID riid,
  __out  VOID **ppObject
);

The Delphi equivalent can be

function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString;
dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; safecall; external 'activeds.dll';

or

function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString;
dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; stdcall; external 'activeds.dll';

As you can see the only difference is the calling convention (safecall vs stdcall), if you want which Delphi check the value of the returned HResult and raises the exception for you then use the safecall calling convention else if you want check manually the HResult returned by the function use stdcall

Listing the Connected Sessions

To list the Open Sessions (Machines connected) to the shared resources we must use the IADsFileServiceOperations interface and the Sessions function which return a collection of the open sessions for the service.

const
   lpszUserName ='';  // set the user name used to establish the connection to the remote machine
   lpszPassword ='';  // set the password used to establish the connection to the remote machine
   lpszComputer ='.'; // the "." is for the local machine, you can set the name of the remote machine
var
  FSO             : IADsFileServiceOperations;
  Sessions        : IADsCollection;
  Session         : IADsSession;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
  dt              : TDateTime;
begin
  //connect to the file service of the loal o remote machine
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
  //obtain the sessions
  Sessions := FSO.Sessions;
  //Get the enumerator
  oEnum:= IUnknown(Sessions._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    //cast the current element to IADsSession
    Session:=IUnknown(rgvar) as IADsSession;
    try
      Writeln('Computer        '+Session.Computer);
      dt := Session.ConnectTime / SecsPerDay; // the ConnectTime  property return the value in seconds
      Writeln('Connected Time  '+FormatDateTime('hh:nn:ss',dt));
      dt := Session.IdleTime / SecsPerDay; // the IdleTime property return the value in seconds
      Writeln('Idle Time       '+FormatDateTime('hh:nn:ss',dt));
      Writeln('Name            '+Session.Name);
      Writeln('User            '+Session.User);
      Writeln('');
    finally
      rgvar:=Unassigned; //clear the variant used for hold the values avoiding meory leaks
    end;
  end;
end;

With this simple code you will get the same information returned by the Windows option Computer Management -> System Tools -> Shared folders > Sessions

Listing the shared resources in use (opened)

To List the opened resources like folders and files we must use the IADsFileServiceOperations interface and the Resources function which return a collection of the open resources for the service.

procedure ListSharedResourcesInUse;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  FSO             : IADsFileServiceOperations;
  Resources       : IADsCollection;
  Resource        : IADsResource;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
begin
  //connect to the WinNt provider of the local or remote machine and get an instance to the file service
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
  //Get the opened resources
  Resources := FSO.Resources;
  //get the enumerator
  oEnum:= IUnknown(Resources._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    //cast the current element of the collection to the IADsResource interface
    Resource:=IUnknown(rgvar) as IADsResource;
    try
      try
       Writeln(Format('Resource %s User %s LockCount %d',[Resource.Path, Resource.User, Resource.LockCount]));
      except
        on E:EOleException  do
        if E.ErrorCode<> HResult($80070002) then  //in some cases this exception (path not found) is raised when you enumerate the opened resources, you can ignore without problems
         raise;
      end;
    finally
      rgvar:=Unassigned; //avoid a memory leak
    end;
  end;
end;

With this code you will get the same information returned by the Windows option Computer Management -> System Tools -> Shared folders > Open files

Listing the Shared Resources

Finally to List the shared resources we must connect to the local or remote machine using the ADsOpenObject function passing a IADsContainer interface which return a collection with the resources.

procedure ListShared;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  Shares          : IADsContainer;
  Share           : IADsFileShare;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
begin
  //connect to the network provider and get the collection of shared resources
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsContainer,Shares));
  //get the enumerator
  oEnum:= IUnknown(Shares._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    //cast the current element to IADsFileShare
    Share:=IUnknown(rgvar) as IADsFileShare;
    try
      Writeln('CurrentUserCount '+IntToStr(Share.CurrentUserCount));
      Writeln('Host Computer    '+Share.HostComputer);
      Writeln('Description      '+Share.Description);
      Writeln('Path             '+Share.Path);
      Writeln('Max User Count   '+IntToStr(Share.MaxUserCount));
      Writeln('');
    finally
     rgvar:=Unassigned; //avoid memory leaks
    end;
  end;
end;

The Console application

This is the full source code of a console application to show all the tasks described in this post.

{$APPTYPE CONSOLE}
{.$DEFINE USE_ActiveDs_TLB}

uses
  {$IFDEF USE_ActiveDs_TLB}
  ActiveDs_TLB,
  {$ENDIF}
  Windows,
  ComObj,
  Variants,
  ActiveX,
  SysUtils;

{$IFNDEF USE_ActiveDs_TLB}
const
  IID_IADsContainer: TGUID = '{001677D0-FD16-11CE-ABC4-02608C9E7553}';
  IID_IADsFileServiceOperations: TGUID = '{A02DED10-31CA-11CF-A98A-00AA006BC149}';
  ADS_SECURE_AUTHENTICATION = $00000001;
type
  IADsCollection = interface(IDispatch)
    ['{72B945E0-253B-11CF-A988-00AA006BC149}']
    function Get__NewEnum: IUnknown; safecall;
    procedure Add(const bstrName: WideString; vItem: OleVariant); safecall;
    procedure Remove(const bstrItemToBeRemoved: WideString); safecall;
    function GetObject(const bstrName: WideString): OleVariant; safecall;
    property _NewEnum: IUnknown read Get__NewEnum;
  end;

  IADs = interface(IDispatch)
    ['{FD8256D0-FD15-11CE-ABC4-02608C9E7553}']
    function Get_Name: WideString; safecall;
    function Get_Class_: WideString; safecall;
    function Get_GUID: WideString; safecall;
    function Get_ADsPath: WideString; safecall;
    function Get_Parent: WideString; safecall;
    function Get_Schema: WideString; safecall;
    procedure GetInfo; safecall;
    procedure SetInfo; safecall;
    function Get(const bstrName: WideString): OleVariant; safecall;
    procedure Put(const bstrName: WideString; vProp: OleVariant); safecall;
    function GetEx(const bstrName: WideString): OleVariant; safecall;
    procedure PutEx(lnControlCode: Integer; const bstrName: WideString; vProp: OleVariant); safecall;
    procedure GetInfoEx(vProperties: OleVariant; lnReserved: Integer); safecall;
    property Name: WideString read Get_Name;
    property Class_: WideString read Get_Class_;
    property GUID: WideString read Get_GUID;
    property ADsPath: WideString read Get_ADsPath;
    property Parent: WideString read Get_Parent;
    property Schema: WideString read Get_Schema;
  end;

  IADsContainer = interface(IDispatch)
    ['{001677D0-FD16-11CE-ABC4-02608C9E7553}']
    function Get_Count: Integer; safecall;
    function Get__NewEnum: IUnknown; safecall;
    function Get_Filter: OleVariant; safecall;
    procedure Set_Filter(pVar: OleVariant); safecall;
    function Get_Hints: OleVariant; safecall;
    procedure Set_Hints(pvFilter: OleVariant); safecall;
    function GetObject(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
    function Create(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
    procedure Delete(const bstrClassName: WideString; const bstrRelativeName: WideString); safecall;
    function CopyHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
    function MoveHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
    property Count: Integer read Get_Count;
    property _NewEnum: IUnknown read Get__NewEnum;
    property Filter: OleVariant read Get_Filter write Set_Filter;
    property Hints: OleVariant read Get_Hints write Set_Hints;
  end;

  IADsServiceOperations = interface(IADs)
    ['{5D7B33F0-31CA-11CF-A98A-00AA006BC149}']
    function Get_Status: Integer; safecall;
    procedure Start; safecall;
    procedure Stop; safecall;
    procedure Pause; safecall;
    procedure Continue; safecall;
    procedure SetPassword(const bstrNewPassword: WideString); safecall;
    property Status: Integer read Get_Status;
  end;

  IADsFileServiceOperations = interface(IADsServiceOperations)
    ['{A02DED10-31CA-11CF-A98A-00AA006BC149}']
    function Sessions: IADsCollection; safecall;
    function Resources: IADsCollection; safecall;
  end;

  IADsResource = interface(IADs)
    ['{34A05B20-4AAB-11CF-AE2C-00AA006EBFB9}']
    function Get_User: WideString; safecall;
    function Get_UserPath: WideString; safecall;
    function Get_Path: WideString; safecall;
    function Get_LockCount: Integer; safecall;
    property User: WideString read Get_User;
    property UserPath: WideString read Get_UserPath;
    property Path: WideString read Get_Path;
    property LockCount: Integer read Get_LockCount;
  end;

  IADsSession = interface(IADs)
    ['{398B7DA0-4AAB-11CF-AE2C-00AA006EBFB9}']
    function Get_User: WideString; safecall;
    function Get_UserPath: WideString; safecall;
    function Get_Computer: WideString; safecall;
    function Get_ComputerPath: WideString; safecall;
    function Get_ConnectTime: Integer; safecall;
    function Get_IdleTime: Integer; safecall;
    property User: WideString read Get_User;
    property UserPath: WideString read Get_UserPath;
    property Computer: WideString read Get_Computer;
    property ComputerPath: WideString read Get_ComputerPath;
    property ConnectTime: Integer read Get_ConnectTime;
    property IdleTime: Integer read Get_IdleTime;
  end;

  IADsFileShare = interface(IADs)
    ['{EB6DCAF0-4B83-11CF-A995-00AA006BC149}']
    function Get_CurrentUserCount: Integer; safecall;
    function Get_Description: WideString; safecall;
    procedure Set_Description(const retval: WideString); safecall;
    function Get_HostComputer: WideString; safecall;
    procedure Set_HostComputer(const retval: WideString); safecall;
    function Get_Path: WideString; safecall;
    procedure Set_Path(const retval: WideString); safecall;
    function Get_MaxUserCount: Integer; safecall;
    procedure Set_MaxUserCount(retval: Integer); safecall;
    property CurrentUserCount: Integer read Get_CurrentUserCount;
    property Description: WideString read Get_Description write Set_Description;
    property HostComputer: WideString read Get_HostComputer write Set_HostComputer;
    property Path: WideString read Get_Path write Set_Path;
    property MaxUserCount: Integer read Get_MaxUserCount write Set_MaxUserCount;
  end;
{$ENDIF}

function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString;dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; stdcall; external 'activeds.dll';

procedure ListConnectedSessions;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  FSO             : IADsFileServiceOperations;
  Sessions        : IADsCollection;
  Session         : IADsSession;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
  dt              : TDateTime;
begin
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
  Sessions := FSO.Sessions;
  oEnum:= IUnknown(Sessions._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    Session:=IUnknown(rgvar) as IADsSession;
    try
      Writeln('Computer        '+Session.Computer);
      dt := Session.ConnectTime / SecsPerDay;
      Writeln('Connected Time  '+FormatDateTime('hh:nn:ss',dt));
      dt := Session.IdleTime / SecsPerDay;
      Writeln('Idle Time       '+FormatDateTime('hh:nn:ss',dt));
      Writeln('Name            '+Session.Name);
      Writeln('User            '+Session.User);
      Writeln('');
    finally
      rgvar:=Unassigned;
    end;
  end;
end;

procedure ListSharedResourcesInUse;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  FSO             : IADsFileServiceOperations;
  Resources       : IADsCollection;
  Resource        : IADsResource;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
begin
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
  Resources := FSO.Resources;
  oEnum:= IUnknown(Resources._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    Resource:=IUnknown(rgvar) as IADsResource;
    try
      try
       Writeln(Format('Resource %s User %s LockCount %d',[Resource.Path, Resource.User, Resource.LockCount]));
      except
        on E:EOleException  do
        if E.ErrorCode<> HResult($80070002) then  //ignore path not found exception
         raise;
      end;
    finally
      rgvar:=Unassigned;
    end;

  end;
end;

procedure ListShared;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  Shares          : IADsContainer;
  Share           : IADsFileShare;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
begin
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsContainer,Shares));
  oEnum:= IUnknown(Shares._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    Share:=IUnknown(rgvar) as IADsFileShare;
    try
      Writeln('CurrentUserCount '+IntToStr(Share.CurrentUserCount));
      Writeln('Host Computer    '+Share.HostComputer);
      Writeln('Description      '+Share.Description);
      Writeln('Path             '+Share.Path);
      Writeln('Max User Count   '+IntToStr(Share.MaxUserCount));
      Writeln('');
    finally
     rgvar:=Unassigned;
    end;
  end;
end;

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


24 Comments

Making a PING with Delphi and the WMI

Typically we use the IcmpSendEcho function or a component like TIdIcmpClient to make a ping from delphi, today i will show you a third 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 wanna 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


5 Comments

Showing the location of the open TCP connections of my computer on a Web Map

I’ve been looking for more applications for the ip geolocation. so I wrote this small tool wich show the open remote tcp connections location on a Web Map (Google Maps, Bing Maps, Yahoo Maps and OpenStreetMap).

DISCLAIMER
This application is only for educational purposes. because some maps services does not allow to display content from a desktop application.

Check the screenshots samples

Showing the location of a ip address in Google Maps

Showing the location of a ip address in Yahoo Maps

Showing the location of a ip address in Bing Maps

Showing the location of a ip address in OpenStreet Maps

First we need obtain the current tcp connections, to do this we can use the GetExtendedTcpTable function wich is part of the iphlpapi.dll.

the header declaration goes like this

type
   TCP_TABLE_CLASS = Integer;

  PMibTcpRowOwnerPid = ^TMibTcpRowOwnerPid;
  TMibTcpRowOwnerPid  = packed record
    dwState     : DWORD;
    dwLocalAddr : DWORD;
    dwLocalPort : DWORD;
    dwRemoteAddr: DWORD;
    dwRemotePort: DWORD;
    dwOwningPid : DWORD;
    end;

  PMIB_TCPTABLE_OWNER_PID  = ^MIB_TCPTABLE_OWNER_PID;
  MIB_TCPTABLE_OWNER_PID = packed record
   dwNumEntries: DWord;
   table: array [0..ANY_SIZE - 1] OF TMibTcpRowOwnerPid;
  end;

var
   GetExtendedTcpTable:function  (pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL; lAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWord; stdcall;

To use this function we need to determine size of the TcpTable returned, to allocate the memory. (look the first parameter is set to nil)

      TableSize := 0;
      Error := GetExtendedTcpTable(nil, @TableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0);
      if Error <> ERROR_INSUFFICIENT_BUFFER then
         Exit;

Now in the TableSize variable we have the size of the TcpTable, so we can retrieve the tcp info passing in the first parameter the buffer to contain the data

var
FExtendedTcpTable : PMIB_TCPTABLE_OWNER_PID;

 GetMem(FExtendedTcpTable, TableSize);
 GetExtendedTcpTable(FExtendedTcpTable, @TableSize, TRUE, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0)

this is the full code to fill the listview with the tcp connections

procedure LoadTCPConnections;
var
   Server       : Cardinal;
   Error        : DWORD;
   TableSize    : DWORD;
   Snapshot     : THandle;
   i            : integer;
   ListItem     : TListItem;
   IpAddress    : in_addr;
   FCurrentPid  : Cardinal;
   IsLocal      : Boolean;
   RemoteIp     : string;
begin
   ListViewIPaddress.Items.BeginUpdate;
   try
     ListViewIPaddress.Items.Clear;
     FCurrentPid:=GetCurrentProcessId();
     FExternalIpAddress:=GetExternalIP;
      TableSize := 0;
      Error := GetExtendedTcpTable(nil, @TableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0);  //get the size of the TcpTable
      if Error <> ERROR_INSUFFICIENT_BUFFER then
         Exit;
      try
         GetMem(FExtendedTcpTable, TableSize);
         SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //take a Snapshot of the running process to obtain the exe name of the pid associated
         if GetExtendedTcpTable(FExtendedTcpTable, @TableSize, TRUE, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
            for i := 0 to FExtendedTcpTable.dwNumEntries - 1 do // for each record in the tcptable

            //avoid show connections of the current application and system connections (PID=0)
            if (FExtendedTcpTable.Table[i].dwOwningPid<>0) and (FExtendedTcpTable.Table[i].dwOwningPid<>FCurrentPid) and (FExtendedTcpTable.Table[i].dwRemoteAddr<>0) then
            begin
               IpAddress.s_addr := FExtendedTcpTable.Table[i].dwRemoteAddr;
               RemoteIp  := string(inet_ntoa(IpAddress));
               Server     :=  FExtendedTcpTable.Table[i].dwRemoteAddr;
               //determine if the remote ip is local or not
               IsLocal    := (FLocalIpAddresses.IndexOf(RemoteIp)>=0) or (Server=0) or (Server=16777343);

               if CheckBoxRemote.Checked and IsLocal then Continue;
               if FExtendedTcpTable.Table[i].dwRemoteAddr = 0 then
               FExtendedTcpTable.Table[i].dwRemotePort := 0;
               //Fill the Listview
               ListItem:=ListViewIPaddress.Items.Add;

               ListItem.ImageIndex:=-1;
               ListItem.Caption:=IntToStr(FExtendedTcpTable.Table[i].dwOwningPid);
               ListItem.SubItems.Add(GetPIDName(SnapShot,FExtendedTcpTable.Table[i].dwOwningPid));
               ListItem.SubItems.Add('TCP');
               ListItem.SubItems.Add(FLocalComputerName);

               IpAddress.s_addr := FExtendedTcpTable.Table[i].dwLocalAddr;
               ListItem.SubItems.Add(string(inet_ntoa(IpAddress))); //get the local ip address
               ListItem.SubItems.Add(IntToStr(ntohs(FExtendedTcpTable.Table[i].dwLocalPort)));

               ListItem.SubItems.AddObject('',Pointer(FExtendedTcpTable.Table[i].dwRemoteAddr));

               ListItem.SubItems.Add(RemoteIp);
               ListItem.SubItems.Add(IntToStr(ntohs(FExtendedTcpTable.Table[i].dwRemotePort)));
               ListItem.SubItems.Add(MIB_TCP_STATE[FExtendedTcpTable.Table[i].dwState]);

               ListItem.SubItems.Add('');
               ListItem.SubItems.Add('');
               ListItem.SubItems.Add('');
               ListItem.SubItems.Add('');
            end;

      finally
         FreeMem(FExtendedTcpTable);
      end;

   finally
    ListViewIPaddress.Items.EndUpdate;
   end;
    //now for resolve the server location and show the flag icon we run a tthread for each row in the listview
    for i:= 0 to ListViewIPaddress.Items.Count-1 do
    begin
      Server:=Cardinal(ListViewIPaddress.Items.Item[i].SubItems.Objects[COLUMN_RemoteServer]);
      IsLocal    := (FLocalIpAddresses.IndexOf(ListViewIPaddress.Items.Item[i].SubItems[COLUMN_RemoteIP])>=0) or (Server=0) or (Server=16777343);
      if not IsLocal then
        TResolveServerName.Create(Server,ListViewIPaddress.Items.Item[i].SubItems[COLUMN_RemoteIP],ImageList1,ListViewIPaddress.Items.Item[i]);
    end;
end;

The code of the thread for resolve the ip locations and retrieve the flags images.

type
   TResolveGeoLocation = class(TThread)
   private
     FListItem         : TListItem;
     FGeoInfo          : TGeoInfoClass;
     FRemoteHostName   : string;
     FRemoteIP         : string;
     FServer           : Cardinal;
     FImageList        : TImageList;
     procedure SetData;
   protected
     procedure Execute; override;
     constructor Create(Server : Cardinal;const RemoteIP:string;ImageList:TImageList;ListItem:TListItem);
   end;

constructor TResolveGeoLocation.Create(Server: Cardinal;const RemoteIP:string;ImageList:TImageList;ListItem:TListItem);
begin
   inherited Create(False);
   FServer   :=Server;
   FRemoteIP :=RemoteIP;
   FImageList:=ImageList;
   FListItem :=ListItem;
   FreeOnTerminate := True;
end;

procedure TResolveGeoLocation.Execute;
begin
  FreeOnTerminate := True;
  FRemoteHostName := GetRemoteHostName(FServer);
  FGeoInfo:=TGeoInfoClass.Create(FRemoteIP);
  try
   Synchronize(SetData);
  finally
   FGeoInfo.Free;
  end;
end;

procedure TResolveGeoLocation.SetData;
var
   Bitmap  : TBitmap;
begin
    FListItem.SubItems[COLUMN_RemoteServer]:=FRemoteHostName;
    FListItem.SubItems[COLUMN_Country]     :=FGeoInfo.GeoInfo.CountryName;
    FListItem.SubItems[COLUMN_City]        :=FGeoInfo.GeoInfo.City;
    FListItem.SubItems[COLUMN_Latitude]    :=FGeoInfo.GeoInfo.LatitudeToString;
    FListItem.SubItems[COLUMN_Longitude]   :=FGeoInfo.GeoInfo.LongitudeToString;

    if Assigned(FGeoInfo.GeoInfo.FlagImage) then
    begin
       Bitmap := TBitmap.Create;
      try
        Bitmap.Assign(FGeoInfo.GeoInfo.FlagImage);
        if (Bitmap.Width=FImageList.Width) and ((Bitmap.Height=FImageList.Height)) then
         FListItem.ImageIndex:=FImageList.Add(Bitmap,nil)
        else
         Bitmap.Width;
      finally
        Bitmap.Free;
      end;
    end;

    FListItem.MakeVisible(False);
end;

Now the class to obtain the geolocation info and the flag of the country.

type
 PGeoInfo   = ^TGeoInfo;
 TGeoInfo   = record
  Status        : string;
  CountryCode   : string;
  CountryName   : string;
  RegionCode    : string;
  City          : string;
  ZipPostalCode : string;
  Latitude      : Double;
  Longitude     : Double;
  TimezoneName  : string;
  Gmtoffset     : string;
  Isdst         : string;
  FlagImage     : TPngImage;
  function LatitudeToString:string;
  function LongitudeToString:string;
 end;

 TGeoInfoClass = class
 private
    FIpAddress : string;
    FGeoInfo   : TGeoInfo;
 public
  property  GeoInfo : TGeoInfo read FGeoInfo;
  constructor Create(IpAddress : string); overload;
  Destructor  Destroy; override;
 end;

and the new function to retrieve the geolocation data from ipinfodb.com

procedure GetGeoInfo(const IpAddress : string;var GeoInfo :TGeoInfo);
var
  XMLDoc        : OleVariant;
  ANode         : OleVariant;
  FormatSettings: TFormatSettings;
  d             : Double;
  Success       : HResult;
  UrlImage      : string;
  XmlContent    : string;
  StreamData    : TMemoryStream;
begin
  GeoInfo.FlagImage:=nil;
  Success := CoInitializeEx(nil, COINIT_MULTITHREADED);
  try
      XmlContent:=WinInet_HttpGet(Format(UrlGeoLookupInfo,[IpAddress]));
      if XmlContent<>'' then
      begin
          XMLDoc := CreateOleObject('Msxml2.DOMDocument.6.0');
          XMLDoc.async := false;
          XMLDoc.LoadXML(XmlContent);
          XMLDoc.setProperty('SelectionLanguage','XPath');
          ANode:=XMLDoc.selectSingleNode('/Response/Status');
          if not VarIsNull(ANode) then GeoInfo.Status:=ANode.Text;
          ANode:=XMLDoc.selectSingleNode('/Response/CountryCode');
          if not VarIsNull(ANode) then GeoInfo.CountryCode:=ANode.Text;
          ANode:=XMLDoc.selectSingleNode('/Response/CountryName');
          if not VarIsNull(ANode) then GeoInfo.CountryName:=ANode.Text;
          ANode:=XMLDoc.selectSingleNode('/Response/RegionCode');
          if not VarIsNull(ANode) then GeoInfo.RegionCode:=ANode.Text;
          ANode:=XMLDoc.selectSingleNode('/Response/City');
          if not VarIsNull(ANode) then GeoInfo.City:=ANode.Text;
          ANode:=XMLDoc.selectSingleNode('/Response/ZipPostalCode');
          if not VarIsNull(ANode) then GeoInfo.ZipPostalCode:=ANode.Text;

          ANode:=XMLDoc.selectSingleNode('/Response/Latitude');
          if not VarIsNull(ANode) then
          begin
            FormatSettings.DecimalSeparator:='.';
            d:=StrToFloat(ANode.Text,FormatSettings);
            GeoInfo.Latitude:=d;
          end;

          ANode:=XMLDoc.selectSingleNode('/Response/Longitude');
          if not VarIsNull(ANode) then
          begin
            FormatSettings.DecimalSeparator:='.';
            d:=StrToFloat(ANode.Text,FormatSettings);
            GeoInfo.Longitude:=d;
          end;

          ANode:=XMLDoc.selectSingleNode('/Response/TimezoneName');
          if not VarIsNull(ANode) then GeoInfo.TimezoneName:=ANode.Text;
          ANode:=XMLDoc.selectSingleNode('/Response/Gmtoffset');
          if not VarIsNull(ANode) then GeoInfo.Gmtoffset:=ANode.Text;
          ANode:=XMLDoc.selectSingleNode('/Response/Isdst');
          if not VarIsNull(ANode) then GeoInfo.Isdst:=ANode.Text;
      end;
  finally
    case Success of
      S_OK, S_FALSE: CoUninitialize;
    end;
  end;

  if GeoInfo.CountryCode<>'' then //get the image
  begin
    GeoInfo.FlagImage  := TPngImage.Create;
    StreamData         := TMemoryStream.Create;
    try
       UrlImage:=Format(UrlFlags,[LowerCase(GeoInfo.CountryCode)]);
          WinInet_HttpGet(UrlImage,StreamData);
          if StreamData.Size>0 then
          begin
            StreamData.Seek(0,0);
            try
              GeoInfo.FlagImage.LoadFromStream(StreamData);//load the image in a Stream
            except   //the image is not valid
              GeoInfo.FlagImage.Free;
              GeoInfo.FlagImage:=nil;
            end;
          end;
    finally
      StreamData.Free;
    end;
  end;

end;

The part of the maps is easy, just only need load a html page in a Twebbrowser with the Latitude and longitude to show in the current selected map

procedure GetMapListItem();
var
 HTMLWindow2  : IHTMLWindow2;
 MemoryStream : TMemoryStream;
 Item         : TListItem;
 Lat          : AnsiString;
 Lng          : AnsiString;
 Title        : AnsiString;
 MapType      : string;
 MapStr       : AnsiString;

//sorry , but the html pages contains a lot of % (porcent) chars
function ReplaceTag(const PageStr,Tag,NewValue:string):AnsiString;
begin
   Result:=AnsiString(StringReplace(PageStr,Tag,NewValue,[rfReplaceAll]));
end;

begin
    Item:=ListViewIPaddress.Selected;
    if not Assigned(Item) then  exit;
    if Item.SubItems.Count<COLUMN_Latitude then Exit;
    if Item.SubItems[COLUMN_Latitude]='' then Exit;

    Lat:=AnsiString(Item.SubItems[COLUMN_Latitude]);
    Lng:=AnsiString(Item.SubItems[COLUMN_Longitude]);
    Title:=AnsiString(Format('(%s,%s) %s - %s',[Lat,Lng,Item.SubItems[COLUMN_RemoteServer],Item.SubItems[COLUMN_RemoteIP]]));
    MapType:=ComboBoxTypes.Text;

   WebBrowser1.Navigate('about:blank');
   while WebBrowser1.ReadyState < READYSTATE_INTERACTIVE do
    Application.ProcessMessages;

    if Assigned(WebBrowser1.Document) then
    begin
      MemoryStream := TMemoryStream.Create;
      try
        case FCurrentMapType of
          Google_Maps    : MapStr:=GoogleMapsPage;
          Yahoo_Map      : MapStr:=YahooMapsPage;
          Bing_Map       : MapStr:=BingsMapsPage;
          Open_Streetmap : MapStr:=OpenStreetMapsPage;
        end;

        MapStr:=ReplaceTag(MapStr,'[Lat]',Lat);
        MapStr:=ReplaceTag(MapStr,'[Lng]',Lng);
        MapStr:=ReplaceTag(MapStr,'[Title]',Title);
        MapStr:=ReplaceTag(MapStr,'[Type]',MapType);
        MemoryStream.WriteBuffer(Pointer(MapStr)^, Length(MapStr));

        MemoryStream.Seek(0, soFromBeginning);
        (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(MemoryStream));
      finally
         MemoryStream.Free;
      end;
      HTMLWindow2 := (WebBrowser1.Document as IHTMLDocument2).parentWindow;
    end;
end;

and finally the html code embedded in a delphi const string for each map type

const
GoogleMapsPage: AnsiString =
'<html> '+
'<head> '+
'<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
'<script type="text/javascript" src="http://maps.google.com/maps/api/js?sensor=true"></script> '+
'<script type="text/javascript"> '+
'  var map;'+
'  function initialize() { '+
'    geocoder = new google.maps.Geocoder();'+
'    var latlng = new google.maps.LatLng([Lat],[Lng]); '+
'    var myOptions = { '+
'      zoom: 12, '+
'      center: latlng, '+
'      mapTypeId: google.maps.MapTypeId.[Type] '+
'    }; '+
'    map = new google.maps.Map(document.getElementById("map_canvas"), myOptions); '+
'    var marker = new google.maps.Marker({'+
'      position: latlng, '+
'      title: "[Title]", '+
'      map: map '+
'  });'+
'  } '+
''+'</script> '+
'</head> '+
'<body onload="initialize()"> '+
'  <div id="map_canvas" style="width:100%; height:100%"></div> '+
'</body>'+
'</html>';

YahooMapsPage: AnsiString =
'<html> '+
'<head> '+
'<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
'<script type="text/javascript" src="http://api.maps.yahoo.com/ajaxymap?v=3.8&amp;appid=08gJIU7V34H9WlTSGrIyEIb73GLT5TpAaF2HzOSJIuTO2AVn6qzftRPDQtcQyynObIG8"></script> '+
'<script type="text/javascript"> '+
'  function initialize() '+
'{'+
'  var map = new YMap ( document.getElementById ( "map_canvas" ) );'+
'  map.addTypeControl();'+
'  map.addZoomLong(); '+
'  map.addPanControl();'+
'	 map.setMapType ( YAHOO_MAP_[Type] );'+
'	 var geopoint = new YGeoPoint ( [Lat] , [Lng] ); '+
'	 map.drawZoomAndCenter ( geopoint , 5 );'+
'  var newMarker= new YMarker(geopoint); '+
'  var markerMarkup = "[Title]";'+
'	 newMarker.openSmartWindow(markerMarkup);'+
'	 map.addOverlay(newMarker);'+
'}'+
''+'</script> '+
'</head> '+
'<body onload="initialize()"> '+
'  <div id="map_canvas" style="width:100%; height:100%"></div> '+
'</body>'+
'</html>';

BingsMapsPage: AnsiString =
'<html> '+
'<head> '+
'<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
'<script type="text/javascript" src="http://dev.virtualearth.net/mapcontrol/mapcontrol.ashx?v=6.2"></script> '+
'<script type="text/javascript"> '+
'var map = null; '+
'  function initialize() '+
'{'+
'        map = new VEMap("map_canvas"); '+
'        map.LoadMap(new VELatLong([Lat],[Lng]), 10 ,"h" ,false);'+
'        map.SetMapStyle(VEMapStyle.[Type]);'+
'        map.ShowMiniMap((document.getElementById("map_canvas").offsetWidth - 180), 200, VEMiniMapSize.Small);'+
'        map.SetZoomLevel (12);'+
'	       shape = new VEShape(VEShapeType.Pushpin, map.GetCenter()); '+
'	       shape.SetTitle("[Title]");'+
'	       map.AddShape ( shape );'+
'}'+
''+'</script> '+
'</head> '+
'<body onload="initialize()"> '+
'  <div id="map_canvas" style="width:100%; height:100%"></div> '+
'</body>'+
'</html>';

OpenStreetMapsPage: AnsiString =
'<html> '+
'<head> '+
'<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
'<script src="http://www.openlayers.org/api/OpenLayers.js"></script> '+
'<script type="text/javascript"> '+
'  function initialize() '+
'{'+
'    map = new OpenLayers.Map("map_canvas");'+
'    map.addLayer(new OpenLayers.Layer.OSM()); '+
'    var lonLat = new OpenLayers.LonLat( [Lng] , [Lat] ) '+
'          .transform( '+
'            new OpenLayers.Projection("EPSG:4326"), '+
'            map.getProjectionObject() '+
'          ); '+
'    var zoom=16; '+
'    var markers = new OpenLayers.Layer.Markers( "Markers" );  '+
'    map.addLayer(markers); '+
'    markers.addMarker(new OpenLayers.Marker(lonLat)); '+
'    map.setCenter (lonLat, zoom); '+
'}'+
''+'</script> '+
'</head> '+
'<body onload="initialize()"> '+
'  <div id="map_canvas" style="width:100%; height:100%"></div> '+
'</body>'+
'</html>';

Download the full sourcecode from here and enjoy

(compiled under delphi XE)


7 Comments

Building a traceroute application with IP geolocation using delphi

Using the free service of ip geolocation provided by http://ipinfodb.com/ , you can do very cool things.

See this sample wich intregrates a trace route and the ip geolocation, to obtain the location of every server included in the trace of an ip address.

First we define the stucture to contain the geolocation data

type
 TGeoInfo   = record
  Status        : string;
  CountryCode   : string;
  CountryName   : string;
  RegionCode    : string;
  City          : string;
  ZipPostalCode : string;
  Latitude      : double;
  Longitude     : double;
  TimezoneName  : string;
  Gmtoffset     : string;
  Isdst         : string;
  function LatitudeToString:string;
  function LongitudeToString:string;
 end;

function TGeoInfo.LatitudeToString: string; //this helper function retrieve the latitute as a string, forcing the decimal separator to a dot
var
  FormatSettings: TFormatSettings;
begin
  FormatSettings.DecimalSeparator:='.';
  result:=FloatToStr(Latitude,FormatSettings);
end;

function TGeoInfo.LongitudeToString: string;//this helper function retrieve the longitude as a string, forcing the decimal separator to a dot
var
  FormatSettings: TFormatSettings;
begin
  FormatSettings.DecimalSeparator:='.';
  result:=FloatToStr(Longitude,FormatSettings);
end;

Now the function to retrieve the geolocation, the url was updated to use the new api published the 2010-11-15.

const
//the key used in this link if only for demo purposes, create your own free key registering in http://ipinfodb.com/
 UrlGeoLookupInfo  ='http://api.ipinfodb.com/v2/ip_query.php?key=a069ef201ef4c1b61231b3bdaeb797b5488ef879effb23d269bda3a572dc704c&ip=%s&timezone=true';

procedure GetGeoInfo(const IpAddress : string;var GeoInfo :TGeoInfo);
var
  lHTTP         : TIdHTTP;
  lStream       : TStringStream;
  XMLDoc        : OleVariant;
  ANode         : OleVariant;
  FormatSettings: TFormatSettings;
  d             : Double;
  Success       : HResult;
begin
  lHTTP   := TIdHTTP.Create(nil);
  lStream := TStringStream.Create('');
  Success := CoInitializeEx(nil, COINIT_MULTITHREADED);//necesary to support MULTITHREAD
  try
      lHTTP.Get(Format(UrlGeoLookupInfo,[IpAddress]), lStream);
      lStream.Seek(0,soFromBeginning);
      XMLDoc := CreateOleObject('Msxml2.DOMDocument.6.0');
      XMLDoc.async := false;
      XMLDoc.LoadXML(lStream.ReadString(lStream.Size));
      XMLDoc.setProperty('SelectionLanguage','XPath');
      ANode:=XMLDoc.selectSingleNode('/Response/Status');
      if not VarIsNull(ANode) then GeoInfo.Status:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/CountryCode');
      if not VarIsNull(ANode) then GeoInfo.CountryCode:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/CountryName');
      if not VarIsNull(ANode) then GeoInfo.CountryName:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/RegionCode');
      if not VarIsNull(ANode) then GeoInfo.RegionCode:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/City');
      if not VarIsNull(ANode) then GeoInfo.City:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/ZipPostalCode');
      if not VarIsNull(ANode) then GeoInfo.ZipPostalCode:=ANode.Text;

      ANode:=XMLDoc.selectSingleNode('/Response/Latitude');
      if not VarIsNull(ANode) then
      begin
        FormatSettings.DecimalSeparator:='.';
        d:=StrToFloat(ANode.Text,FormatSettings);
        GeoInfo.Latitude:=d;
      end;

      ANode:=XMLDoc.selectSingleNode('/Response/Longitude');
      if not VarIsNull(ANode) then
      begin
        FormatSettings.DecimalSeparator:='.';
        d:=StrToFloat(ANode.Text,FormatSettings);
        GeoInfo.Longitude:=d;
      end;

      ANode:=XMLDoc.selectSingleNode('/Response/TimezoneName');
      if not VarIsNull(ANode) then GeoInfo.TimezoneName:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/Gmtoffset');
      if not VarIsNull(ANode) then GeoInfo.Gmtoffset:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/Isdst');
      if not VarIsNull(ANode) then GeoInfo.Isdst:=ANode.Text;
  finally
    lHTTP.Free;
    lStream.Free;
    case Success of
      S_OK, S_FALSE: CoUninitialize;
    end;
  end;
end;

Now using the IcmpCreateFile,IcmpCloseHandle and IcmpSendEcho functions we can write a trace route function.

function IcmpCreateFile: THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';
function IcmpCloseHandle(IcmpHandle: THandle): BOOL; stdcall;  external 'ICMP.DLL' name 'IcmpCloseHandle';
function IcmpSendEcho(IcmpHandle : THandle; DestinationAddress: Longint;  RequestData: Pointer; RequestSize: Word; RequestOptions: PIP_option_information; ReplyBuffer: Pointer; ReplySize, Timeout: DWORD): DWORD; stdcall;  external 'ICMP.DLL' name 'IcmpSendEcho';

Check the definition of the TGeoTraceThread TThread

  ProcTraceCallBack    = procedure(const ServerName,ServerIp:string) of object;
  ProcTraceLogCallBack = procedure(const Msg:string) of object;
  TGeoTraceThread = class(TThread)
  private
    DestAddr            : in_addr;
    TraceHandle         : THandle;
    FDestAddress        : string;
    FLogString          : string;
    FIcmpTimeOut        : Word;
    FMaxHops            : Word;
    FResolveHostName    : boolean;
    FServerCallBack     : string;
    FServerIpCallBack   : string;
    FCallBack           : ProcTraceCallBack;
    FLogCallBack        : ProcTraceLogCallBack;
    FIncludeGeoInfo     : boolean;
    FGeoInfo            : TGeoInfo;
    function  Trace(const Ttl: Byte): Longint;
    procedure Log;
    procedure IntCallBack;
  public
    procedure Execute; override;
    property  MaxHops : Word read FMaxHops write FMaxHops default 30;
    property  DestAddress : string read FDestAddress write FDestAddress;
    property  IcmpTimeOut : Word read FIcmpTimeOut write FIcmpTimeOut default 5000;
    property  ResolveHostName : boolean read FResolveHostName write FResolveHostName default True;
    property  IncludeGeoInfo : boolean read FIncludeGeoInfo write FIncludeGeoInfo default True;
    property  CallBack : ProcTraceCallBack read FCallBack write FCallBack;
    property  MsgCallBack : ProcTraceLogCallBack read FLogCallBack write FLogCallBack;
  end;

and now the implementation of the TGeoTraceThread TThread, the code was commented to explain the logic of the trace route.

procedure TGeoTraceThread.Execute;
const
  MaxPings = 3;
var
  HostName   : String;
  HostReply  : Boolean;
  HostIP     : LongInt;
  HostEnt    : PHostEnt;
  WSAData    : TWSAData;
  WsaErr     : DWORD;
  OldTick    : DWORD;
  PingTime   : DWORD;
  TraceResp  : Longint;
  Index      : Word;
  FCurrentTTL: Word;
  sValue     : string;
  FGeoInfoStr: string;
  IpAddress  : in_addr;
begin

  WsaErr := WSAStartup($101, WSAData);
  if WsaErr <> 0 then
  begin
    FLogString := SysErrorMessage(WSAGetLastError);
    if Assigned(FLogCallBack)then Synchronize(Log);
    Exit;
  end;

  try
    HostEnt := gethostbyname(PAnsiChar(AnsiString(FDestAddress))); //get the host to trace
    if not Assigned(HostEnt) then
    begin
      FLogString := SysErrorMessage(WSAGetLastError);
      if Assigned(FLogCallBack) then Synchronize(Log);
      Exit;
    end;

    DestAddr     := PInAddr(in_addr(HostEnt.h_addr_list^))^; //get the address of the host to trace
    TraceHandle := IcmpCreateFile;

    if TraceHandle = INVALID_HANDLE_VALUE then
    begin
      FLogString := SysErrorMessage(GetLastError);
      if Assigned(FLogCallBack) then Synchronize(Log);
      Exit;
    end;

    try

      if Assigned(FLogCallBack)then //check if the callback function to log the data is assigned
      begin
        FLogString := Format('Tracing route to %s [%s]',[FDestAddress,string(inet_ntoa(DestAddr))]);
        Synchronize(Log); //Log the data
        FLogString := Format('over a maximum of %d hops ',[FMaxHops]);
        Synchronize(Log);//log the data
      end;

      TraceResp    := 0;
      FCurrentTTL  := 0;

      while (TraceResp <> DestAddr.S_addr) and (FCurrentTTL < FMaxHops) do //begin the trace
      begin
        Inc(FCurrentTTL);
        HostReply := False;
        sValue:='';
        for Index := 0 to MaxPings-1 do // make 3 pings to the current host
        begin
          OldTick   := GetTickCount; //save the current time
          TraceResp := Trace(FCurrentTTL); //do the trace

          if TraceResp = -1 then //check for the response of the trace, -1 indicate a request time-out
            FLogString := '    *    '
          else
          begin
            PingTime   :=GetTickCount - OldTick; //calculate the elapsed time in ms

            if PingTime>0 then
             FLogString := Format('%6d ms', [PingTime])
            else
             FLogString := Format('    <%d ms', [1]);

            HostReply := True;
            HostIP    := TraceResp;
          end;

          if Index = 0 then
            FLogString := Format('%3d %s', [FCurrentTTL, FLogString]);

          sValue:=sValue+FLogString;
        end;

        FLogString:=sValue+' ';

        if HostReply then
        begin
          IpAddress.s_addr :=HostIP;
          sValue :=string(inet_ntoa(IpAddress)); //get the ip address (x.x.x.x) of the current host

          FGeoInfoStr:='';
          if FIncludeGeoInfo then //makes the magic now
          begin
            GetGeoInfo(sValue,FGeoInfo); //get the geolocation info about the current host
            FGeoInfoStr:=Format('(%s,%s) %s-%s TimeZone %s',[FGeoInfo.LongitudeToString,FGeoInfo.LatitudeToString,FGeoInfo.CountryName,FGeoInfo.City,FGeoInfo.TimezoneName]); //construct the string to log the data
          end;

          FServerCallBack  :='';
          FServerIpCallBack:=sValue;
          if FResolveHostName then //only if the property ResolveHostName is Tru try to resolve the current host name
          begin
            HostName         := GetRemoteHostName(HostIP);
            FServerCallBack  := HostName;
            if HostName <> '' then
              FLogString := FLogString + HostName + ' [' + sValue + '] '+FGeoInfoStr
            else
              FLogString := FLogString + sValue +' '+ FGeoInfoStr;
          end
          else
          FLogString := FLogString + sValue+' '+ FGeoInfoStr;

          if Assigned(FCallBack) then Synchronize(IntCallBack);
        end
        else
          FLogString := FLogString+' Request timed out.';

        FLogString := '  ' + FLogString;
        if Assigned(FLogCallBack) then Synchronize(Log);
      end;

    finally
      IcmpCloseHandle(TraceHandle);
    end;

    if Assigned(FLogCallBack) then
    begin
      FLogString := 'Trace complete'; //we are done
      Synchronize(Log);
    end;

  finally
    WSACleanup;
  end;
end;

function TGeoTraceThread.Trace(const Ttl: Byte): Longint;
var
  IPOptionInfo: TIPOptionInformation;
  IcmpEcho    : PIcmpEchoReply;
  IcpmErr     : Integer;
begin
  GetMem(IcmpEcho, SizeOf(TIcmpEchoReply));
  try
    IPOptionInfo.Ttl         := Ttl;
    IPOptionInfo.Tos         := 0;
    IPOptionInfo.Flags       := 0;
    IPOptionInfo.OptionsSize := 0;
    IPOptionInfo.OptionsData := nil;

    IcpmErr := IcmpSendEcho(TraceHandle,DestAddr.S_addr,nil,0,@IPOptionInfo,IcmpEcho,SizeOf(TIcmpEchoReply),FIcmpTimeOut); //send the echo request and wait for any echo response replies
    if IcpmErr = 0 then //check for the reply
    begin
      Result := -1;
      Exit;
    end;
    Result := IcmpEcho.Address;
  finally
    FreeMem(IcmpEcho); //dispose the memory allocated
  end;
end;

procedure TGeoTraceThread.IntCallBack; //this callback function report the current server name and ip address
begin
  FCallBack(FServerCallBack,FServerIpCallBack);
end;

procedure TGeoTraceThread.Log; //this callback log the data
begin
  FLogCallBack(FLogString);
end;

finally you can call the the TGeoTraceThread class in this way

procedure TFrmMainTrace.TraceAddress;
var
  Trace : TGeoTraceThread;
begin
    if Trim(EditAddress.Text)='' then  Exit;
    Trace:=TGeoTraceThread.Create(True);
    Trace.FreeOnTerminate    :=True;
    Trace.DestAddress        :=EditAddress.Text;
    Trace.MaxHops            :=30; //hops
    Trace.ResolveHostName    :=True;
    Trace.IcmpTimeOut        :=5000; //timeout in ms
    Trace.MsgCallBack        :=TraceLogCallBack; //assign the callback
    Trace.IncludeGeoInfo     :=True; //set this property true option to display the geoloccation info result in the trace
    Trace.Start;
end;

procedure TFrmMainTrace.TraceLogCallBack(const Msg: string);
begin
  MemoTrace.Lines.Add(Msg);
  MemoTrace.Perform(WM_VSCROLL, SB_BOTTOM, 0);
end;

and the output look like this, check which the trace includes the latitude, longitude, timezone, country and city for each host included in the trace.

Tracing route to theroadtodelphi.wordpress.com [76.74.254.123]
over a maximum of 30 hops
    1     16 ms    <1 ms    <1 ms DD-WRT [192.168.1.2] (0,0) Reserved- TimeZone
    2     16 ms    <1 ms    16 ms 10.9.90.1 (0,0) Reserved- TimeZone
    3     <1 ms    16 ms    <1 ms sblx12gw.gtdinternet.com [190.196.63.126] (-70.6667,-33.45) Chile-Santiago TimeZone Chile/Continental
    4     <1 ms    16 ms    <1 ms 190.196.125.185 (-70.6667,-33.45) Chile-Santiago TimeZone Chile/Continental
    5     <1 ms    16 ms    <1 ms ci1.te1-2.v218.cn1.gtdinternet.com [190.196.124.74] (-70.6667,-33.45) Chile-Santiago TimeZone Chile/Continental
    6     <1 ms    16 ms    <1 ms ci2.te1-1.ci1.gtdinternet.com [201.238.238.26] (-70.6667,-33.45) Chile-Santiago TimeZone Chile/Continental
    7     16 ms    <1 ms    15 ms ge13-0-0.santiago2.san.seabone.net [195.22.221.85] (-70.6667,-33.45) Chile-Santiago TimeZone Chile/Continental
    8     *        *        *      Request timed out.
    9    109 ms   125 ms   109 ms pos0-15-1-0.miami13.mia.seabone.net [195.22.221.205] (-70.6667,-33.45) Chile-Santiago TimeZone Chile/Continental
   10    125 ms   109 ms   125 ms te7-2.miami7.mia.seabone.net [195.22.199.111] (-80.2939,25.7615) United States-Miami TimeZone America/New_York
   11    172 ms   187 ms   171 ms te-7-4.car2.Miami1.Level3.net [63.209.150.165] (-97,38) United States- TimeZone
   12    188 ms   187 ms   187 ms ae-31-51.ebr1.Miami1.Level3.net [4.69.138.94] (-97,38) United States- TimeZone
   13    172 ms   187 ms   171 ms ae-2-2.ebr1.Dallas1.Level3.net [4.69.140.133] (-97,38) United States- TimeZone
   14    171 ms   203 ms   187 ms ae-3-80.edge9.Dallas1.Level3.net [4.69.145.144] (-97,38) United States- TimeZone
   15    188 ms   171 ms   187 ms PEER-1-NETW.edge9.Dallas1.Level3.net [4.59.118.6] (-95.7402,29.1793) United States-West Columbia TimeZone America/Chicago
   16     *        *        *      Request timed out.
   17     *        *        *      Request timed out.
   18    187 ms   188 ms   187 ms wordpress.com [76.74.254.123] (-98.5353,29.4713) United States-San Antonio TimeZone America/Chicago
Trace complete

Download the source code from here

(the demo project was compiled under Delphi XE, but the TGeoTraceThread class can be used with older versions of delphi i tested with 2007 to XE)


9 Comments

Getting IP address geolocation info with delphi

ipinfodb.com provides a free service wich let you obtain geolocation info about any ip address. you can access this info parsing the content returned by this page.

the request must be done in this way

http://ipinfodb.com/ip_query.php?timezone=true&ip=204.236.220.71

UPDATE

The above url is not longer valid because to a New APIs are being introduced with API key. you must register in this site to get access to the info.

now you must use a url like this

http://api.ipinfodb.com/v2/ip_query.php?key=&ip=74.125.45.100&timezone=true

and the response look like this

<Response>
<Ip>204.236.220.71</Ip>
<Status>OK</Status>
<CountryCode>US</CountryCode>
<CountryName>United States</CountryName>
<RegionCode>53</RegionCode>
<RegionName>Washington</RegionName>
<City>Seattle</City>
<ZipPostalCode>98144</ZipPostalCode>
<Latitude>47.5839</Latitude>
<Longitude>-122.299</Longitude>
<TimezoneName>America/Los_Angeles</TimezoneName>
<Gmtoffset>-28800</Gmtoffset>
<Isdst>0</Isdst>
</Response>

Now using a TIdHTTP component you can get the result of the request to this page.

uses
  Classes,
  ComObj,
  Variants,
  IdHTTP,

type
 TGeoInfo   = record
  Status        : string;
  CountryCode   : string;
  CountryName   : string;
  RegionCode    : string;
  City          : string;
  ZipPostalCode : string;
  Latitude      : string;
  Longitude     : string;
  TimezoneName  : string;
  Gmtoffset     : string;
  Isdst         : string;
 end;

const
 UrlGeoLookupInfo  ='http://ipinfodb.com/ip_query.php?timezone=true&ip=%s';
 UrlGeoLookupInfo2 ='http://backup.ipinfodb.com/ip_query.php?timezone=true&ip=%s'; //backup server

procedure GetGeoInfo(const IpAddress : string;var GeoInfo :TGeoInfo);
var
  lHTTP  : TIdHTTP;
  lStream: TStringStream;
  XMLDoc : OleVariant;
  ANode  : OleVariant;
begin
  lHTTP   := TIdHTTP.Create(nil);
  lStream := TStringStream.Create;
  try
      try
        lHTTP.Get(Format(UrlGeoLookupInfo,[IpAddress]), lStream); //get the request
      except
        lHTTP.Get(Format(UrlGeoLookupInfo2,[IpAddress]), lStream); //if something is wrong try using the backup server.
      end;
      lStream.Seek(0,0);
      XMLDoc := CreateOleObject('Msxml2.DOMDocument.6.0');
      XMLDoc.async := false;
      XMLDoc.LoadXML(lStream.ReadString(lStream.Size));
      XMLDoc.setProperty('SelectionLanguage','XPath');//use XPath to parse the xml result
      ANode:=XMLDoc.selectSingleNode('/Response/Status');
      if not VarIsNull(ANode) then GeoInfo.Status:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/CountryCode');
      if not VarIsNull(ANode) then GeoInfo.CountryCode:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/CountryName');
      if not VarIsNull(ANode) then GeoInfo.CountryName:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/RegionCode');
      if not VarIsNull(ANode) then GeoInfo.RegionCode:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/City');
      if not VarIsNull(ANode) then GeoInfo.City:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/ZipPostalCode');
      if not VarIsNull(ANode) then GeoInfo.ZipPostalCode:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/Latitude');
      if not VarIsNull(ANode) then GeoInfo.Latitude:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/Longitude');
      if not VarIsNull(ANode) then GeoInfo.Longitude:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/TimezoneName');
      if not VarIsNull(ANode) then GeoInfo.TimezoneName:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/Gmtoffset');
      if not VarIsNull(ANode) then GeoInfo.Gmtoffset:=ANode.Text;
      ANode:=XMLDoc.selectSingleNode('/Response/Isdst');
      if not VarIsNull(ANode) then GeoInfo.Isdst:=ANode.Text;
  finally
    lHTTP.Free;
    lStream.Free;
  end;
end;


4 Comments

Delphi : Enumerating Remote Desktop Servers in a network domain

using the WinApi WTSEnumerateServers function you can get a list of all Remote Desktop Servers in a network domain.

check the code. tested in Delphi 2007, Delphi 2010, Delphi XE – (Windows Xp, Windows 7, Windows 2008 Server)

program GetRemoteDesktops;

{$APPTYPE CONSOLE}

type
PWTS_SERVER_INFO = ^WTS_SERVER_INFO;
_WTS_SERVER_INFO = packed record
pServerName:LPTSTR;
end;
WTS_SERVER_INFO = _WTS_SERVER_INFO;
WTS_SERVER_INFO_Array  = Array [0..0] of WTS_SERVER_INFO;
PWTS_SERVER_INFO_Array =^WTS_SERVER_INFO_Array;

{$IFDEF UNICODE}
function WTSEnumerateServers( pDomainName: LPTSTR; Reserved: DWORD; Version: DWORD; ppServerInfo: PWTS_SERVER_INFO; pCount: PDWORD):BOOLEAN; stdcall; external 'wtsapi32.dll'  name 'WTSEnumerateServersW';
{$ELSE}
function WTSEnumerateServers( pDomainName: LPTSTR; Reserved: DWORD; Version: DWORD; ppServerInfo: PWTS_SERVER_INFO; pCount: PDWORD):BOOLEAN; stdcall; external 'wtsapi32.dll'  name 'WTSEnumerateServersA';
{$ENDIF}
procedure WTSFreeMemory(pMemory:Pointer);stdcall; external 'wtsapi32.dll' name 'WTSFreeMemory';

procedure GetRemoteDesktopsList(const Domain:PChar;const Servers:TStrings);
var
ppServerInfo : PWTS_SERVER_INFO_Array;//PWTS_SERVER_INFO;
pCount       : DWORD;
i            : integer;
begin
  Servers.Clear;
  ppServerInfo:=nil;
  try
    if WTSEnumerateServers(Domain,0,1,PWTS_SERVER_INFO(@ppServerInfo),@pCount) then
      for i := 0 to pCount - 1 do
        Servers.Add(ppServerInfo^[i].pServerName)
    else
    Raise Exception.Create(SysErrorMessage(GetLastError));
  finally
    if ppServerInfo<>nil then
    WTSFreeMemory(ppServerInfo);
  end;
end;


8 Comments

Checking if a TCP port is Open using Delphi and Winsocks

Many times we need to know if a TCP port is open or not, here I leave a function to perform this task using winsock.

Code tested in Delphi 7, 2007 and 2010.


uses
  Winsock;

function PortTCP_IsOpen(dwPort : Word; ipAddressStr:AnsiString) : boolean;
var
  client : sockaddr_in;
  sock   : Integer;

  ret    : Integer;
  wsdata : WSAData;
begin
 Result:=False;
 ret := WSAStartup($0002, wsdata); //initiates use of the Winsock DLL
  if ret<>0 then exit;
  try
    client.sin_family      := AF_INET;  //Set the protocol to use , in this case (IPv4)
    client.sin_port        := htons(dwPort); //convert to TCP/IP network byte order (big-endian)
    client.sin_addr.s_addr := inet_addr(PAnsiChar(ipAddressStr));  //convert to IN_ADDR  structure
    sock  :=socket(AF_INET, SOCK_STREAM, 0);    //creates a socket
    Result:=connect(sock,client,SizeOf(client))=0;  //establishes a connection to a specified socket
  finally
  WSACleanup;
  end;
end;

see this sample of usage

begin
 if PortTCP_IsOpen(3306,'127.0.0.1') then 
  DoMyStuff();
end;


12 Comments

Detecting Wifi Networks Using Delphi and Native Wifi API

Today we will use the Native Wifi API and Delphi to enumerate all Wifi Networks availables. In this link you can find a translation of the headers.
I wrote this code using these headers. Tested in Delphi 2007 and Windows Vista.

Try this link for a fixed and updated version of the Native Wifi Delphi headers.

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  nduWlanAPI   in 'nduWlanAPI.pas',
  nduWlanTypes in 'nduWlanTypes.pas';

function DOT11_AUTH_ALGORITHM_To_String( Dummy :Tndu_DOT11_AUTH_ALGORITHM):AnsiString;
begin
    Result:='';
    case Dummy of
        DOT11_AUTH_ALGO_80211_OPEN          : Result:= '80211_OPEN';
        DOT11_AUTH_ALGO_80211_SHARED_KEY    : Result:= '80211_SHARED_KEY';
        DOT11_AUTH_ALGO_WPA                 : Result:= 'WPA';
        DOT11_AUTH_ALGO_WPA_PSK             : Result:= 'WPA_PSK';
        DOT11_AUTH_ALGO_WPA_NONE            : Result:= 'WPA_NONE';
        DOT11_AUTH_ALGO_RSNA                : Result:= 'RSNA';
        DOT11_AUTH_ALGO_RSNA_PSK            : Result:= 'RSNA_PSK';
        DOT11_AUTH_ALGO_IHV_START           : Result:= 'IHV_START';
        DOT11_AUTH_ALGO_IHV_END             : Result:= 'IHV_END';
    end;
end;

function DOT11_CIPHER_ALGORITHM_To_String( Dummy :Tndu_DOT11_CIPHER_ALGORITHM):AnsiString;
begin
    Result:='';
    case Dummy of
  	DOT11_CIPHER_ALGO_NONE      : Result:= 'NONE';
    DOT11_CIPHER_ALGO_WEP40     : Result:= 'WEP40';
    DOT11_CIPHER_ALGO_TKIP      : Result:= 'TKIP';
    DOT11_CIPHER_ALGO_CCMP      : Result:= 'CCMP';
    DOT11_CIPHER_ALGO_WEP104    : Result:= 'WEP104';
    DOT11_CIPHER_ALGO_WPA_USE_GROUP : Result:= 'WPA_USE_GROUP OR RSN_USE_GROUP';
    //DOT11_CIPHER_ALGO_RSN_USE_GROUP : Result:= 'RSN_USE_GROUP';
    DOT11_CIPHER_ALGO_WEP           : Result:= 'WEP';
    DOT11_CIPHER_ALGO_IHV_START     : Result:= 'IHV_START';
    DOT11_CIPHER_ALGO_IHV_END       : Result:= 'IHV_END';
    end;
end;

procedure Scan();
const
WLAN_AVAILABLE_NETWORK_INCLUDE_ALL_ADHOC_PROFILES =$00000001;
var
  hClient              : THandle;
  dwVersion            : DWORD;
  ResultInt            : DWORD;
  pInterface           : Pndu_WLAN_INTERFACE_INFO_LIST;
  i                    : Integer;
  j                    : Integer;
  pAvailableNetworkList: Pndu_WLAN_AVAILABLE_NETWORK_LIST;
  pInterfaceGuid       : PGUID;
  SDummy               : AnsiString;
begin
  ResultInt:=WlanOpenHandle(1, nil, @dwVersion, @hClient);
   try
    if  ResultInt<> ERROR_SUCCESS then
    begin
       WriteLn('Error Open CLient'+IntToStr(ResultInt));
       Exit;
    end;

    ResultInt:=WlanEnumInterfaces(hClient, nil, @pInterface);
    if  ResultInt<> ERROR_SUCCESS then
    begin
       WriteLn('Error Enum Interfaces '+IntToStr(ResultInt));
       exit;
    end;

    for i := 0 to pInterface^.dwNumberOfItems - 1 do
    begin
     Writeln('Interface       ' + pInterface^.InterfaceInfo[i].strInterfaceDescription);
     WriteLn('GUID            ' + GUIDToString(pInterface^.InterfaceInfo[i].InterfaceGuid));
     Writeln('');
     pInterfaceGuid:= @pInterface^.InterfaceInfo[pInterface^.dwIndex].InterfaceGuid;

        ResultInt:=WlanGetAvailableNetworkList(hClient,pInterfaceGuid,WLAN_AVAILABLE_NETWORK_INCLUDE_ALL_ADHOC_PROFILES,nil,pAvailableNetworkList);
        if  ResultInt<> ERROR_SUCCESS then
        begin
           WriteLn('Error WlanGetAvailableNetworkList '+IntToStr(ResultInt));
           Exit;
        end;

          for j := 0 to pAvailableNetworkList^.dwNumberOfItems - 1 do
          Begin
             WriteLn(Format('Profile         %s',[WideCharToString(pAvailableNetworkList^.Network[j].strProfileName)]));
             SDummy:=PAnsiChar(@pAvailableNetworkList^.Network[j].dot11Ssid.ucSSID);
             WriteLn(Format('NetworkName     %s',[SDummy]));
             WriteLn(Format('Signal Quality  %d ',[pAvailableNetworkList^.Network[j].wlanSignalQuality])+'%');
             //SDummy := GetEnumName(TypeInfo(Tndu_DOT11_AUTH_ALGORITHM),integer(pAvailableNetworkList^.Network[j].dot11DefaultAuthAlgorithm)) ;
             SDummy:=DOT11_AUTH_ALGORITHM_To_String(pAvailableNetworkList^.Network[j].dot11DefaultAuthAlgorithm);
             WriteLn(Format('Auth Algorithm  %s ',[SDummy]));
             SDummy:=DOT11_CIPHER_ALGORITHM_To_String(pAvailableNetworkList^.Network[j].dot11DefaultCipherAlgorithm);
             WriteLn(Format('Auth Algorithm  %s ',[SDummy]));
             Writeln('');
          End;
    end;
   finally
    WlanCloseHandle(hClient, nil);
   end;
end;
begin
  try
    Scan();
    Readln;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.
ScanWifi Image

ScanWifi Image

Follow

Get every new post delivered to your Inbox.

Join 589 other followers