unit   Net.IPLocation;

 interface

 uses System.Classes, System.SysUtils, Winapi.WinSock, Vcl.Forms,

   System.Math, System.SyncObjs;

 type

   TIPLocation = class(TObject)

   private

     QQWryFileName: string;

     QQWryFileStream: TBufferedFileStream;

     QQWryFileSize: Cardinal;

     IPRecordNum: Cardinal;

     FirstIPIndexOffset, LastIPIndexOffset: Cardinal;

     FLock: TCriticalSection;

     function GetQQWryFileName: string;

     function GetQQWryFileSize: Cardinal;

     function GetIPRecordNum: Cardinal;

     function GetQQWryDate: TDate;

     function GetQQWryDataFrom: string;

     function GetIPLocation(IPLocationOffset: Cardinal): TStringlist;

     function GetIPMsg(IPRecordID: Cardinal): TStringlist;

     function GetIPRecordID(IP: string): Cardinal;

     function GetIPValue(IP: string): Cardinal;

   public

     constructor Create(cQQWryFileName: string);

     destructor Destroy; override;

     function GetLocation(IP: string): String;

   end;

 function IPLocation: TIPLocation;

 implementation

 var

   __IPLocation: TIPLocation;

 function IPLocation: TIPLocation;

 begin

   if __IPLocation = nil then

     __IPLocation := TIPLocation.Create(ExtractFilePath(ParamStr()) +

       'qqwry.dat');

   Result := __IPLocation;

 end;

 { TIPLocation }

 constructor TIPLocation.Create(cQQWryFileName: string);

 begin

   inherited Create;

   FLock := TCriticalSection.Create;

   QQWryFileName := cQQWryFileName;

   QQWryFileStream := TBufferedFileStream.Create(QQWryFileName,

     fmOpenRead or fmShareDenyWrite, );

   QQWryFileSize := QQWryFileStream.Size;

   QQWryFileStream.Read(FirstIPIndexOffset, );

   QQWryFileStream.Read(LastIPIndexOffset, );

   IPRecordNum := (LastIPIndexOffset - FirstIPIndexOffset) div  + ;

 end;

 destructor TIPLocation.Destroy;

 begin

   QQWryFileStream.Free;

   FLock.Free;

   inherited Destroy;

 end;

 function TIPLocation.GetIPLocation(IPLocationOffset: Cardinal): TStringlist;

 const

   // 实际信息字串存放位置的重定向模式

   REDIRECT_MODE_ = ;

   REDIRECT_MODE_ = ;

 var

   RedirectMode: byte;

   CountryFirstOffset, CountrySecondOffset: Cardinal;

   CountryMsg, AreaMsg: string;

   //

   function ReadString(StringOffset: Cardinal): ansistring;

   var

     ReadByte: ansichar;

   begin

     Result := '';

     QQWryFileStream.Seek(StringOffset, soFromBeginning);

     QQWryFileStream.Read(ReadByte, );

     while ord(ReadByte) <>  do

     begin

       Result := Result + ReadByte;

       QQWryFileStream.Read(ReadByte, );

     end;

   end;

 //

   function ReadArea(AreaOffset: Cardinal): ansistring;

   var

     ModeByte: byte;

     ReadAreaOffset: Cardinal;

   begin

     ReadAreaOffset := ;

     QQWryFileStream.Seek(AreaOffset, soFromBeginning);

     QQWryFileStream.Read(ModeByte, );

     if (ModeByte = REDIRECT_MODE_) or (ModeByte = REDIRECT_MODE_) then

     begin

       QQWryFileStream.Read(ReadAreaOffset, );

       if ReadAreaOffset =  then

         Result := '未知地区'

       else

         Result := ReadString(ReadAreaOffset);

     end

     else

     begin

       Result := ReadString(AreaOffset);

     end;

   end;

 begin

   CountryFirstOffset := ;

   CountrySecondOffset := ;

   // 跳过4个字节，该4字节内容为该条IP信息里IP地址段中的终止IP值

   QQWryFileStream.Seek(IPLocationOffset + , soFromBeginning);

   // 读取国家信息的重定向模式值

   QQWryFileStream.Read(RedirectMode, );

   // 重定向模式1的处理

   if RedirectMode = REDIRECT_MODE_ then

   begin

     // 模式值为1，则后3个字节的内容为国家信息的重定向偏移值

     QQWryFileStream.ReadData(CountryFirstOffset, );

     // 进行重定向

     QQWryFileStream.Seek(CountryFirstOffset, soFromBeginning);

     // 第二次读取国家信息的重定向模式

     QQWryFileStream.Read(RedirectMode, );

     // 第二次重定向模式为模式2的处理

     if RedirectMode = REDIRECT_MODE_ then

     begin

       // 后3字节的内容即为第二次重定向偏移值

       QQWryFileStream.ReadData(CountrySecondOffset, );

       // 读取第二次重定向偏移值下的字符串值，即为国家信息

       CountryMsg := ReadString(CountrySecondOffset);

       // 若第一次重定向模式为1，进行重定向后读取的第二次重定向模式为2，

       // 则地区信息存放在第一次国家信息偏移值的后面

       QQWryFileStream.Seek(CountryFirstOffset + , soFromBeginning);

       // 第二次重定向模式不是模式2的处理

     end

     else

     begin

       CountryMsg := ReadString(CountryFirstOffset);

     end;

     // 在重定向模式1下读地区信息值

     AreaMsg := ReadArea(QQWryFileStream.Position);

     // 重定向模式2的处理

   end

   else if RedirectMode = REDIRECT_MODE_ then

   begin

     QQWryFileStream.ReadData(CountrySecondOffset, );

     CountryMsg := ReadString(CountrySecondOffset);

     AreaMsg := ReadArea(IPLocationOffset + );

     // 不是重定向模式的处理，存放的即是IP地址信息

   end

   else

   begin

     CountryMsg := ReadString(QQWryFileStream.Position - );

     AreaMsg := ReadArea(QQWryFileStream.Position);

   end;

   Result := TStringlist.Create;

   Result.Add(CountryMsg);

   Result.Add(AreaMsg);

 end;

 function TIPLocation.GetIPMsg(IPRecordID: Cardinal): TStringlist;

 var

   aryStartIP: array [ .. ] of byte;

   strStartIP: string;

   EndIPOffset: Cardinal;

   aryEndIP: array [ .. ] of byte;

   strEndIP: string;

   i: integer;

 begin

   EndIPOffset := ;

   // 根据记录ID号移到该记录号的索引处

   QQWryFileStream.Seek(FirstIPIndexOffset + (IPRecordID - ) * ,

     soFromBeginning);

   // 索引的前4个字节为起始IP地址

   QQWryFileStream.Read(aryStartIP, );

   // 后3个字节是内容区域的偏移值

   // QQWryFileStream.Read(EndIPOffset, 3);

   QQWryFileStream.ReadData(EndIPOffset, );

   // 移至内容区域

   QQWryFileStream.Seek(EndIPOffset, soFromBeginning);

   // 内容区域的前4个字节为终止IP地址

   QQWryFileStream.Read(aryEndIP, );

   // 将起止IP地址转换为点分的形式

   strStartIP := '';

   for i :=  downto  do

   begin

     if i <>  then

       strStartIP := strStartIP + IntToStr(aryStartIP[i]) + '.'

     else

       strStartIP := strStartIP + IntToStr(aryStartIP[i]);

   end;

   strEndIP := '';

   for i :=  downto  do

   begin

     if i <>  then

       strEndIP := strEndIP + IntToStr(aryEndIP[i]) + '.'

     else

       strEndIP := strEndIP + IntToStr(aryEndIP[i]);

   end;

   Result := TStringlist.Create;

   Result.Add(strStartIP);

   Result.Add(strEndIP);

   // 获取该条记录下的IP地址信息

   // 以下三者是统一的：①内容区域的偏移值 ②终止IP地址的存放位置 ③国家信息紧接在终止IP地址存放位置后

   Result.AddStrings(GetIPLocation(EndIPOffset));

 end;

 function TIPLocation.GetIPRecordID(IP: string): Cardinal;

   function SearchIPRecordID(IPRecordFrom, IPRecordTo, IPValue: Cardinal)

     : Cardinal;

   var

     CompareIPValue1, CompareIPValue2: Cardinal;

   begin

     Result := ;

     CompareIPValue1 := ;

     CompareIPValue2 := ;

     QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div

       + IPRecordFrom - ) * , soFromBeginning);

     QQWryFileStream.Read(CompareIPValue1, );

     QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div

       + IPRecordFrom) * , soFromBeginning);

     QQWryFileStream.Read(CompareIPValue2, );

     // 找到了

     if (IPValue >= CompareIPValue1) and (IPValue < CompareIPValue2) then

     begin

       Result := (IPRecordTo - IPRecordFrom) div  + IPRecordFrom;

     end

     else

       // 后半段找

       if IPValue > CompareIPValue1 then

       begin

         Result := SearchIPRecordID((IPRecordTo - IPRecordFrom) div  +

           IPRecordFrom + , IPRecordTo, IPValue);

       end

       else

         // 前半段找

         if IPValue < CompareIPValue1 then

         begin

           Result := SearchIPRecordID(IPRecordFrom, (IPRecordTo - IPRecordFrom)

             div  + IPRecordFrom - , IPValue);

         end;

   end;

 begin

   Result := SearchIPRecordID(, GetIPRecordNum, GetIPValue(IP));

 end;

 function TIPLocation.GetIPRecordNum: Cardinal;

 begin

   Result := IPRecordNum;

 end;

 function TIPLocation.GetIPValue(IP: string): Cardinal;

 var

   tsIP: TStringlist;

   i: integer;

   function SplitStringToStringlist(aString: string; aSplitChar: string)

     : TStringlist;

   begin

     Result := TStringlist.Create;

     while pos(aSplitChar, aString) >  do

     begin

       Result.Add(copy(aString, , pos(aSplitChar, aString) - ));

       aString := copy(aString, pos(aSplitChar, aString) + ,

         length(aString) - pos(aSplitChar, aString));

     end;

     Result.Add(aString);

   end;

 begin

   tsIP := SplitStringToStringlist(IP, '.');

   Result := ;

   for i :=  downto  do

   begin

     Result := Result + StrToInt(tsIP[i]) * trunc(power(,  - i));

   end;

 end;

 function TIPLocation.GetLocation(IP: string): String;

 begin

   FLock.Enter;

   try

     Result := GetIPMsg(GetIPRecordID(IP))[];

   finally

     FLock.Leave;

   end;

 end;

 function TIPLocation.GetQQWryDataFrom: string;

 begin

   Result := GetIPMsg(GetIPRecordNum)[];

 end;

 function TIPLocation.GetQQWryDate: TDate;

 var

   DateString: string;

 begin

   DateString := GetIPMsg(GetIPRecordNum)[];

   DateString := copy(DateString, , pos('IP数据', DateString) - );

   DateString := StringReplace(DateString, '年', '-',

     [rfReplaceAll, rfIgnoreCase]);

   DateString := StringReplace(DateString, '月', '-',

     [rfReplaceAll, rfIgnoreCase]);

   DateString := StringReplace(DateString, '日', '-',

     [rfReplaceAll, rfIgnoreCase]);

   Result := StrToDate(DateString);

 end;

 function TIPLocation.GetQQWryFileName: string;

 begin

   Result := QQWryFileName;

 end;

 function TIPLocation.GetQQWryFileSize: Cardinal;

 begin

   Result := QQWryFileSize;

 end;

 initialization

 finalization

 if __IPLocation <> nil then

   __IPLocation.Free;

 end.