Oct 19
 

MaxMind fournit des bases de données de géolocalisationW, dont GeoLite City, qui est gratuit et permet de localiser géographiquement une adresse IP.
Cette base de données est actualisée tous les mois.

Une API pour Delphi est disponible, mais celle-ci, au jour d’aujourd’hui, n’a pas encore été portée sous Delphi 2009W, la première version UnicodeW qui introduit des nouveaux types de chaînes de caractères dans ce langage, et engendre une erreur avec l’API telle qu’elle est fournie.

Je suis donc parti de l'APIW fournie, et j’ai changé quelques types, casté quelques variables, et supprimé ainsi tous les warnings que j’obtenais… je ne suis pas un expert Delphi, loin de là, mais si cela vous interresse de récupérer un code qui compile, voici un exemple qui fonctionne. Vous aurez besoin de la base de géolocalisation, disponible à cette adresse pour pouvoir exécuter cette application : http://geolite.maxmind.com/download/geoip/database/GeoLiteCity.dat.gz

Je me suis également inspiré de l’extension installée sur ce blog pour la localisation sur la planisphère et l’ajout des régions en toutes lettres…

Ces noms de régions viennent en plus de l’API standard… Les pays et régions sont soit en français, soit en anglais.

Le fichier GeoIP.pas, l’API avec les régions en plus (constantes volontairement tronquées dans l’affichage du blog) :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
{
 * 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.
Share

Pages : 1 2 3

Lien permanent vers Exemple GeoLite City avec Delphi Rédigé par Whiler \\ Tags : , , , , , , , , ,

4 réponses pour “Exemple GeoLite City avec Delphi”

  1. Whiler a dit :

    Les fichiers référencés dans cet article ont mis à jour en incluant le calcul de la distance entre les deux dernières IPs localisées. |-(

    Répondre

  2. Whiler a dit :

    Je viens d’ajouter la possibilité de saisir une liste d’adresses IPs. Pour cela, il suffit simplement de cliquer sur l’IP unique pour faire apparaitre un champ de saisie beaucoup plus grand…
    Vous pouvez également copier l’image avec les différentes adresses géolocalisées dans le presse-papier afin de coller l’image où vous le souhaitez.

    Répondre

  3. Thierry a dit :

    Tiens un spam (ou fishing??)
    Je me demande comment il a passé le captcha. Automatiquement ? Ou c’est un gars qui l’a rentré manuellement

    Répondre

  4. Whiler a dit :

    @ Thierry : Je ne sais pas non plus.. mais, il ne sera pas resté longtemps ;)

    Répondre

Laisser une réponse

(requis)

(requis)

*

Notifiez-moi les commentaires à venir via email. Vous pouvez aussi vous abonner sans commenter.

;) (lol) (y) |-( (hi) 8-) (angel) :s (clap) (bow) (tmi) (:| plus »