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
Check the source code on Github
(The demo project was compiled under Delphi XE, but the TGeoTraceThread class can be used with older versions of Delphi)
November 17, 2010 at 3:32 am
Very good, thank you for sharing!!
November 17, 2010 at 6:58 am
Did you accidentally publish your API key? ;-)
November 17, 2010 at 8:03 am
No tondrej, i created a demo account in http://ipinfodb.com/ to use this key in my blog posts.
November 17, 2010 at 8:19 am
Good to know. :-)
Nice example, thank you!
August 22, 2011 at 10:47 am
Exactly what I was looking for! Just need some improvements that I have no time for. Some things like implementing tracert’s command line switches, break/stop button and so on … anyhow thank you for sharing …
April 6, 2012 at 3:21 am
This is fantastic! I tweaked the message callback and pass the ThreadID of the thread so that you can run a few traces in parallel.
Pingback: VolvoxSoft — Service de localisation IP