纯真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.