纯真IP数据库解析Delphi D10.1下正常使用
2017-11-23 00:00
337 查看
纯真IP数据库解析Delphi D10.1下正常使用
直接一个单元，代码分享出来。Delphi/Pascal
| 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 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 | 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(0)) + '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, 0); QQWryFileSize := QQWryFileStream.Size; QQWryFileStream.Read(FirstIPIndexOffset, 4); QQWryFileStream.Read(LastIPIndexOffset, 4); IPRecordNum := (LastIPIndexOffset - FirstIPIndexOffset) div 7 + 1; end; destructor TIPLocation.Destroy; begin QQWryFileStream.Free; FLock.Free; inherited Destroy; end; function TIPLocation.GetIPLocation(IPLocationOffset: Cardinal): TStringlist; const // 实际信息字串存放位置的重定向模式 REDIRECT_MODE_1 = 1; REDIRECT_MODE_2 = 2; 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, 1); while ord(ReadByte) <> 0 do begin Result := Result + ReadByte; QQWryFileStream.Read(ReadByte, 1); end; end; // function ReadArea(AreaOffset: Cardinal): ansistring; var ModeByte: byte; ReadAreaOffset: Cardinal; begin ReadAreaOffset := 0; QQWryFileStream.Seek(AreaOffset, soFromBeginning); QQWryFileStream.Read(ModeByte, 1); if (ModeByte = REDIRECT_MODE_1) or (ModeByte = REDIRECT_MODE_2) then begin QQWryFileStream.Read(ReadAreaOffset, 3); if ReadAreaOffset = 0 then Result := '未知地区' else Result := ReadString(ReadAreaOffset); end else begin Result := ReadString(AreaOffset); end; end; begin CountryFirstOffset := 0; CountrySecondOffset := 0; // 跳过4个字节，该4字节内容为该条IP信息里IP地址段中的终止IP值 QQWryFileStream.Seek(IPLocationOffset + 4, soFromBeginning); // 读取国家信息的重定向模式值 QQWryFileStream.Read(RedirectMode, 1); // 重定向模式1的处理 if RedirectMode = REDIRECT_MODE_1 then begin // 模式值为1，则后3个字节的内容为国家信息的重定向偏移值 QQWryFileStream.ReadData(CountryFirstOffset, 3); // 进行重定向 QQWryFileStream.Seek(CountryFirstOffset, soFromBeginning); // 第二次读取国家信息的重定向模式 QQWryFileStream.Read(RedirectMode, 1); // 第二次重定向模式为模式2的处理 if RedirectMode = REDIRECT_MODE_2 then begin // 后3字节的内容即为第二次重定向偏移值 QQWryFileStream.ReadData(CountrySecondOffset, 3); // 读取第二次重定向偏移值下的字符串值，即为国家信息 CountryMsg := ReadString(CountrySecondOffset); // 若第一次重定向模式为1，进行重定向后读取的第二次重定向模式为2， // 则地区信息存放在第一次国家信息偏移值的后面 QQWryFileStream.Seek(CountryFirstOffset + 4, soFromBeginning); // 第二次重定向模式不是模式2的处理 end else begin CountryMsg := ReadString(CountryFirstOffset); end; // 在重定向模式1下读地区信息值 AreaMsg := ReadArea(QQWryFileStream.Position); // 重定向模式2的处理 end else if RedirectMode = REDIRECT_MODE_2 then begin QQWryFileStream.ReadData(CountrySecondOffset, 3); CountryMsg := ReadString(CountrySecondOffset); AreaMsg := ReadArea(IPLocationOffset + 8); // 不是重定向模式的处理，存放的即是IP地址信息 end else begin CountryMsg := ReadString(QQWryFileStream.Position - 1); AreaMsg := ReadArea(QQWryFileStream.Position); end; Result := TStringlist.Create; Result.Add(CountryMsg); Result.Add(AreaMsg); end; function TIPLocation.GetIPMsg(IPRecordID: Cardinal): TStringlist; var aryStartIP: array [1 .. 4] of byte; strStartIP: string; EndIPOffset: Cardinal; aryEndIP: array [1 .. 4] of byte; strEndIP: string; i: integer; begin EndIPOffset := 0; // 根据记录ID号移到该记录号的索引处 QQWryFileStream.Seek(FirstIPIndexOffset + (IPRecordID - 1) * 7, soFromBeginning); // 索引的前4个字节为起始IP地址 QQWryFileStream.Read(aryStartIP, 4); // 后3个字节是内容区域的偏移值 // QQWryFileStream.Read(EndIPOffset, 3); QQWryFileStream.ReadData(EndIPOffset, 3); // 移至内容区域 QQWryFileStream.Seek(EndIPOffset, soFromBeginning); // 内容区域的前4个字节为终止IP地址 QQWryFileStream.Read(aryEndIP, 4); // 将起止IP地址转换为点分的形式 strStartIP := ''; for i := 4 downto 1 do begin if i <> 1 then strStartIP := strStartIP + IntToStr(aryStartIP[i]) + '.' else strStartIP := strStartIP + IntToStr(aryStartIP[i]); end; strEndIP := ''; for i := 4 downto 1 do begin if i <> 1 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 := 0; CompareIPValue1 := 0; CompareIPValue2 := 0; QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div 2 + IPRecordFrom - 1) * 7, soFromBeginning); QQWryFileStream.Read(CompareIPValue1, 4); QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div 2 + IPRecordFrom) * 7, soFromBeginning); QQWryFileStream.Read(CompareIPValue2, 4); // 找到了 if (IPValue >= CompareIPValue1) and (IPValue < CompareIPValue2) then begin Result := (IPRecordTo - IPRecordFrom) div 2 + IPRecordFrom; end else // 后半段找 if IPValue > CompareIPValue1 then begin Result := SearchIPRecordID((IPRecordTo - IPRecordFrom) div 2 + IPRecordFrom + 1, IPRecordTo, IPValue); end else // 前半段找 if IPValue < CompareIPValue1 then begin Result := SearchIPRecordID(IPRecordFrom, (IPRecordTo - IPRecordFrom) div 2 + IPRecordFrom - 1, IPValue); end; end; begin Result := SearchIPRecordID(1, 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) > 0 do begin Result.Add(copy(aString, 1, pos(aSplitChar, aString) - 1)); aString := copy(aString, pos(aSplitChar, aString) + 1, length(aString) - pos(aSplitChar, aString)); end; Result.Add(aString); end; begin tsIP := SplitStringToStringlist(IP, '.'); Result := 0; for i := 3 downto 0 do begin Result := Result + StrToInt(tsIP[i]) * trunc(power(256, 3 - i)); end; end; function TIPLocation.GetLocation(IP: string): String; begin FLock.Enter; try Result := GetIPMsg(GetIPRecordID(IP))[2]; finally FLock.Leave; end; end; function TIPLocation.GetQQWryDataFrom: string; begin Result := GetIPMsg(GetIPRecordNum)[2]; end; function TIPLocation.GetQQWryDate: TDate; var DateString: string; begin DateString := GetIPMsg(GetIPRecordNum)[3]; DateString := copy(DateString, 1, pos('IP数据', DateString) - 1); 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. |
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- 纯真IP数据库解析Delphi D10.1下正常使用
- UTF-8使用纯真IP数据库乱码问题（已解决）
- 需要这样一个记录本-9 Delphi使用TADOQuery时提示：不正常地定义参数对象。提供了一不致或不完整的信息。
- 深度解析工业图形专家（VG）在delphi中的使用
- discuz 使模板中的函数不解析 正常使用
- 使用ruby解析纯真IP库（qqwry.dat)
- 使用Delphi解析XML 文档
- PHP使用纯真IP数据库
- 使用纯真IP数据库查询访问者所在地
- php 使用 纯真IP数据库 －纯php
- ServiceStack.RabbitMQ在站点中使用时导致静态页面无法正常解析
- java解析纯真IP数据库
- Delphi中使用ISuperObject解析Json数据的实现代码
- 【VOLTE案例解析】南京移动拨打10086回落到2G，拨打其他电话正常使用VOLTE
- php读取纯真ip数据库使用示例
- PHP获取IP地址所在地信息(使用纯真IP数据库qqwry.dat)
- Delphi使用SuperObject解析Json时提示“Integer overflow”
- php读取纯真ip数据库使用示例
- 使用php来读取纯真ip数据库
- php 使用 纯真IP数据库 - C 代码