Delphi纯真IP数据库查找[源码]


前段时间没事写了个纯真数据库的IP查找,参考lumaqq的解析纯真IP数据库的部分代码和其格式写了个,默认是使用二分查找法,其中顺序查找法只是把代码注释掉了,

祥情请看源码

{*******************************************************}
{    }
{    纯真IP数据库查询    }
{    QueryWryData.pas    }
{    支持Unicode, 测试环境    }
{    Win7 sp1 + Delphi XE2 + Delphi7    }
{    }
{    2012/11/29 3:19:06    }
{    QQ: 396506155    }
{    E-mail:yuanfen3287@vip.qq.com    }
{    http: www.3464.com    }
{    版权所有 (C) 2012 ying32    }
{-------------------------------------------------------}
{    }
{    未测试多种带有重定义或未重定义的IP    }
{    如果查询出错,可发邮件给我,告知改进    }
{    或者由您改进,但记得发我一份    }
{    }
{    纯真网络:    }
{    http://www.cz88.net/    }
{    纯真IP数据格式:    }
{    http://lumaqq.linuxsir.org/    }
{    article/qqwry_format_detail.html  }
{    }
{*******************************************************}

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++
  注意:
   如果定义了 USEINITIALIZATION 那么必须保
   证纯真数据库在与exe同目录下
   或者自己修改常量 WryDataFileName
*+++++++++++++++++++++++++++++++++++++++++++++++++++++*)
{$DEFINE USEINITIALIZATION}

unit QueryWryData;

interface

uses
  Windows, Messages, SysUtils, Classes;


type
  { 定义IP结构 }
  TIprecord = record
   a1 : BYTE;
   a2 : BYTE;
   a3 : BYTE;
   a4 : BYTE;
  end;
  { 查询纯真IP数据库记录 }
  TWryData = class
  private
   FRecordCount: Integer;
   (* 首个IP起始位置 *)
   FFirstRecord: Integer;
   (* 加载数据库的流 *)
   FWryDatStream: TMemoryStream;
   (* 读偏移所在位置字符串以 #0 结束*)
   function  ReadStrByPosition(Offset: Integer): string;
   (* 将一个字符IP转为整数 *)
   function  StrIpToInt(str: string): Cardinal;

   (* 读偏移所在位置区域 *)
   function  ReadAreaStrByPosition(offset: Integer):string;
   (* 取位置 = 国家 + 地区 *)
   function  GetIpLocationByPosition(offset: Integer): string;
   (* 读取记录时用的 *)
   function  GetIpCommonFunc(RecordNum: Integer; var StartIp,
   EndIp: Cardinal; Flags: Byte = 0): Integer;
  public
   (* 初始创建读取文件名 *)
   constructor Create(WryDatFileName: string);
   destructor Destroy; override;
   (* 根据提供的IP地址查找地区 *)
   function  GetLocationByIpAddress(Ip: string):string;
   (* 读取版本信息 *)
   function  GetVersion: string;
   (* 属性: 返回本个数据库中IP数 *)
   property  RecordCount: Integer read FRecordCount;
  end;

  { 抛出错误类 }
  EWryDataError = class(Exception);
 
{$IFDEF USEINITIALIZATION}
  function QueryWryDataLoactionByIp(Ip: string):string;
  function QeeryWryDataLoactionByInt(Ip: Cardinal; BigEndian: Boolean = False):string;
{$ENDIF}


(* 将一个整数转为文本IP *)
function  IntIpToStr(IntIp: Cardinal; BigEndian: Boolean = False): string;
implementation

const
  { 重定义模式 }
  REDIRECT_MODE_1 = 1;
  REDIRECT_MODE_2 = 2;

{$IFDEF USEINITIALIZATION}

// 这个定义没什么用,主要是用来测试自己编写代码的
{`$DEFINE TestUnit}

var
  WryDat : TWryData;
const

{$IFDEF TestUnit}
  WryDataFileName = 'F:\DELPHI7\MyPascalSource\qqwry.dat';
{$ELSE}
  WryDataFileName = 'qqwry.dat';
{$ENDIF}

function QueryWryDataLoactionByIp(Ip: string):string;
begin
  Result := WryDat.GetLocationByIpAddress(Ip);
end;

function QeeryWryDataLoactionByInt(Ip: Cardinal; BigEndian: Boolean):string;
begin
  Result := WryDat.GetLocationByIpAddress(IntIpToStr(Ip, BigEndian));
end; 

{$ENDIF}


{ TWryData }

constructor TWryData.Create(WryDatFileName: string);
var
  LastRecord: Integer;
begin
  FRecordCount  := 0;
  FWryDatStream := TMemoryStream.Create;
  if FileExists(WryDatFileName) then
  begin
   try
   FWryDatStream.LoadFromFile(WryDatFileName);
   FWryDatStream.Position := 0;
   FWryDatStream.Read(FFirstRecord, 4);
   FWryDatStream.Read(LastRecord , 4);
   FRecordCount := (LastRecord - FFirstRecord) div 7;
   except
   raise EWryDataError.Create('加载纯真IP数据库错误!');
   end;
  end else raise EWryDataError.Create('文件不存在,无法打开!');
end;

destructor TWryData.Destroy;
begin
  FWryDatStream.Clear;
  FWryDatStream.Free;
  inherited Destroy;
end;

function TWryData.ReadStrByPosition(offset: Integer): string;
var
  C: Byte;
{$IFDEF UNICODE}
  retstr: AnsiString;
{$ENDIF}
begin
  Result := '';
{$IFDEF UNICODE}
  retstr := '';
{$ENDIF}
  FWryDatStream.Seek(offset, soBeginning);
  FWryDatStream.Read(C, 1);
  while C <> 0 do
  begin
   {$IFNDEF UNICODE}
   Result := Result + Chr(C);
   {$ELSE}
   retstr := retstr + AnsiChar(C);
   {$ENDIF}
   FWryDatStream.Read(C, 1);
  end;
  {$IFDEF UNICODE}
   Result := string(retstr);
  {$ENDIF}
end;


function {TWryData.}IntIpToStr(IntIp: Cardinal; BigEndian: Boolean): string;
var
  Ip: TIpRecord;
begin
  Ip := TIprecord(IntIp);
  case BigEndian of
   False : Result := Format('%d.%d.%d.%d', [Ip.a4, Ip.a3, Ip.a2, Ip.a1]);
   True  : Result := Format('%d.%d.%d.%d', [Ip.a1, Ip.a2, Ip.a3, Ip.a4]);
  end;
end;

function TWryData.StrIpToInt(str: string): Cardinal;
var
  StrIp: TStringList;
  IpR: TIprecord;
begin
  StrIp := TStringList.Create;
  try
   ExtractStrings(['.'], [' '], PChar(Str), StrIp);
   if StrIp.Count = 4 then
   begin
   IpR.a1 := StrToIntDef(StrIp[3], 0);
   IpR.a2 := StrToIntDef(StrIp[2], 0);
   IpR.a3 := StrToIntDef(StrIp[1], 0);
   IpR.a4 := StrToIntDef(StrIp[0], 0);
   Result := Cardinal(IpR);
   end else Result := $0000000;
  finally
   StrIp.Free;
  end;
end;

function TWryData.GetIpCommonFunc(RecordNum: Integer; var StartIp,
   EndIp: Cardinal; Flags: Byte = 0): Integer;
begin
   Result := FFirstRecord + RecordNum * 7;
   FWryDatStream.Seek(Result, soBeginning);
   FWryDatStream.Read(StartIp, 4);
   if Flags = 1 then
   begin
   FWryDatStream.Read(Result, 3);
   FWryDatStream.Seek(Result, sobeginning);
   FWryDatStream.Read(EndIP, 4);
   end;
end;

function TWryData.ReadAreaStrByPosition(offset: Integer):string;
var
  b:Byte;
  AreaOffset: Integer;
begin
  FWryDatStream.Seek(offset, soBeginning);
  FWryDatStream.Read(b, 1);
  if (b = REDIRECT_MODE_1) or (b = REDIRECT_MODE_2) then
  begin
   FWryDatStream.Seek(offset + 1, soBeginning);
   FWryDatStream.Read(AreaOffset, 3);
   if AreaOffset = 0 then
   Result := '未知区域'
   else Result := ReadStrByPosition(AreaOffset);
  end else
  Result := ReadStrByPosition(offset);
end;

function TWryData.GetIpLocationByPosition(offset: Integer): string;
var
  b: Byte;
  CountryOffset, CountryOffset2: Integer;
  CountryName: string;
  AreaName: string;
begin
  try
   FWryDatStream.Seek(offset + 4, soBeginning);
   FWryDatStream.Read(b, 1);
   case b of
   REDIRECT_MODE_1 :
   begin
   FWryDatStream.Read(CountryOffset, 3);
   FWryDatStream.Seek(CountryOffset, soBeginning);
   FwryDatStream.Read(b, 1);
  
   if b = REDIRECT_MODE_2 then
   begin
   FWryDatStream.Read(CountryOffset2, 3);
   CountryName := ReadStrByPosition(CountryOffset2);
   FWryDatStream.Seek(Countryoffset + 4, soBeginning);
   end else CountryName := ReadStrByPosition(CountryOffset);
  
   AreaName := ReadAreaStrByPosition(FWryDatStream.Position);
   end;
   REDIRECT_MODE_2 :
   begin
   FWryDatStream.Read(CountryOffset, 3);
   CountryName := ReadStrByPosition(CountryOffset);
   Areaname := ReadAreaStrByPosition(offset + 8);
   end;
   else
   CountryName := ReadStrByPosition(FWryDatStream.Position - 1);
   AreaName := ReadAreaStrByPosition(FWryDatStream.Position);
   end;
  except
   Result := '异常';
   Exit;
  end;
  Result := CountryName + AreaName;
end;

{ 二分查找 }

function TWryData.GetLocationByIpAddress(Ip: string):string;
var
  IpInt : Cardinal;
  Min, Max, MidRNo: Integer;
  StartIp: Cardinal;
  EndIp: Cardinal;
  Offset: Integer;
 
resourcestring
  returnstr = '***友情提示,未知IP***';

begin
  if FRecordCount > 0 then
  begin
   IpInt := StrIpToInt(Ip);
   if IpInt <> 0 then
   begin
   Min := 0;
   Max := FRecordCount - 1;
   while Min <= Max do
   begin
   MidRNo := (Min + Max) div 2;
   GetIpCommonFunc(MidRNo, StartIp, EndIp);
   if IpInt = StartIp then
   begin
   Max := MidRNo;
   Break;
   end else
   if IpInt > StartIp then
   Min := MidRNo + 1
   else
   Max := MidRNo - 1;
   end;

   Offset := GetIpCommonFunc(Max, StartIp, EndIp, 1);
   if (StartIp <= IpInt) and (EndIp >= IpInt) then
   Result :=  GetIpLocationByPosition(Offset)
   else Result   := returnstr;
   end else Result := returnstr;
  end else Result   := returnstr;
 
end;

function  TWryData.GetVersion: string;
var
  StartIp, EndIp: Cardinal;
  offset: Integer;
begin
  Result := '未知版本信息';
  if FRecordCount > 0 then
  begin
   offset := GetIpCommonFunc(FRecordCount, StartIp, EndIp, 1);
   if offset > 0 then
   Result := GetIpLocationByPosition(offset);
  end;
end;

{ 以下用的是顺序查找法 }
{
function TWryData.GetLocationByIpAddress(Ip: string):string;
var
  IpInt : Cardinal;
  I: Integer;
  StartIp: Cardinal;
  EndIp: Cardinal;
  Offset: Integer;
begin
  if FRecordCount > 0 then
  begin
   IpInt := StrIpToInt(Ip);
   if IpInt <> 0 then
   begin
   for I := 0 to FRecordCount - 1 do
   begin
   Offset := FFirstRecord + I * 7;
   FWryDatStream.Seek(Offset, soBeginning);
   FWryDatStream.Read(StartIp, 4);

   FWryDatStream.Read(Offset, 3);
   FWryDatStream.Seek(Offset, sobeginning);
   FWryDatStream.Read(EndIP, 4);
   if IpInt = StartIp then
   begin
   Result := GetIpLocationByPosition(Offset);
   break;
   end else if (IpInt > StartIp) and (IpInt < EndIp) then
   begin
   Result :=  GetIpLocationByPosition(Offset);
   break;
   end;
   end;
   end else Result := 'IP格式错误';
  end else Result := '当前数据库可能不是纯真数据库';
end;
}
initialization
{$IFDEF USEINITIALIZATION}
  {$IFDEF TestUnit}
   WryDat := TWryData.Create(WryDataFileName);
  {$ELSE}
   WryDat := TWryData.Create(ExtractFilePath(ParamStr(0)) + WryDataFileName);
  {$ENDIF}
{$ENDIF}
finalization
{$IFDEF USEINITIALIZATION}
  WryDat.Free;
{$ENDIF}

end.


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678