Oct 19
 

Le fichier main.pas, exemple d’utilisation :

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
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg, GeoIP, Math, WinSock, Buttons, ShellAPI, Clipbrd;

const
  DOWNLOAD_URL = 'http://geolite.maxmind.com/download/geoip/database/GeoLiteCity.dat.gz';
  MAP_URL      = 'http://blogs.wittwer.fr/whiler/visitors/';
  BORDERS      = clYellow;
  MIDDLE       = clRed;
  NOT_DEFINED  = 4;    // > Pi
  EARTH_RADIUS = 6378; // Rayon équatorial : 6 378,137

type
  TfrmMain = class(TForm)
    btnGetLocation: TButton;
    lbledtIP: TLabeledEdit;
    grpLocation: TGroupBox;
    imgMap: TImage;
    lbledtCountry: TLabeledEdit;
    lbledtCity: TLabeledEdit;
    lbledtRegion: TLabeledEdit;
    bbtnrefreshImage: TBitBtn;
    bbtnMaxMind: TBitBtn;
    bbtnMap: TBitBtn;
    bbtnDistance: TBitBtn;
    lblDistance: TLabel;
    mmoIPs: TMemo;
    bbtnMapToClipboard: TBitBtn;
    procedure btnGetLocationClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lbledtIPChange(Sender: TObject);
    procedure bbtnrefreshImageClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bbtnMaxMindClick(Sender: TObject);
    procedure bbtnMapClick(Sender: TObject);
    procedure lbledtIPDblClick(Sender: TObject);
    procedure bbtnMapToClipboardClick(Sender: TObject);
  private
    { Déclarations privées }
   GeoIP: TGeoIP;
   bDefaultMap: TBitmap;
   dPreviousLongitude : Double;
   dPreviousLatitude  : Double;
   function  GetLocation(sIP: AnsiString): Boolean;
   procedure DrawPin(dLongitude, dLatitude: Double);
   procedure CalculateDistance(dLongitude, dLatitude: Double);
   function  CheckIP(sIP: string): Boolean;
  public
    { Déclarations publiques }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.bbtnMapClick(Sender: TObject);
begin
  ShellExecute(0, 'open', PChar(MAP_URL), nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.bbtnMapToClipboardClick(Sender: TObject);
begin
  Clipboard.Assign(imgMap.Picture.Bitmap);
  MessageDlg('Carte copiée dans le presse-papier.',  mtInformation, [mbOK], 0);
end;

procedure TfrmMain.bbtnMaxMindClick(Sender: TObject);
begin
  ShellExecute(0, 'open', PChar(DOWNLOAD_URL), nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.bbtnrefreshImageClick(Sender: TObject);
begin
  imgMap.Refresh;
  imgMap.Picture.Assign(bDefaultMap);
end;

procedure TfrmMain.btnGetLocationClick(Sender: TObject);
var
  sIP:   AnsiString;
  iLoop, iMax: Integer;
begin
  if (mmoIPs.Visible) then
  begin
    iMax := mmoIPs.Lines.Count - 1;
    for iLoop := 0 to iMax do
    begin
      sIP := AnsiString(Trim(mmoIPs.Lines[0]));
      GetLocation(sIP);
      mmoIPs.Lines.Delete(0);
    end;
    mmoIPs.Visible := False;
  end
  else
  begin
    sIP := AnsiString(Trim(lbledtIP.Text));
    GetLocation(sIP);
  end;
end;

procedure TfrmMain.CalculateDistance(dLongitude, dLatitude: Double);
  function ArcCosWithZero(dValue: Double): Double;
  var
    dCheck: Double;
  begin
    dCheck := sqrt(-dValue*dValue+1);
    if (dCheck = 0) then
      dCheck := 0.0000000001;

    Result := -ArcTan(dValue / dCheck) + (Pi / 2);
  end;

var
  dDistance : Double;
begin
  // Degrés en radians
  dLongitude := dLongitude / 180 * Pi;
  dLatitude  := dLatitude  / 180 * Pi;

  if ((dPreviousLongitude <> NOT_DEFINED) and (dPreviousLatitude <> NOT_DEFINED)) then
  begin
    //Distance = Rayon * | arccos[ sin(LatA).sin(LatB)+cos(LatA).cos(LatB).cos(LonA-LonB) ] |
    // Rayon équatorial : 6 378,137
    dDistance := EARTH_RADIUS * ArcCosWithZero(Sin(dPreviousLatitude)*Sin(dLatitude)+Cos(dPreviousLatitude)*Cos(dLatitude)*Cos(dPreviousLongitude - dLongitude));

    lblDistance.Caption := Format('Distance entre les deux dernières adresses IPs : %8.2f km', [dDistance]);
  end;

  dPreviousLongitude := dLongitude;
  dPreviousLatitude  := dLatitude;
end;

function TfrmMain.CheckIP(sIP: string): Boolean;
var
   netlong: Cardinal;
begin
  netlong := inet_addr(PAnsiChar(AnsiString(sIP)));
  Result  := (netlong <> INADDR_NONE);
end;

procedure TfrmMain.DrawPin(dLongitude, dLatitude: Double);
const
  scale = 0.5625; //(360 / Largeur|width Image);
var
  pin: TPoint;
begin
  if ((dLongitude <> 0) and (dLatitude <> 0)) then
  begin
    pin.X := Floor( (dLongitude + 180) / scale );
    pin.Y := Floor( (90 - dLatitude)   / scale );

    with imgMap.Canvas do
      with pin do
      begin
        Pixels[X    , Y    ] := MIDDLE;
        Pixels[X - 1, Y    ] := BORDERS;
        Pixels[X + 1, Y    ] := BORDERS;
        Pixels[X    , Y - 1] := BORDERS;
        Pixels[X    , Y + 1] := BORDERS;
      end;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  dPreviousLongitude := NOT_DEFINED;
  dPreviousLatitude  := NOT_DEFINED;
  // Save initial bitmap
  bDefaultMap := TBitmap.Create;
  with bDefaultMap do
  begin
    Width  := 640;
    Height := 320;
    Assign(imgMap.Picture.Bitmap);
  end;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  if Assigned(GeoIP) then
    GeoIP.Free;
  if Assigned(bDefaultMap) then
    bDefaultMap.Free;
end;

function TfrmMain.GetLocation(sIP: AnsiString): Boolean;
var
   GeoIPCity: TGeoIPCity;
begin
  if not Assigned(GeoIP) then
    GeoIP := TGeoIP.Create('GeoLiteCity.dat');

  Result := (GeoIP.GetCity(sIP, GeoIPCity) = GEOIP_SUCCESS);
  if (Result) then
  begin
    lbledtCountry.Text := string(GeoIPCity.CountryName);
    lbledtRegion.Text  := string(GeoIPCity.Region);
    lbledtCity.Text    := string(GeoIPCity.City);
    DrawPin(GeoIPCity.Longitude, GeoIPCity.Latitude);
    CalculateDistance(GeoIPCity.Longitude, GeoIPCity.Latitude);
  end
  else
  begin
    lbledtCountry.Text := '';
    lbledtRegion.Text  := 'Erreur';
    lbledtCity.Text    := '';
  end;
end;

procedure TfrmMain.lbledtIPChange(Sender: TObject);
begin
  with lbledtIP do
  begin
    if CheckIP(Text) then
      Font.Color := clBlue
    else
      Font.Color := clRed;
  end;
end;

procedure TfrmMain.lbledtIPDblClick(Sender: TObject);
begin
  mmoIPs.Text := lbledtIP.Text;
  mmoIPs.Visible := True;
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 »