qileilove
          

          blog已經轉移至github,大家請訪問 http://qaseven.github.io/
          
			
          
				
					
	
          
		
          
			UTF-8使用純真IP數據庫亂碼問題
		
          
		
          最近手頭在寫一個根據IP地址返回省份地區的代碼，發現在使用純真ip數據庫的時候出現亂碼，最后發現純真數據庫是居于GBK編碼的，而我的整個工程編碼都是采用的UTF-8編碼，兩個走到一起肯定會出現亂碼，所以只能改寫純真讀取ip的類
          <%
          '得到訪問者IP
          public Function getip()
          Dim strIPAddr
          If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
          strIPAddr = Request.ServerVariables("REMOTE_ADDR")
          ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
          strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
          actforip=Request.ServerVariables("REMOTE_ADDR")
          ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
          strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
          actforip=Request.ServerVariables("REMOTE_ADDR")
          Else
          strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
          actforip=Request.ServerVariables("REMOTE_ADDR")
          End If
          getip = Trim(Mid(strIPAddr, 1, 30))
          End Function
          ' ============================================
          ' 返回IP地區信息
          ' ============================================
          Function Look_Ip(IP)
          Dim Wry, IPType, QQWryVersion, IpCounter
          ' 設置類對象
          Set Wry = New TQQWry
          ' 開始搜索，并返回搜索結果
          ' 您可以根據 QQWry(IP) 返回值來判斷該IP地址在數據庫中是否存在，如果不存在可以執行其他的一些操作
          ' 比如您自建一個數據庫作為追捕等，這里我就不詳細說明了
          IPType = Wry.QQWry(IP)
          ' Country：國家地區字段
          ' LocalStr：省市及其他信息字段
          Look_Ip = Wry.Country & " " & Wry.LocalStr
          End Function
          ' ============================================
          ' 返回QQWry信息
          ' ============================================
          Function WryInfo()
          Dim Wry, IPType, QQWry(1)
          ' 設置類對象
          Set Wry = New TQQWry
          IPType = Wry.QQWry("255.255.255.255")
          ' 讀取數據庫版本信息
          QQWry(0) = Wry.Country & " " & Wry.LocalStr
          ' 讀取數據庫IP地址數目
          QQWry(1) = Wry.RecordCount + 1
          WryInfo = QQWry
          End Function
          ' ============================================
          ' IP物理定位搜索類
          ' ============================================
          Class TQQWry
          ' ============================================
          ' 變量聲名
          ' ============================================
          Dim Country, LocalStr, Buf, OffSet
          Private StartIP, EndIP, CountryFlag
          Public QQWryFile
          Public FirstStartIP, LastStartIP, RecordCount
          Private Stream, EndIPOff
          ' ============================================
          ' 類模塊初始化
          ' ============================================
          Private Sub Class_Initialize
          Country = ""
          LocalStr = ""
          StartIP = 0
          EndIP = 0
          CountryFlag = 0
          FirstStartIP = 0
          LastStartIP = 0
          EndIPOff = 0
          QQWryFile = Server.MapPath("/yxgame/date/qqwry.dat") 'QQ IP庫路徑，要轉換成物理路徑
          End Sub
          ' ============================================
          ' IP地址轉換成整數 ip
          ' ============================================
          Function IPToInt(IP)
          If Instr(IP,":")>0 Then IP="127.0.0.1" '當IP地址是::1這樣的地址時返回本機地址
          Dim IPArray, i
          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
          IPToInt = (CInt(IPArray(0))*256*256*256) + (CInt(IPArray(1))*256*256) + (CInt(IPArray(2))*256) + 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)
          EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256)
          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)
          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)
          If InStr(Country, "CZ88.NET") Then Country = "本地/局域網"
          If InStr(LocalStr, "CZ88.NET") Then 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
          OffSet = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256)
          Else
          Exit Do
          End If
          Loop
          If (OffSet < 12 ) Then
          GetFlagStr = ""
          Else
          Stream.Position = OffSet
          GetFlagStr = GetStr()
          End If
          End Function
          ' ============================================這里獲取代碼最關鍵了
          ' 獲取字串信息 (www.viming.com)
          '-----utf-8-----------
          Private Function GetStr()
          dim c
          getstr = ""
          dim objstream
          set objstream = server.createobject("adodb.stream")
          objstream.type = 1
          objstream.mode =3
          objstream.open
          c = stream.read(1)
          do while (ascb(c)<>0 and not stream.eos)
          objstream.write c
          c = stream.read(1)
          loop
          objstream.position = 0
          objstream.type = 2
          objstream.charset = "gb2312"
          getstr = objstream.readtext
          objstream.close
          set objstream = nothing
          End Function
          ' ============================================
          ' 核心函數，執行IP搜索
          ' ============================================
          Public Function QQWry(DotIP)
          Dim IP, nRet
          Dim RangB, RangE, RecNo
          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)
          FirstStartIP = 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)
          LastStartIP = 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
          ' ============================================
          ' 類終結
          ' ============================================
          Private Sub Class_Terminate
          On ErrOr Resume Next
          Stream.Close
          If Err Then Err.Clear
          Set Stream = Nothing
          End Sub
          End Class
          %>
          　　最后就簡單了，到需要用到顯示的地方只需調用 look_ip()這個函數就可以了，哈哈。



          
		
          
			posted on 2013-10-16 10:50 順其自然EVO 閱讀(723) 評論(0)  編輯  收藏  
		
          
	
          
	
	


	


          
	    
    




          





          


          

	
          
		
          
				
		
	
		
          
		
		
          只有注冊用戶登錄后才能發表評論。
          
		
          
			
		
          
			
		
          
		
		
          
		


          

		          		
		
          
		
          			
		
		
		
		
          
		
          
		
		
          
		
          
			網站導航:
		
		
          
		
          
			
		
          	
		
          
			 
		
          
		
          
			
		
          
		
          
			
				
		
          		
	
          	

          



          

				
			
          
			
          
				
					
          
	
          
		
          <2013年10月>
          
	
          日一二三四五六
          293012345
          6789101112
          13141516171819
          20212223242526
          272829303112
          3456789
          

          

					

          導航
          

					

          統計
          
	
					
					

          常用鏈接
          


          留言簿(55)
          


		
          隨筆分類
          
		
				
			
	
		
          隨筆檔案
          
		
				
			
	
		
          文章分類
          
		
				
			
	
		
          文章檔案
          
		
				
			
	



          搜索
          



          最新評論
	
          

          
	
			
		

          


          閱讀排行榜
          



          評論排行榜
          


				
			
          			
			

	

    







          
        
	




主站蜘蛛池模板：
衡阳县|
靖州|
汨罗市|
孟津县|
棋牌|
景东|
洞口县|
合阳县|
甘泉县|
高雄市|
博兴县|
浦县|
永顺县|
中江县|
始兴县|
孟津县|
长宁区|
清水河县|
永春县|
娄烦县|
建水县|
安仁县|
黄梅县|
佛教|
疏附县|
三门峡市|
锡林浩特市|
凤阳县|
黄陵县|
桦川县|
仁怀市|
耿马|
通州市|
孝昌县|
申扎县|
城固县|
青海省|
凌源市|
横峰县|
岳阳县|
台前县|