scream المِؤسس
scream.1fr1.net الطاقة : 1835 نقاط : 22129915
| موضوع: Exemple GeoLite City avec Delphi الجمعة 19 نوفمبر 2010 - 23:32 | |
| - الكود:
-
{ * Copyright (C) 2005 MaxMind LLC All Rights Reserved. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library 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 * General Public License for more details. * * You should have received a copy of the GNU 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
* ChangeLog * 2003-04-09 Translation of C# class to Pascal provided by W. Tracz * 2005-07-20 Added support for GeoIP Region, City, ISP and Organization (Yvan Schwab/esoftys) * 2009-10-18 Compatible with Delphi 2009 and above (AnsiString) + regions added }
{ Thanks to W. Tracz/Yvan Schwab for contributing this class }
unit GeoIP;
interface
uses Classes, SysUtils, WinSock;
type TGeoIPResult = ( GEOIP_SUCCESS = 0, GEOIP_NODATA = 1, GEOIP_ERROR_IPADDR = 2, GEOIP_ERROR_DBTYPE = 3, GEOIP_ERROR_IO = 4 );
TGeoIPDBTypes = ( GEOIP_COUNTRY_EDITION = 1, GEOIP_REGION_EDITION_REV0 = 7, GEOIP_CITY_EDITION_REV0 = 6, GEOIP_ORG_EDITION = 5, GEOIP_ISP_EDITION = 4, GEOIP_CITY_EDITION_REV1 = 2, GEOIP_REGION_EDITION_REV1 = 3, GEOIP_PROXY_EDITION = 8, GEOIP_ASNUM_EDITION = 9 );
TGeoIPCountry = record CountryCode: ansistring; CountryName: ansistring; end;
TGeoIPRegion = record CountryCode: ansistring; Region: ansistring; end;
TGeoIPCity = record CountryCode: ansistring; CountryName: ansistring; Region: ansistring; City: ansistring; PostalCode: ansistring; Latitude: Double; Longitude: Double; DmaCode: Integer; AreaCode: Integer; end;
TGeoIPOrg = record Name: ansistring; end;
TGeoIP = class private FInputFile: TFileStream; FDatabaseType: TGeoIPDBTypes; FDatabaseSegments: array of Cardinal; FDatabaseInfo: string; FRecordLength: Cardinal; slRegions : TStringList; function _GetCity(IPNum: Cardinal; var GeoIPCity: TGeoIPCity): TGeoIPResult; function _GetCountry(IPNum: Cardinal; var GeoIPCountry: TGeoIPCountry): TGeoIPResult; function _GetOrg(IPNum: Cardinal; var GeoIPOrg: TGeoIPOrg): TGeoIPResult; function _GetRegion(IPNum: Cardinal; var GeoIPRegion: TGeoIPRegion): TGeoIPResult; function AddrToNum(const IPAddr: ansistring): Cardinal; procedure InitDBFile; function SeekRecord(IPNum: Cardinal): Cardinal; procedure InitRegions; public constructor Create(const FileName: string); destructor Destroy; override; function GetCity(const IPAddr: ansistring; var GeoIPCity: TGeoIPCity): TGeoIPResult; function GetCountry(const IPAddr: ansistring; var GeoIPCountry: TGeoIPCountry): TGeoIPResult; function GetDatabaseInfo: string; function GetOrg(const IPAddr: ansistring; var GeoIPOrg: TGeoIPOrg): TGeoIPResult; function GetRegion(const IPAddr: ansistring; var GeoIPRegion: TGeoIPRegion): TGeoIPResult; end;
const CountryCodes:array [0..252] of ansistring = ('--','AP','EU','AD','AE','AF','AG','AI','AL','AM','AN','AO','AQ', 'AR','AS','AT','AU','AW','AZ','BA','BB','BD','BE','BF','BG', 'BH','BI','BJ','BM','BN','BO','BR','BS','BT','BV','BW','BY','BZ','CA','CC','CD','CF','CG','CH','CI','CK','CL','CM','CN', 'CO','CR','CU','CV','CX','CY','CZ','DE','DJ','DK','DM','DO', 'DZ','EC','EE','EG','EH','ER','ES','ET','FI','FJ','FK','FM','FO','FR','FX','GA','GB','GD','GE','GF','GH','GI','GL','GM','GN', 'GP','GQ','GR','GS','GT','GU','GW', 'GY','HK','HM','HN','HR','HT','HU','ID','IE','IL','IN','IO','IQ','IR','IS','IT','JM', 'JO','JP','KE','KG','KH','KI','KM','KN','KP', 'KR','KW','KY','KZ','LA','LB','LC','LI','LK','LR','LS','LT','LU', 'LV','LY','MA','MC','MD','MG','MH','MK','ML','MM','MN','MO','MP','MQ','MR','MS','MT','MU','MV','MW','MX','MY','MZ', 'NA','NC','NE','NF','NG','NI','NL','NO','NP','NR','NU','NZ','OM','PA','PE','PF','PG','PH','PK','PL','PM', 'PN','PR','PS','PT','PW','PY','QA','RE','RO','RU', 'RW','SA','SB','SC','SD','SE','SG','SH','SI','SJ','SK','SL','SM','SN','SO','SR','ST', 'SV','SY','SZ','TC','TD','TF','TG','TH', 'TJ','TK','TM','TN','TO','TL','TR','TT','TV','TW','TZ','UA', 'UG','UM','US','UY','UZ','VA','VC','VE','VG','VI','VN','VU','WF','WS','YE','YT','RS','ZA','ZM','ME','ZW','A1','A2','O1','AX', 'GG','IM','JE','BL','MF');
CountryNames:array [0..252] of ansistring = ('ND', 'Région Asie / Pacifique', 'Europe', 'Andorre', 'Émirats Arabes Unis', 'Afghanistan', [...] , 'Saint-Barthélemy', 'Saint Martin'); RegionNames:array [0..4209] of ansistring = ('AD02=Canillo', 'AD03=Encamp', 'AD04=La Massana', 'AD05=Ordino', 'AD06=Sant Julia de Loria', 'AD07=Andorra la Vella', 'AD08=Escaldes-Engordany', 'AE01=Abu Dhabi', 'AE02=Ajman', 'AE03=Dubai', [...] 'ZW10=Harare');
implementation
const COUNTRY_BEGIN = 16776960; STATE_BEGIN_REV0 = 16700000; STATE_BEGIN_REV1 = 16000000; STRUCTURE_INFO_MAX_SIZE = 20; DATABASE_INFO_MAX_SIZE = 100; SEGMENT_RECORD_LENGTH = 3; STANDARD_RECORD_LENGTH = 3; ORG_RECORD_LENGTH = 4; MAX_RECORD_LENGTH = 4; MAX_ORG_RECORD_LENGTH = 300; FULL_RECORD_LENGTH = 50; US_OFFSET = 1; CANADA_OFFSET = 677; WORLD_OFFSET = 1353; FIPS_RANGE = 360;
{ TGeoIP }
constructor TGeoIP.Create(const FileName: string); begin inherited Create; FInputFile := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); InitDBFile; InitRegions; end;
destructor TGeoIP.Destroy; begin if Assigned(FInputFile) then FInputFile.Free; if Assigned(slRegions) then slRegions.Free; inherited Destroy; end;
function TGeoIP._GetCity(IPNum: Cardinal; var GeoIPCity: TGeoIPCity): TGeoIPResult; var SeekCity: Cardinal; RecordPointer: Cardinal; StrLen: Cardinal; buf: array[0..FULL_RECORD_LENGTH-1] of Byte; p: PAnsiChar; i: Integer; DmaAreaCombo: Integer; begin if (FDatabaseType <> GEOIP_CITY_EDITION_REV0) and (FDatabaseType <> GEOIP_CITY_EDITION_REV1) then begin Result := GEOIP_ERROR_DBTYPE; Exit; end; SeekCity := SeekRecord(IPNum); if SeekCity = FDatabaseSegments[0] then begin Result := GEOIP_NODATA; Exit; end; RecordPointer := SeekCity + (2 * FRecordLength - 1) * FDatabaseSegments[0]; FInputFile.Seek(RecordPointer, soFromBeginning); FInputFile.Read(buf, FULL_RECORD_LENGTH);
// get country GeoIPCity.CountryCode := CountryCodes[buf[0]]; GeoIPCity.CountryName := CountryNames[buf[0]];
// get region p := @buf[1]; StrLen := 0; while (p[StrLen] <> #0) do Inc(StrLen); GeoIPCity.Region := Copy(p, 0, StrLen);
// Region label if ((GeoIPCity.Region <> '') and (slRegions.IndexOfName(string(GeoIPCity.CountryCode + GeoIPCity.Region)) <> -1)) then begin GeoIPCity.Region := AnsiString(slRegions.Values[string(GeoIPCity.CountryCode + GeoIPCity.Region)]); end;
// get city Inc(p, StrLen + 1); StrLen := 0; while (p[StrLen] <> #0) do Inc(StrLen); GeoIPCity.City := Copy(p, 0, StrLen);
// get postal code Inc(p, StrLen + 1); StrLen := 0; while (p[StrLen] <> #0) do Inc(StrLen); GeoIPCity.PostalCode := Copy(p, 0, StrLen);
// get latitude Inc(p, StrLen + 1); GeoIPCity.Latitude := 0.0; for i:=0 to 2 do begin GeoIPCity.Latitude := GeoIPCity.Latitude + (Integer(p[i]) shl (i*8)); end; GeoIPCity.Latitude := GeoIPCity.Latitude/10000 - 180;
// get longitude Inc(p, 3); GeoIPCity.Longitude := 0.0; for i:=0 to 2 do begin GeoIPCity.Longitude := GeoIPCity.Longitude + (Integer(p[i]) shl (i*8)); end; GeoIPCity.Longitude := GeoIPCity.Longitude/10000 - 180;
// get area code and dma code for post April 2002 databases and for US locations GeoIPCity.DmaCode := 0; GeoIPCity.AreaCode := 0; if FDatabaseType = GEOIP_CITY_EDITION_REV1 then begin if GeoIPCity.CountryCode = 'US' then begin Inc(p, 3); DmaAreaCombo := 0; for i:=0 to 2 do begin DmaAreaCombo := DmaAreaCombo + (Integer(p[i]) shl (i*8)); end; GeoIPCity.DmaCode := DmaAreaCombo div 1000; GeoIPCity.AreaCode := DmaAreaCombo mod 1000; end; end; Result := GEOIP_SUCCESS; end;
function TGeoIP._GetCountry(IPNum: Cardinal; var GeoIPCountry: TGeoIPCountry): TGeoIPResult; var ret: Cardinal; begin if (FDatabaseType <> GEOIP_COUNTRY_EDITION) and (FDatabaseType <> GEOIP_PROXY_EDITION) then begin Result := GEOIP_ERROR_DBTYPE; Exit; end; ret := SeekRecord(IPNum) - COUNTRY_BEGIN; if ret > 0 then begin GeoIPCountry.CountryCode := CountryCodes[ret]; GeoIPCountry.CountryName := CountryNames[ret]; Result := GEOIP_SUCCESS; end else begin Result := GEOIP_NODATA; end; end;
function TGeoIP._GetOrg(IPNum: Cardinal; var GeoIPOrg: TGeoIPOrg): TGeoIPResult; var SeekOrg: Cardinal; RecordPointer: Cardinal; StrLen: Cardinal; buf: array[0..MAX_ORG_RECORD_LENGTH-1] of Byte; p: PAnsiChar; begin if (FDatabaseType <> GEOIP_ORG_EDITION) and (FDatabaseType <> GEOIP_ISP_EDITION) and (FDatabaseType <> GEOIP_ASNUM_EDITION) then begin Result := GEOIP_ERROR_DBTYPE; Exit; end; SeekOrg := SeekRecord(IPNum); if SeekOrg = FDatabaseSegments[0] then begin Result := GEOIP_NODATA; Exit; end; RecordPointer := SeekOrg + (2 * FRecordLength - 1) * FDatabaseSegments[0]; FInputFile.Seek(RecordPointer, soFromBeginning); FInputFile.Read(buf, FULL_RECORD_LENGTH);
p := @buf[0]; StrLen := 0; while (p[StrLen] <> #0) do Inc(StrLen); GeoIPOrg.Name := Copy(p, 0, StrLen); Result := GEOIP_SUCCESS; end;
function TGeoIP._GetRegion(IPNum: Cardinal; var GeoIPRegion: TGeoIPRegion): TGeoIPResult; var SeekRegion: Cardinal; begin if (FDatabaseType <> GEOIP_REGION_EDITION_REV0) and (FDatabaseType <> GEOIP_REGION_EDITION_REV1) then begin Result := GEOIP_ERROR_DBTYPE; Exit; end; SeekRegion := SeekRecord(IPNum); if FDatabaseType = GEOIP_REGION_EDITION_REV0 then begin // Region Edition, pre June 2003 Dec(SeekRegion, STATE_BEGIN_REV0); if SeekRegion >= 1000 then begin GeoIPRegion.CountryCode := 'US'; GeoIPRegion.Region := AnsiString(Chr((SeekRegion - 1000) div 26 + 65) + Chr((SeekRegion - 1000) mod 26 + 65)); end else begin GeoIPRegion.CountryCode := CountryCodes[SeekRegion]; GeoIPRegion.Region := ''; end; end else if FDatabaseType = GEOIP_REGION_EDITION_REV1 then begin // Region Edition, post June 2003 Dec(SeekRegion, STATE_BEGIN_REV1); if SeekRegion < US_OFFSET then begin // Unknown GeoIPRegion.CountryCode := ''; GeoIPRegion.Region := ''; end else if SeekRegion < CANADA_OFFSET then begin // USA State GeoIPRegion.CountryCode := 'US'; GeoIPRegion.Region := AnsiString(Chr((SeekRegion - US_OFFSET) div 26 + 65) + Chr((SeekRegion - US_OFFSET) mod 26 + 65)); end else if SeekRegion < WORLD_OFFSET then begin // Canada Province GeoIPRegion.CountryCode := 'CA'; GeoIPRegion.Region := AnsiString(Chr((SeekRegion - CANADA_OFFSET) div 26 + 65) + Chr((SeekRegion - CANADA_OFFSET) mod 26 + 65)); end else begin // Not US or Canada GeoIPRegion.CountryCode := CountryCodes[(SeekRegion - WORLD_OFFSET) div FIPS_RANGE]; GeoIPRegion.Region := ''; end; end; Result := GEOIP_SUCCESS; end;
function TGeoIP.AddrToNum(const IPAddr: ansistring): Cardinal; var netlong: Cardinal; temp: PAnsiChar; begin temp := PAnsiChar(IPAddr); netlong := inet_addr(temp); if netlong <> INADDR_NONE then Result := ntohl(netlong) else Result := 0; end;
function TGeoIP.GetCity(const IPAddr: ansistring; var GeoIPCity: TGeoIPCity): TGeoIPResult; var IPNum: Cardinal; begin IPNum := AddrToNum(IPAddr); if IPNum = 0 then begin Result := GEOIP_ERROR_IPADDR; Exit; end; Result := _GetCity(IPNum, GeoIPCity); end;
function TGeoIP.GetCountry(const IPAddr: ansistring; var GeoIPCountry: TGeoIPCountry): TGeoIPResult; var IPNum: Cardinal; begin IPNum := AddrToNum(IPAddr); if IPNum = 0 then begin Result := GEOIP_ERROR_IPADDR; Exit; end; Result := _GetCountry(IPNum, GeoIPCountry); end;
function TGeoIP.GetDatabaseInfo: string; var i: Integer; delim: array[0..2] of Byte; HasStructureInfo: Boolean; begin FDatabaseInfo := ''; HasStructureInfo := False; FInputFile.Seek(-3, soFromEnd); for i:=0 to STRUCTURE_INFO_MAX_SIZE-1 do begin FInputFile.Read(delim, 3); if (delim[0] = 255) and (delim[1] = 255) and (delim[2] = 255) then begin HasStructureInfo := True; Break; end; FInputFile.Seek(-4, soFromCurrent); end; if HasStructureInfo then FInputFile.Seek(-3, soFromCurrent) else // no structure info, must be pre Sep 2002 database, go back to end FInputFile.Seek(-3, soFromEnd); for i:=0 to DATABASE_INFO_MAX_SIZE-1 do begin FInputFile.Read(delim, 3); if (delim[0] = 0) and (delim[1] = 0) and (delim[2] = 0) then begin SetLength(FDatabaseInfo, i); FInputFile.Read(PChar(FDatabaseInfo)^, i); Break; end; FInputFile.Seek(-4, soFromCurrent); end; Result := FDatabaseInfo; end;
function TGeoIP.GetOrg(const IPAddr: ansistring; var GeoIPOrg: TGeoIPOrg): TGeoIPResult; var IPNum: Cardinal; begin IPNum := AddrToNum(IPAddr); if IPNum = 0 then begin Result := GEOIP_ERROR_IPADDR; Exit; end; Result := _GetOrg(IPNum, GeoIPOrg); end;
function TGeoIP.GetRegion(const IPAddr: ansistring; var GeoIPRegion: TGeoIPRegion): TGeoIPResult; var IPNum: Cardinal; begin IPNum := AddrToNum(IPAddr); if IPNum = 0 then begin Result := GEOIP_ERROR_IPADDR; Exit; end; Result := _GetRegion(IPNum, GeoIPRegion); end;
procedure TGeoIP.InitDBFile; var i,j: Integer; delim: array[0..2] of Byte; buf: array[0..SEGMENT_RECORD_LENGTH-1] of Byte; begin // default to GeoIP Country Edition FDatabaseType := GEOIP_COUNTRY_EDITION; FRecordLength := STANDARD_RECORD_LENGTH; FInputFile.Seek(-3, soFromEnd); for i:=0 to STRUCTURE_INFO_MAX_SIZE-1 do begin FInputFile.Read(delim, 3); if (delim[0] = 255) and (delim[1] = 255) and (delim[2] = 255) then begin FInputFile.Read(FDatabaseType, 1); if Byte(FDatabaseType) >= 106 then begin // Backward compatibility with databases from April 2003 and earlier Dec(FDatabaseType, 105); end; if FDatabaseType = GEOIP_REGION_EDITION_REV0 then begin // Region Edition, pre June 2003 SetLength(FDatabaseSegments, 1); FDatabaseSegments[0] := STATE_BEGIN_REV0; end else if FDatabaseType = GEOIP_REGION_EDITION_REV1 then begin // Region Edition, post June 2003 SetLength(FDatabaseSegments, 1); FDatabaseSegments[0] := STATE_BEGIN_REV1; end else if (FDatabaseType = GEOIP_CITY_EDITION_REV0) or (FDatabaseType = GEOIP_CITY_EDITION_REV1) or (FDatabaseType = GEOIP_ORG_EDITION) or (FDatabaseType = GEOIP_ISP_EDITION) or (FDatabaseType = GEOIP_ASNUM_EDITION) then begin // City/Org Editions have two segments, read offset of second segment SetLength(FDatabaseSegments, 1); FDatabaseSegments[0] := 0; FInputFile.Read(buf, SEGMENT_RECORD_LENGTH); for j:=0 to SEGMENT_RECORD_LENGTH-1 do begin Inc(FDatabaseSegments[0], Integer(buf[j]) shl (j*8)); end; if (FDatabaseType = GEOIP_ORG_EDITION) or (FDatabaseType = GEOIP_ISP_EDITION) then FRecordLength := ORG_RECORD_LENGTH; end; Break; end else begin FInputFile.Seek(-4, soFromCurrent); end; end; if (FDatabaseType = GEOIP_COUNTRY_EDITION) or (FDatabaseType = GEOIP_PROXY_EDITION) then begin SetLength(FDatabaseSegments, 1); FDatabaseSegments[0] := COUNTRY_BEGIN; end; end;
procedure TGeoIP.InitRegions; var f,t,loop: Integer; begin slRegions := TStringList.Create;
f := Low(RegionNames); t := High(RegionNames);
for loop := f to t do begin slRegions.Add(string(RegionNames[loop])); end; end;
function TGeoIP.SeekRecord(IPNum: Cardinal): Cardinal; var depth: Cardinal; offset: Cardinal; i,j: Cardinal; x: array[0..1] of Cardinal; y: Cardinal; buf: array[0..2*MAX_RECORD_LENGTH-1] of Byte; begin offset := 0; for depth:=31 downto 0 do begin FInputFile.Seek(2 * FRecordLength * offset, soFromBeginning); FInputFile.Read(buf, 2 * FRecordLength); for i:=0 to 1 do begin x[i] := 0; for j:=0 to FRecordLength-1 do begin y := buf[i*FRecordLength+j]; x[i] := x[i] + (y shl (j*8)); end; end; if (IPNum and (1 shl depth)) <> 0 then begin if x[1] >= FDatabaseSegments[0] then begin Result := x[1]; Exit; end else begin Offset := x[1]; end; end else begin if x[0] >= FDatabaseSegments[0] then begin Result := x[0]; Exit; end else begin Offset := x[0]; end; end; end; Result := 0; end;
end.
| |
|