interface
uses Classes, Types, SysUtils, Math, dialogs;
type
TIPwry = class
public
StartIP: DWORD;
EndIP: DWORD;
Country, City: string;
Local: string;
CountryFlag: integer; // 标识 Country位置
FirstStartIp: DWORD;
LastStartIp: DWORD;
EndIpOff: integer;
fHandle: integer;
datafile: string;
countryOffset: integer;
isChina: Boolean;
constructor Create(dbfile: string); virtual;
destructor Destroy; override;
function IPwry(dotip: string): integer;
private
function IpToInt(ip: string): DWORD;
function IntToIp(ipint: integer): string;
function toInt(doint: integer): integer;
function GetStartIp(RecNo: integer): DWORD;
function GetEndIp(): DWORD;
function GetStr(): string;
function getFlagStr(offset: integer): string;
procedure getCountry();
end;
implementation
function TIPwry.IpToInt(ip: string): DWORD;
var
str: TStringList;
begin
str := TStringList.Create;
str.CommaText := stringreplace(ip, '.', ' ', [rfReplaceAll]);
result := (StrToInt(str.Strings[0]) * 256 * 256 * 256)
+ (StrToInt(str.Strings[1]) * 256 * 256)
+ (StrToInt(str.Strings[2]) * 256)
+ StrToInt(str.Strings[3]);
str.Free;
end;
function TIPwry.IntToIp(ipint: integer): string;
var
b1, b2, b3, b4: integer;
begin
b1 := (ipint and $FF000000) shr 24;
if (b1 < 0) then
b1 := b1 + $100;
b2 := (ipint and $00FF0000) shr 16;
if (b2 < 0) then
b2 := b2 + $100;
b3 := (ipint and $0000FF00) shr 8;
if (b3 < 0) then
b3 := b3 + $100;
b4 := ipint and $000000FF;
if (b4 < 0) then
b4 := b4 + $100;
result := inttostr(b1) + '.' + inttostr(b2) + '.' + inttostr(b3) + '.' + inttostr(b4);
end;
constructor TIPwry.Create(dbfile: string);
begin
StartIP := 0;
EndIP := 0;
CountryFlag := 0;
FirstStartIp := 0;
LastStartIp := 0;
EndIpOff := 0;
isChina := false;
datafile := 'QQWry.Dat';
if (dbfile <> '') then
datafile := dbfile;
end;
destructor TIPwry.Destroy;
begin
Country := '';
City := '';
Local := '';
if fHandle <> 0 then
FileClose(fHandle);
end;
function TIPwry.toInt(doint: integer): integer;
begin
result := doint;
if doint < 0 then
result := result + 256;
end;
function TIPwry.GetStartIp(RecNo: integer): DWORD;
var
offset: DWORD;
buf: array[0..7] of char;
begin
offset := FirstStartIp + RecNo * 7;
fileseek(fHandle, offset, 0);
fileread(fHandle, buf, 7);
EndIpOff := toInt(ord(buf[4]))
+ (toInt(ord(buf[5])) * 256)
+ (toInt(ord(buf[6])) * 256 * 256);
StartIP := toInt(ord(buf[0]))
+ (toInt(ord(buf[1])) * 256)
+ (toInt(ord(buf[2])) * 256 * 256)
+ (toInt(ord(buf[3])) * 256 * 256 * 256);
result := StartIP;
end;
function TIPwry.GetEndIp(): DWORD;
var
buf: array[0..4] of char;
begin
fileseek(fHandle, EndIpOff, 0);
fileread(fHandle, buf, 5);
EndIP := toInt(ord(buf[0])) + (toInt(ord(buf[1])) * 256) +
(toInt(ord(buf[2])) * 256 * 256) +
(toInt(ord(buf[3])) * 256 * 256 * 256);
CountryFlag := ord(buf[4]);
result := EndIP;
end;
function TIPwry.GetStr(): string;
var
buf: byte;
begin
result := '';
while true do
begin
fileread(fHandle, buf, 1);
if toInt(buf) = 0 then
break;
result := result + chr(buf);
end;
end;
function TIPwry.getFlagStr(offset: integer): string;
var
flag: integer;
buf: byte;
buffer: array[0..2] of byte;
begin
while true do
begin
fileseek(fHandle, offset, 0);
fileread(fHandle, buf, 1);
flag := toInt(buf);
if ((flag = 1) or (flag = 2)) then
begin
fileread(fHandle, buffer, 3);
if flag = 2 then
begin
CountryFlag := 2;
EndIpOff := offset - 4;
end;
offset := toInt(ord(buffer[0])) +
(toInt(ord(buffer[1])) * 256) +
(toInt(ord(buffer[2])) * 256 * 256);
end
else
break;
end;
if offset < 12 then
begin
result := '';
exit;
end;
fileseek(fHandle, offset, 0);
result := GetStr();
end;
procedure TIPwry.getCountry();
const
strprovice = '省';
strCity = '市';
AProvice: array[0..31] of string = ('北京', '上海', '天津', '重庆', '河北', '辽宁',
'山东', '黑龙江', '山西', '吉林', '陕西', '河南', '安徽', '江苏', '湖北', '浙江',
'湖南', '江西', '福建', '台湾', '内蒙古', '甘肃', '宁夏', '四川', '贵州', '云南',
'广西', '广东', '海南', '新疆', '青海', '西藏');
var
i, j: integer;
temStr: string;
begin
Country := getFlagStr(EndIpOff + 4);
i := pos(strprovice, Country);
if i > 0 then //为省 ，但有省字。
begin
temStr := Copy(Country, 0, i + 1); //得到省
City := Copy(Country, i + 2, Length(Country));
i := pos(strCity, City); //得到市
if i > 0 then
City := Copy(City, 0, i + 1);
if City = '' then
City := '未知地区';
Country := temStr;
isChina := true;
end
else
begin
i := pos(strCity, Country);
if i = 5 then // 直辖市
begin
temStr := Copy(Country, 0, i + 1);
City := Copy(Country, i + 2, Length(Country));
Country := temStr;
City := Country;
isChina := true;
end
else if i > 5 then //为省，但没有省字 。
begin
for j := Low(AProvice) to High(AProvice) do
begin
i := pos(AProvice[j], Country);
if i > 0 then
begin
temStr := Copy(Country, 0, Length(AProvice[j]));
City := Copy(Country, Length(AProvice[j]) + 1, Length(Country));
i := pos(strCity, City); //得到市
if i > 0 then
City := Copy(City, 0, Length(Country) - Length(temStr));
Country := temStr;
isChina := true;
break;
end;
end;
end;
end;
if (2 <> CountryFlag) then
Local := getFlagStr(fileseek(fHandle, 0, 1)) //fileseek(fhandle,0,1)获得当前文件指针位置
else
Local := getFlagStr(EndIpOff + 8);
for j := 1 to Length(Local) do
begin
if (Local[j] in ['a'..'z', 'A'..'Z', '.']) then
begin
Local := '未知地区';
break;
end;
end;
end;
function TIPwry.IPwry(dotip: string): integer;
var
nRet: integer;
ip: DWORD;
buf: array[0..7] of char;
i, RecintCount, RangB, RangE, RecNo: integer;
begin
for i := Low(buf) to High(buf) do
begin
buf[i] := #0;
end;
fHandle := FileOpen(datafile, fmOpenRead);
if fHandle = 0 then
begin
showmessage('wrong');
result := -1;
exit;
end;
ip := IpToInt(dotip);
fileseek(fHandle, 0, 0);
fileread(fHandle, buf, 8);
FirstStartIp := toInt(ord(buf[0])) + ((toInt(ord(buf[1]))) * 256) + (toInt(ord(buf[2])) * 256 * 256) + (toInt(ord(buf[3])) * 256 * 256 * 256);
LastStartIp := toInt(ord(buf[4])) + (toInt(ord(buf[5])) * 256) + (toInt(ord(buf[6])) * 256 * 256) + (toInt(ord(buf[7])) * 256 * 256 * 256);
RecintCount := floor((LastStartIp - FirstStartIp) / 7);
if (RecintCount <= 1) then
begin
Country := 'FileDataError';
result := 2;
exit;
end;
RangB := 0;
RangE := RecintCount;
while (RangB < RangE - 1) do
begin
RecNo := floor((RangB + RangE) / 2);
GetStartIp(RecNo);
if ip = StartIP then
begin
RangB := RecNo;
break;
end;
if ip > StartIP then
RangB := RecNo
else
RangE := RecNo;
end; //end of while
GetStartIp(RangB);
GetEndIp();
if ((StartIP <= ip) and (EndIP >= ip)) then
begin
nRet := 0;
getCountry();
end
else
begin
nRet := 3;
Country := '未知';
Local := '';
end;
result := nRet;
end;
end.
unit u_ip;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IPwry, DB, ADODB, Grids, DBGrids, ComCtrls;
type
TFrm_IP = class(TForm)
Button1: TButton;
Button2: TButton;
ADOConnection1: TADOConnection;
IpQuery: TADOQuery;
DataSource1: TDataSource;
Memo1: TMemo;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
function GetIP(IpStr: string): string;
{ Private declarations }
public
procedure SaveIp;
{ Public declarations }
end;
var
Frm_IP: TFrm_IP;
implementation
{$R *.dfm}
procedure TFrm_IP.Button2Click(Sender: TObject);
begin
Application.Terminate ;
end;
function TFrm_IP.GetIP(IpStr: string): string;
var
i, j, DotCnt: integer;
Num, tempStr, StrIP: string;
Arr: array[1..4] of string;
begin
tempStr := '';
StrIP := '';
DotCnt := 0;
for i := Length(IpStr) downto 1 do
begin
if IpStr[i] = ')' then
Continue;
if IpStr[i] = '(' then
Break;
if not (IpStr[i] in ['0'..'9', '.']) then
begin
Result := '';
Exit;
end
else
begin
if IpStr[i] = '.' then
inc(DotCnt);
tempStr := tempStr + IpStr[i];
end;
end;
for i := Length(tempStr) downto 1 do
begin
StrIP := StrIP + tempStr[i];
end;
tempStr := StrIP;
if DotCnt <> 3 then
begin
Result := '';
Exit;
end;
for j := 1 to 3 do
begin
i := Pos('.', tempStr);
Num := Copy(tempStr, 1, i - 1);
Delete(tempStr, 1, i);
Arr[j] := Num;
end;
Arr[4] := tempStr;
try
DotCnt := 0;
for i := 1 to 4 do
begin
j := StrToInt(Arr[i]);
if ((j >= 0) and (j <= 255)) then
inc(DotCnt);
end;
if (DotCnt = 4) then
Result := StrIP
else
Result := '';
except
end;
end;
procedure TFrm_IP.SaveIp;
var
IPwry: TIPwry;
filepath, IpStr, StrIP, strCountry, StrCity: string;
i: integer;
begin
Memo1.Lines.Clear;
if IpQuery.Active then
IpQuery.Close;
IpQuery.Open;
filepath := ExtractFilePath(Application.ExeName) + 'QQWry.dat';
for i := 0 to IpQuery.RecordCount - 1 do
begin
IpQuery.edit;
StrIP := '未知IP';
strCountry := '未知国家';
StrCity := '未知地区';
IpStr := IpQuery.FieldByName('IPStr').AsString;
if IpStr <> '' then
begin
StrIP := GetIP(IpStr);
if (StrIP <> '') then
begin
IPwry := TIPwry.Create(filepath);
try
if IPwry.IPwry(Trim(StrIP)) = 0 then
begin
strCountry := IPwry.Country;
if IPwry.isChina then
StrCity := IPwry.City
else
StrCity := IPwry.Local;
end;
finally
IPwry.Destroy;
end;
end
else
StrIP := '未知IP';
end;
IpQuery.FieldByName('Groupid').AsString := strCountry;
IpQuery.FieldByName('Parentid').AsString := StrCity;
IpQuery.post;
Memo1.Lines.Add(StrIP + ' - ' + strCountry + ' - ' + StrCity + ' - ' + IntToStr(i));
IpQuery.Next;
end;
IpQuery.Close;
end;
procedure TFrm_IP.Button1Click(Sender: TObject);
begin
SaveIp;
end;
end.