
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6307 8e941d3f-bd1b-0410-a28a-d453659cc2b4
198 lines
4.7 KiB
ObjectPascal
198 lines
4.7 KiB
ObjectPascal
{ Map Viewer Geolocation Engine for geonames.org
|
|
|
|
Copyright (C) 2011 Maciej Kaczkowski / keit.co
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public License
|
|
along with this library; if not, write to the Free Software Foundation,
|
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
}
|
|
unit mvGeoNames;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, StrUtils,
|
|
mvTypes, mvDownloadEngine;
|
|
|
|
type
|
|
TNameFoundEvent = procedure (const AName: string; const ADescr: String;
|
|
const ALoc: TRealPoint) of object;
|
|
|
|
TStringArray = array of string;
|
|
|
|
{ TMVGeoNames }
|
|
|
|
TMVGeoNames = class(TComponent)
|
|
private
|
|
FLocationName: string;
|
|
FOnNameFound: TNameFoundEvent;
|
|
function RemoveTag(const str: String): TStringArray;
|
|
public
|
|
function DoSearch(dl : TCustomDownloadEngine): TRealPoint;
|
|
published
|
|
property LocationName: string read FLocationName write FLocationName;
|
|
property OnNameFound : TNameFoundEvent read FOnNameFound write FOnNameFound;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
|
|
implementation
|
|
|
|
function CleanLocationName(x: string): string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 1 to Length(x) do
|
|
begin
|
|
if x[i] in ['A'..'Z', 'a'..'z', '0'..'9'] then
|
|
Result := Result + x[i]
|
|
else
|
|
Result := Result + '+'
|
|
end;
|
|
end;
|
|
|
|
{ TMVGeoNames }
|
|
|
|
Type
|
|
TResRec = record
|
|
Name : String;
|
|
Descr : String;
|
|
Loc : TRealPoint;
|
|
End;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Maps',[TMVGeoNames]);
|
|
end;
|
|
|
|
function TMVGeoNames.RemoveTag(Const str : String) : TStringArray;
|
|
var iStart,iEnd,i : Integer;
|
|
tmp : String;
|
|
lst : TStringList;
|
|
Begin
|
|
SetLength(Result,0);
|
|
tmp:=StringReplace(str,'<br>',#13,[rfReplaceall]);
|
|
tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]);
|
|
tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]);
|
|
repeat
|
|
iEnd:=-1;
|
|
iStart:=pos('<',tmp);
|
|
if iStart>0 then
|
|
Begin
|
|
iEnd:=posEx('>',tmp,iStart);
|
|
if iEnd>0 then
|
|
Begin
|
|
tmp:=copy(tmp,1,iStart-1)+copy(tmp,iEnd+1,length(tmp));
|
|
end;
|
|
end;
|
|
until iEnd<=0;
|
|
lst:=TStringList.Create;
|
|
try
|
|
lst.Text:=tmp;
|
|
SetLEngth(Result,lst.Count);
|
|
For i:=0 to pred(lst.Count) do
|
|
Result[i]:=trim(lst[i]);
|
|
finally
|
|
freeAndNil(lst);
|
|
end;
|
|
|
|
end;
|
|
|
|
function TMVGeoNames.DoSearch(dl: TCustomDownloadEngine): TRealPoint;
|
|
const
|
|
LAT_ID = '<span class="latitude">';
|
|
LONG_ID = '<span class="longitude">';
|
|
var
|
|
s: string;
|
|
|
|
function gs(id: string;Start : integer): string;
|
|
var
|
|
i: Integer;
|
|
ln: Integer;
|
|
begin
|
|
Result := '';
|
|
ln := Length(s);
|
|
i := PosEx(id, s,start) + Length(id);
|
|
while (s[i] <> '<') and (i < ln) do
|
|
begin
|
|
if s[i] = '.' then
|
|
Result := Result + DecimalSeparator
|
|
else
|
|
Result := Result + s[i];
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
m: TMemoryStream;
|
|
iRes,i : integer;
|
|
lstRes : Array of TResRec;
|
|
iStartDescr : integer;
|
|
lst : TStringArray;
|
|
begin
|
|
m := TMemoryStream.Create;
|
|
try
|
|
dl.DownloadFile('http://www.geonames.org/search.html?q='+
|
|
CleanLocationName(FLocationName), m);
|
|
m.Position := 0;
|
|
SetLength(s, m.Size);
|
|
m.Read(s[1], m.Size);
|
|
finally
|
|
m.Free;
|
|
end;
|
|
|
|
Result.Lon := 0;
|
|
Result.Lat:=0;
|
|
SetLength(lstRes,0);
|
|
iRes:=Pos('<span class="geo"',s);
|
|
while (iRes>0) do
|
|
Begin
|
|
SetLength(lstRes,length(lstRes)+1);
|
|
lstRes[high(lstRes)].Loc.Lon:=strtofloat(gs(LONG_ID,iRes));
|
|
lstRes[high(lstRes)].Loc.Lat:=strtofloat(gs(LAT_ID,iRes));
|
|
iStartDescr:=RPosex('<td>',s,iRes);
|
|
if iStartDescr>0 then
|
|
Begin
|
|
lst:=RemoveTag(Copy(s,iStartDescr,iRes-iStartDescr));
|
|
if length(lst)>0 then
|
|
lstRes[high(lstRes)].Name:=lst[0];
|
|
lstRes[high(lstRes)].Descr:='';
|
|
For i:=1 to high(lst) do
|
|
lstRes[high(lstRes)].Descr+=lst[i];
|
|
end;
|
|
|
|
Result.Lon += lstRes[high(lstRes)].Loc.Lon;
|
|
Result.Lat += lstRes[high(lstRes)].Loc.Lat;
|
|
iRes:=PosEx('<span class="geo"',s,iRes+17);
|
|
End;
|
|
|
|
if length(lstRes)>0 then
|
|
Begin
|
|
if length(lstRes)>1 then
|
|
begin
|
|
Result.Lon := Result.Lon/length(lstRes);
|
|
Result.Lat := Result.Lat/length(lstRes);
|
|
end;
|
|
if Assigned(FOnNameFound) then
|
|
For iRes:=low(lstRes) to high(lstRes) do
|
|
Begin
|
|
FOnNameFound(lstRes[iRes].Name,lstRes[iRes].Descr,lstRes[iRes].Loc);
|
|
end;
|
|
End;
|
|
|
|
end;
|
|
|
|
end.
|