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&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>';
The Road to Delphi 