VB 使用纯真ip数据库查询ip地理位置

VB 使用纯真ip数据库查询ip地理位置 VB ä,?ç??çº?真ipæ??æ??åº?æŸ,è??ipåœ?ç?†ä,?ç,? (2011-05-21 10:15:56) æ ‡ç??ﵚ vb ipåœ?å?? ç??æ??å ? ç??æ?? æ??æ??åº? æ?‚è?ˆ 'ä,?ç??è?,å‡,æ??æŸ,è?? Public Function GetAddress(sip) If Len(sip) < 5 Then GetAddress = "è??å…,IPé??è??ﵕ" Exit Function End If On Error Resume Next Dim Wry, IPType Set Wry = New ShowIp If Not Wry.IsIp(sip) Then GetAddress = " è??å…,IPé??è??ﵕ" Exit Function End If IPType = Wry.QQWry(sip) GetAddress = Wry.Country & " " & Wry.LocalStr End Function 'ç??æ??å ?,å?,å ä?ºShowIp ' ============================================ ' å??é‡?å??å?? ' ============================================ Public Country, LocalStr, Buf, OffSet Private StartIP, EndIP, CountryFlag Public QQWryFile Public FirstStartIP, LastStartIP, RecordCount Private Stream, EndIPOff ' ============================================ ' ç??æ??å ?åˆ?å?‹åŒ? ' ============================================ Private Sub Class_Initialize() On Error Resume Next Country = "" LocalStr = "" StartIP = 0 EndIP = 0 CountryFlag = 0 FirstStartIP = 0 LastStartIP = 0 EndIPOff = 0 QQWryFile = "QQWry.Dat" 'QQ IPåº?è??å?„ End Sub ' ============================================ ' IPåœ?å??è,?æ??æˆ?æ??æ?? ' ============================================ Function Iptoint(IP) As Single Dim IPArray, i, Iptoint1 As Single, Iptoint2 As Single, Iptoint3 As Single, Iptoint4 As Single IPArray = Split(IP, ".", -1) For i = 0 To 3 If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0 If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i))) If CInt(IPArray(i)) > 255 Then IPArray(i) = 255 Next Iptoint1 = CInt(IPArray(3)) Iptoint2 = CInt(IPArray(2)): Iptoint2 = Iptoint2 * 256 Iptoint3 = CInt(IPArray(1)): Iptoint3 = Iptoint3 * 256: Iptoint3 = Iptoint3 * 256 Iptoint4 = CInt(IPArray(0)): Iptoint4 = Iptoint4 * 256: Iptoint4 = Iptoint4 * 256: Iptoint4 = Iptoint4 * 256 Iptoint = Iptoint1 + Iptoint2 + Iptoint3 + Iptoint4 'è??ä?ªç??æ??åœ?VBä??䵚有æº?出?ä??çŸ,é??ä??ä?ˆå?Ÿå› Iptoint = ((CInt(IPArray(0)) * 256 * 256 + CInt(IPArray(1)) * 256 + CInt(IPArray(2))) * Iptoint + CInt(IPArray(3)) End Function ' ============================================ ' æ??æ??é?†è,?IPåœ?å?? ' ============================================ Function IntToIP(IntValue) p4 = IntValue - Fix(IntValue / 256) * 256 IntValue = (IntValue - p4) / 256 p3 = IntValue - Fix(IntValue / 256) * 256 IntValue = (IntValue - p3) / 256 p2 = IntValue - Fix(IntValue / 256) * 256 IntValue = (IntValue - p2) / 256 p1 = IntValue IntToIP = CStr(p1) & "." & CStr(p2) & "." & CStr(p3) & "." & CStr(p4) End Function ' ============================================ ' è??å ?åµ?å?‹IPä, ç?? ' ============================================ Private Function GetStartIP(RecNo) OffSet = FirstStartIP + RecNo * 7 Stream.Position = OffSet Buf = Stream.Read(7) FirstStartIP1 = AscB(MidB(Buf, 1, 1)) FirstStartIP2 = AscB(MidB(Buf, 2, 1)): FirstStartIP2 = FirstStartIP2 * 256 FirstStartIP3 = AscB(MidB(Buf, 3, 1)): FirstStartIP3 = FirstStartIP3 * 256: FirstStartIP3 = FirstStartIP3 * 256 FirstStartIP4 = AscB(MidB(Buf, 4, 1)): FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256 StartIP = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 + FirstStartIP4 LastStartIP1 = AscB(MidB(Buf, 5, 1)) LastStartIP2 = AscB(MidB(Buf, 6, 1)): LastStartIP2 = LastStartIP2 * 256 LastStartIP3 = AscB(MidB(Buf, 7, 1)): LastStartIP3 = LastStartIP3 * 256: LastStartIP3 = LastStartIP3 * 256 'LastStartIP4 = AscB(MidB(Buf, 8, 1)): LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256 EndIPOff = LastStartIP1 + LastStartIP2 + LastStartIP3 '+ LastStartIP4 'è??ä?ªç??æ??åœ?VBä??䵚有æº?出?ä??çŸ,é??ä??ä?ˆå?Ÿå› EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1)) * 256) + (AscB(MidB(Buf, 7, 1)) * 256 * 256) 'è??ä?ªç??æ??åœ?VBä??䵚有æº?出?ä??çŸ,é??ä??ä?ˆå?Ÿå› StartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1)) * 256) + (AscB(MidB(Buf, 3, 1)) * 256 * 256) + (AscB(MidB(Buf, 4, 1)) * 256 * 256 * 256) GetStartIP = StartIP End Function ' ============================================ ' è??å ?ç??æ?ŸIPä,?ç,? ' ============================================ Private Function GetEndIP() Stream.Position = EndIPOff Buf = Stream.Read(5) FirstStartIP1 = AscB(MidB(Buf, 1, 1)) FirstStartIP2 = AscB(MidB(Buf, 2, 1)): FirstStartIP2 = FirstStartIP2 * 256 FirstStartIP3 = AscB(MidB(Buf, 3, 1)): FirstStartIP3 = FirstStartIP3 * 256: FirstStartIP3 = FirstStartIP3 * 256 FirstStartIP4 = AscB(MidB(Buf, 4, 1)): FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256 EndIP = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 + FirstStartIP4 'è??ä?ªç??æ??åœ?VBä??䵚有æº?出?ä??çŸ,é??ä??ä?ˆå?Ÿå› EndIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1)) * 256) + (AscB(MidB(Buf, 3, 1)) * 256 * 256) + (AscB(MidB(Buf, 4, 1)) * 256 * 256 * 256) CountryFlag = AscB(MidB(Buf, 5, 1)) GetEndIP = EndIP End Function ' ============================================ ' è??å ?åœ?域ä??æ??﵌包å??å›,å?? å?Œå?Œçœ?å?‚ ' ============================================ Private Sub GetCountry(IP) If (CountryFlag = 1 Or CountryFlag = 2) Then Country = GetFlagStr(EndIPOff + 4) If CountryFlag = 1 Then LocalStr = GetFlagStr(Stream.Position) ' ä?,ä?‹ç??æ?,è??å??æ??æ??åº?版æœ?ä??æ?? If IP >= Iptoint("255.255.255.0") And IP <= Iptoint("255.255.255.255") Then LocalStr = GetFlagStr(EndIPOff + 21) Country = GetFlagStr(EndIPOff + 12) End If Else LocalStr = GetFlagStr(EndIPOff + 8) End If Else Country = GetFlagStr(EndIPOff + 4) LocalStr = GetFlagStr(Stream.Position) End If ' è?‡æ?,æ??æ??åº?ä??çš„æ? ç??ä??æ•? Country = Trim(Country) LocalStr = Trim(LocalStr) End Sub ' ============================================ ' è??å ?IPåœ?å??æ ‡è?†ç?? ' ============================================ Private Function GetFlagStr(OffSet) Dim Flag Flag = 0 Do While (True) Stream.Position = OffSet Flag = AscB(Stream.Read(1)) If (Flag = 1 Or Flag = 2) Then Buf = Stream.Read(3) If (Flag = 2) Then CountryFlag = 2 EndIPOff = OffSet - 4 End If FirstStartIP1 = AscB(MidB(Buf, 1, 1)) FirstStartIP2 = AscB(MidB(Buf, 2, 1)): FirstStartIP2 = FirstStartIP2 * 256 FirstStartIP3 = AscB(MidB(Buf, 3, 1)): FirstStartIP3 = FirstStartIP3 * 256: FirstStartIP3 = FirstStartIP3 * 256 OffSet = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 ' + FirstStartIP4 Else Exit Do End If Loop If (OffSet < 12) Then GetFlagStr = "" Else Stream.Position = OffSet GetFlagStr = GetStr() End If End Function ' ============================================ ' è??å ?å,?ä??ä??æ•? ' ============================================ Private Function GetStr() Dim c GetStr = "" Do While (True) c = AscB(Stream.Read(1)) If (c = 0) Then Exit Do 'å?‚æ?œæ??å?Œå??节﵌å??è?›è?Œé??å??节åœ?ç??å?ˆä,?å??节å?ˆæˆ?ä? ?ä?ªå??ç?? If c > 127 Then If Stream.EOS Then Exit Do GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(c))) Else GetStr = GetStr & Chr(c) End If Loop End Function ' ============================================ ' æ ?å?ƒå‡,æ??﵌æ‰?è?ŒIPæ œç?? ' ============================= =============== Public Function QQWry(DotIP) Dim IP, nRet Dim RangB, RangE, RecNo Dim FirstStartIP1, FirstStartIP2, FirstStartIP3, FirstStartIP4 Dim LastStartIP1, LastStartIP2, LastStartIP3, LastStartIP4 IP = Iptoint(DotIP) Set Stream = CreateObject("ADodb.Stream") Stream.Mode = 3 Stream.Type = 1 Stream.Open Stream.LoadFromFile QQWryFile Stream.Position = 0 Buf = Stream.Read(8) FirstStartIP1 = AscB(MidB(Buf, 1, 1)) FirstStartIP2 = AscB(MidB(Buf, 2, 1)): FirstStartIP2 = FirstStartIP2 * 256 FirstStartIP3 = AscB(MidB(Buf, 3, 1)): FirstStartIP3 = FirstStartIP3 * 256: FirstStartIP3 = FirstStartIP3 * 256 FirstStartIP4 = AscB(MidB(Buf, 4, 1)): FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256 FirstStartIP = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 + FirstStartIP4 LastStartIP1 = AscB(MidB(Buf, 5, 1)) LastStartIP2 = AscB(MidB(Buf, 6, 1)): LastStartIP2 = LastStartIP2 * 256 LastStartIP3 = AscB(MidB(Buf, 7, 1)): LastStartIP3 = LastStartIP3 * 256: LastStartIP3 = LastStartIP3 * 256 LastStartIP4 = AscB(MidB(Buf, 8, 1)): LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256 LastStartIP = LastStartIP1 + LastStartIP2 + LastStartIP3 + LastStartIP4 'è??ä?ªç??æ??åœ?VBä??䵚有æº?出?ä??çŸ,é??ä??ä?ˆå?Ÿå› LastStartI P = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1)) * 256) + (AscB(MidB(Buf, 7, 1)) * 256 * 256) + (AscB(MidB(Buf, 8, 1)) * 256 * 256 * 256) RecordCount = Int((LastStartIP - FirstStartIP) / 7) ' åœ?æ??æ??åº?ä??æ‰?ä??åˆ?ä??ä,?IPåœ?å?? If (RecordCount <= 1) Then Country = "未çŸ," QQWry = 2 Exit Function End If RangB = 0 RangE = RecordCount Do While (RangB < (RangE - 1)) RecNo = Int((RangB + RangE) / 2) Call GetStartIP(RecNo) If (IP = StartIP) Then RangB = RecNo Exit Do End If If (IP > StartIP) Then RangB = RecNo Else RangE = RecNo End If Loop Call GetStartIP(RangB) Call GetEndIP If (StartIP <= IP) And (EndIP >= IP) Then ' æ??有æ‰?åˆ? nRet = 0 Else ' æ,?å?? nRet = 3 End If Call GetCountry(IP) QQWry = nRet End Function ' ============================================ ' æ??æŸ,IPåœ?å??å?ˆæ??æ?? ' ============================================ Public Function IsIp(IP) varparts = Split( IP, ".") Debug.Print UBound(varparts) If UBound(varparts) <> 3 Then IsIp = False Exit Function End If For i = 0 To 3 If Val(varparts(i)) > 255 Or Val(varparts(i)) < 0 Then IsIp = False Exit Function Else IsIp = True End If Next i End Function ' ============================================ ' ç??ç?ˆç?? ' ============================================ Private Sub Class_Terminate() On Error Resume Next Stream.Close If Err Then Err.Clear Set Stream = Nothing End Sub