纯真IP数据库解析Delphi D10.1下正常使用
直接一个单元，代码分享出来。
1 unit Net.IPLocation; 2 3 interface 4 5 uses System.Classes, System.SysUtils, Winapi.WinSock, Vcl.Forms, 6 System.Math, System.SyncObjs; 7 8 type 9 TIPLocation = class(TObject) 10 private 11 QQWryFileName: string; 12 QQWryFileStream: TBufferedFileStream; 13 QQWryFileSize: Cardinal; 14 IPRecordNum: Cardinal; 15 FirstIPIndexOffset, LastIPIndexOffset: Cardinal; 16 FLock: TCriticalSection; 17 18 function GetQQWryFileName: string; 19 function GetQQWryFileSize: Cardinal; 20 function GetIPRecordNum: Cardinal; 21 function GetQQWryDate: TDate; 22 function GetQQWryDataFrom: string; 23 function GetIPLocation(IPLocationOffset: Cardinal): TStringlist; 24 function GetIPMsg(IPRecordID: Cardinal): TStringlist; 25 function GetIPRecordID(IP: string): Cardinal; 26 function GetIPValue(IP: string): Cardinal; 27 public 28 constructor Create(cQQWryFileName: string); 29 destructor Destroy; override; 30 function GetLocation(IP: string): String; 31 end; 32 33 function IPLocation: TIPLocation; 34 35 implementation 36 37 var 38 __IPLocation: TIPLocation; 39 40 function IPLocation: TIPLocation; 41 begin 42 if __IPLocation = nil then 43 __IPLocation := TIPLocation.Create(ExtractFilePath(ParamStr(0)) + 44 'qqwry.dat'); 45 46 Result := __IPLocation; 47 end; 48 49 { TIPLocation } 50 51 constructor TIPLocation.Create(cQQWryFileName: string); 52 begin 53 inherited Create; 54 FLock := TCriticalSection.Create; 55 QQWryFileName := cQQWryFileName; 56 QQWryFileStream := TBufferedFileStream.Create(QQWryFileName, 57 fmOpenRead or fmShareDenyWrite, 0); 58 QQWryFileSize := QQWryFileStream.Size; 59 QQWryFileStream.Read(FirstIPIndexOffset, 4); 60 QQWryFileStream.Read(LastIPIndexOffset, 4); 61 IPRecordNum := (LastIPIndexOffset - FirstIPIndexOffset) div 7 + 1; 62 end; 63 64 destructor TIPLocation.Destroy; 65 begin 66 67 QQWryFileStream.Free; 68 FLock.Free; 69 inherited Destroy; 70 end; 71 72 function TIPLocation.GetIPLocation(IPLocationOffset: Cardinal): TStringlist; 73 const 74 // 实际信息字串存放位置的重定向模式 75 REDIRECT_MODE_1 = 1; 76 REDIRECT_MODE_2 = 2; 77 var 78 RedirectMode: byte; 79 CountryFirstOffset, CountrySecondOffset: Cardinal; 80 CountryMsg, AreaMsg: string; 81 // 82 function ReadString(StringOffset: Cardinal): ansistring; 83 var 84 ReadByte: ansichar; 85 begin 86 Result := ''; 87 QQWryFileStream.Seek(StringOffset, soFromBeginning); 88 QQWryFileStream.Read(ReadByte, 1); 89 while ord(ReadByte) <> 0 do 90 begin 91 Result := Result + ReadByte; 92 QQWryFileStream.Read(ReadByte, 1); 93 end; 94 end; 95 // 96 function ReadArea(AreaOffset: Cardinal): ansistring; 97 var 98 ModeByte: byte; 99 ReadAreaOffset: Cardinal; 100 begin 101 ReadAreaOffset := 0; 102 QQWryFileStream.Seek(AreaOffset, soFromBeginning); 103 QQWryFileStream.Read(ModeByte, 1); 104 if (ModeByte = REDIRECT_MODE_1) or (ModeByte = REDIRECT_MODE_2) then 105 begin 106 QQWryFileStream.Read(ReadAreaOffset, 3); 107 if ReadAreaOffset = 0 then 108 Result := '未知地区' 109 else 110 Result := ReadString(ReadAreaOffset); 111 end 112 else 113 begin 114 Result := ReadString(AreaOffset); 115 end; 116 end; 117 118 begin 119 CountryFirstOffset := 0; 120 CountrySecondOffset := 0; 121 // 跳过4个字节，该4字节内容为该条IP信息里IP地址段中的终止IP值 122 QQWryFileStream.Seek(IPLocationOffset + 4, soFromBeginning); 123 // 读取国家信息的重定向模式值 124 QQWryFileStream.Read(RedirectMode, 1); 125 // 重定向模式1的处理 126 if RedirectMode = REDIRECT_MODE_1 then 127 begin 128 // 模式值为1，则后3个字节的内容为国家信息的重定向偏移值 129 QQWryFileStream.ReadData(CountryFirstOffset, 3); 130 // 进行重定向 131 QQWryFileStream.Seek(CountryFirstOffset, soFromBeginning); 132 // 第二次读取国家信息的重定向模式 133 QQWryFileStream.Read(RedirectMode, 1); 134 // 第二次重定向模式为模式2的处理 135 if RedirectMode = REDIRECT_MODE_2 then 136 begin 137 // 后3字节的内容即为第二次重定向偏移值 138 QQWryFileStream.ReadData(CountrySecondOffset, 3); 139 // 读取第二次重定向偏移值下的字符串值，即为国家信息 140 CountryMsg := ReadString(CountrySecondOffset); 141 // 若第一次重定向模式为1，进行重定向后读取的第二次重定向模式为2， 142 // 则地区信息存放在第一次国家信息偏移值的后面 143 QQWryFileStream.Seek(CountryFirstOffset + 4, soFromBeginning); 144 // 第二次重定向模式不是模式2的处理 145 end 146 else 147 begin 148 CountryMsg := ReadString(CountryFirstOffset); 149 end; 150 // 在重定向模式1下读地区信息值 151 AreaMsg := ReadArea(QQWryFileStream.Position); 152 // 重定向模式2的处理 153 end 154 else if RedirectMode = REDIRECT_MODE_2 then 155 begin 156 QQWryFileStream.ReadData(CountrySecondOffset, 3); 157 CountryMsg := ReadString(CountrySecondOffset); 158 AreaMsg := ReadArea(IPLocationOffset + 8); 159 // 不是重定向模式的处理，存放的即是IP地址信息 160 end 161 else 162 begin 163 CountryMsg := ReadString(QQWryFileStream.Position - 1); 164 AreaMsg := ReadArea(QQWryFileStream.Position); 165 end; 166 Result := TStringlist.Create; 167 Result.Add(CountryMsg); 168 Result.Add(AreaMsg); 169 end; 170 171 function TIPLocation.GetIPMsg(IPRecordID: Cardinal): TStringlist; 172 var 173 aryStartIP: array [1 .. 4] of byte; 174 strStartIP: string; 175 EndIPOffset: Cardinal; 176 aryEndIP: array [1 .. 4] of byte; 177 strEndIP: string; 178 i: integer; 179 begin 180 EndIPOffset := 0; 181 182 // 根据记录ID号移到该记录号的索引处 183 QQWryFileStream.Seek(FirstIPIndexOffset + (IPRecordID - 1) * 7, 184 soFromBeginning); 185 // 索引的前4个字节为起始IP地址 186 QQWryFileStream.Read(aryStartIP, 4); 187 // 后3个字节是内容区域的偏移值 188 // QQWryFileStream.Read(EndIPOffset, 3); 189 QQWryFileStream.ReadData(EndIPOffset, 3); 190 // 移至内容区域 191 QQWryFileStream.Seek(EndIPOffset, soFromBeginning); 192 // 内容区域的前4个字节为终止IP地址 193 QQWryFileStream.Read(aryEndIP, 4); 194 195 // 将起止IP地址转换为点分的形式 196 strStartIP := ''; 197 for i := 4 downto 1 do 198 begin 199 if i <> 1 then 200 strStartIP := strStartIP + IntToStr(aryStartIP[i]) + '.' 201 else 202 strStartIP := strStartIP + IntToStr(aryStartIP[i]); 203 end; 204 strEndIP := ''; 205 for i := 4 downto 1 do 206 begin 207 if i <> 1 then 208 strEndIP := strEndIP + IntToStr(aryEndIP[i]) + '.' 209 else 210 strEndIP := strEndIP + IntToStr(aryEndIP[i]); 211 end; 212 Result := TStringlist.Create; 213 Result.Add(strStartIP); 214 Result.Add(strEndIP); 215 // 获取该条记录下的IP地址信息 216 // 以下三者是统一的：①内容区域的偏移值 ②终止IP地址的存放位置 ③国家信息紧接在终止IP地址存放位置后 217 Result.AddStrings(GetIPLocation(EndIPOffset)); 218 end; 219 220 function TIPLocation.GetIPRecordID(IP: string): Cardinal; 221 function SearchIPRecordID(IPRecordFrom, IPRecordTo, IPValue: Cardinal) 222 : Cardinal; 223 var 224 CompareIPValue1, CompareIPValue2: Cardinal; 225 begin 226 Result := 0; 227 CompareIPValue1 := 0; 228 CompareIPValue2 := 0; 229 QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div 2 230 + IPRecordFrom - 1) * 7, soFromBeginning); 231 QQWryFileStream.Read(CompareIPValue1, 4); 232 QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div 2 233 + IPRecordFrom) * 7, soFromBeginning); 234 QQWryFileStream.Read(CompareIPValue2, 4); 235 // 找到了 236 if (IPValue >= CompareIPValue1) and (IPValue < CompareIPValue2) then 237 begin 238 Result := (IPRecordTo - IPRecordFrom) div 2 + IPRecordFrom; 239 end 240 else 241 // 后半段找 242 if IPValue > CompareIPValue1 then 243 begin 244 Result := SearchIPRecordID((IPRecordTo - IPRecordFrom) div 2 + 245 IPRecordFrom + 1, IPRecordTo, IPValue); 246 end 247 else 248 // 前半段找 249 if IPValue < CompareIPValue1 then 250 begin 251 Result := SearchIPRecordID(IPRecordFrom, (IPRecordTo - IPRecordFrom) 252 div 2 + IPRecordFrom - 1, IPValue); 253 end; 254 end; 255 256 begin 257 Result := SearchIPRecordID(1, GetIPRecordNum, GetIPValue(IP)); 258 end; 259 260 function TIPLocation.GetIPRecordNum: Cardinal; 261 begin 262 Result := IPRecordNum; 263 end; 264 265 function TIPLocation.GetIPValue(IP: string): Cardinal; 266 var 267 tsIP: TStringlist; 268 i: integer; 269 function SplitStringToStringlist(aString: string; aSplitChar: string) 270 : TStringlist; 271 begin 272 Result := TStringlist.Create; 273 while pos(aSplitChar, aString) > 0 do 274 begin 275 Result.Add(copy(aString, 1, pos(aSplitChar, aString) - 1)); 276 aString := copy(aString, pos(aSplitChar, aString) + 1, 277 length(aString) - pos(aSplitChar, aString)); 278 end; 279 Result.Add(aString); 280 end; 281 282 begin 283 tsIP := SplitStringToStringlist(IP, '.'); 284 Result := 0; 285 for i := 3 downto 0 do 286 begin 287 Result := Result + StrToInt(tsIP[i]) * trunc(power(256, 3 - i)); 288 end; 289 end; 290 291 function TIPLocation.GetLocation(IP: string): String; 292 begin 293 FLock.Enter; 294 try 295 Result := GetIPMsg(GetIPRecordID(IP))[2]; 296 finally 297 FLock.Leave; 298 end; 299 end; 300 301 function TIPLocation.GetQQWryDataFrom: string; 302 begin 303 Result := GetIPMsg(GetIPRecordNum)[2]; 304 end; 305 306 function TIPLocation.GetQQWryDate: TDate; 307 var 308 DateString: string; 309 begin 310 DateString := GetIPMsg(GetIPRecordNum)[3]; 311 DateString := copy(DateString, 1, pos('IP数据', DateString) - 1); 312 DateString := StringReplace(DateString, '年', '-', 313 [rfReplaceAll, rfIgnoreCase]); 314 DateString := StringReplace(DateString, '月', '-', 315 [rfReplaceAll, rfIgnoreCase]); 316 DateString := StringReplace(DateString, '日', '-', 317 [rfReplaceAll, rfIgnoreCase]); 318 Result := StrToDate(DateString); 319 end; 320 321 function TIPLocation.GetQQWryFileName: string; 322 begin 323 Result := QQWryFileName; 324 end; 325 326 function TIPLocation.GetQQWryFileSize: Cardinal; 327 begin 328 Result := QQWryFileSize; 329 end; 330 331 initialization 332 333 finalization 334 335 if __IPLocation <> nil then 336 __IPLocation.Free; 337 338 end.
