修正了查詢方法，查詢的方法和追捕的一致；只是追捕會自動更正ip。 還有個函數的書寫錯誤，也已經修正； 包括增加了一個IP地址正確性的驗證函數。（只是從格式上判斷） <% '作者：蕭寒雪(S.F.) 'QQ號：410000 Server.ScriptTimeout = &HE10 '&H3C Response.Buffer = ("S.F." = "S.F.") Dim IpSearch '建立對象 Set IpSearch = New clsIpSearch ' 該句建立SQL Server的IP地址庫的連接，可使用默認連接，但要保證存在wry.mdb IpSearch.ConnectionString = "DRIVER={SQL Server};SERVER=hostname:UID=sa;PWD=;DATABASE=Ip" ' 設置要查詢的IP，可用默認值，這里設置的是 127.0.0.1 IpSearch.IpAddress = &H7F & "." & &H00 & "." & &H00 & "." & &H01 If Request.QueryString("IP")<>"" Then If IpSearch.Valid_IP(Request.QueryString("IP")) Then IpSearch.IpAddress = Trim(Request.QueryString("IP")) End If End If ' 取得IP 所在地，反饋值有三個，以逗號分割 ' 格式為：所在國家或地區,當地上網地區,提供正確IP地址信息的用戶名 Response.Write ("所在地:" & IpSearch.GetIpAddrInfo() & "<br>") ' 取出IP地址 Response.Write ("IP:" & IpSearch.IpAddress & "<br>") ' 將IP地址轉換為數值 Response.Write ("IP轉換為數值:" & IpSearch.CLongIP(IpSearch.IpAddress) & "<br>") ' 將IP地址轉換為數值后還原成IP字符串 Response.Write ("數值還原成IP:" & IpSearch.CStringIP(IpSearch.CLongIP(IpSearch.IpAddress)) & "<br>") Response.Write ("<hr>")
'這里是測試代碼 'dim a,b,c,d 'for a = 0 to 255 ' for b= 0 to 255 step 20 ' for c=0 to 255 step 20 ' for d = 0 to 255 step 20 ' IpSearch.IpAddress = a & "." & b & "." & c & "." & d ' Response.Write ("所在地:" & IpSearch.GetIpAddrInfo() & "<br>") ' Response.Write ("IP:" & IpSearch.IpAddress & "<br>") ' Response.Write ("IP轉換為數值:" & IpSearch.CLongIP(IpSearch.IpAddress) & "<br>") ' Response.Write ("數值還原成IP:" & IpSearch.CStringIP(IpSearch.CLongIP(IpSearch.IpAddress)) & "<br>") ' Response.Write ("<hr>") ' next ' next ' next 'next %> <% Class clsIpSearch '################################################################## '聲明：本程序采用的數據為網絡上著名的IP工具軟件《追捕》作者“馮志宏” '先生所精心搜集整理。 '《追捕》數據庫的轉換方法： '修改wry.dll 文件后綴名稱為 wry.dbf '方法一： ' 啟動access 數據，選擇打開數據庫，選擇打開的文件類型為“dBASE 5 (*.dbf)” ' 打開wry.dbf文件，選擇《工具》菜單下的《數據庫實用工具》中的《轉換數據庫》 ' 選擇《轉換為 Access 97 格式(版本可選)》功能，保存文件即可成為MDB格式。 '方法二： ' 使用SQL Server提供的《導入和導出數據》向導。 ' 方法簡要說明：在ODBC 控制面板中設置指向wry.dbf的DSN。 ' 使用《導入和導出數據》向導，選擇其正確的驅動程序和要導入的庫即可。 ' 或者直接導入由方法一生成的MDB文件入庫。 '方法三： ' 使用Access 打開wry.dbf 文件后將自動通過MDB庫引用原庫數據。 ' '未安裝其他數據庫平臺，其他方法欠考慮。 '###################### 類說明 #################################### '# IP 所在地搜索類 '# ConnectionString 為數據庫連接聲明，默認聲明同級目錄的wry.mdb '# IpAddress 請設置為進行搜索的IP 地址，默認取當前訪問者IP '# 類建立方法 '# Dim objVal '聲明一個變量 '# Set objVal = New clsIpSearch '建立類對象 '# Response.Write (objVal.IpAddress) '顯示當前訪問者IP '# IP 搜索類方法列表： '# .Valid_IP 'IP 地址正確性效驗 '# 參數：IP 'IP 數值或者字符串 '# .CLongIP '將IP地址轉換為長整型的數值 '# 參數：asNewIP '要轉換的IP地址字符串 '# .CStringIP '將長整型的數值轉換為IP '# 參數：anNewIP '要還原為IP地址的數值 '# .GetClientIP '取訪問者的IP '# .GetIpAddrInfo '得到設置過IpAddRess屬性的IP所在地 '# 屬性列表（自動初始化）： '# ConnEctionString 'ADo 訪問數據庫連接說明 '# IpAddress '要操作的IP地址 '# 內部錯誤處理： '# 欠缺，未做，請自行補充。 '##################################################################
Public ConnectionString Public IpAddress PRivate DBConn '連接對象，模塊級聲明 '──────────────────────────────── ' 類初始化 Private Sub Class_initialize() ' 這里建立的是通過“數據轉換--方法一”生成的mdb 庫文件 ConnectionString="DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath("wry.mdb") IpAddress = GetClientIP() Set DBConn = OpenConnection() End Sub '──────────────────────────────── ' 類注銷 Private Sub Class_Terminate() ConnectionString = Null IpAddress = Null DBConn.Close Set DBConn = Nothing End Sub '──────────────────────────────── ' 建立一個連接 Private Function OpenConnection() Dim tmpConn Set tmpConn=Server.CreateObject("ADODB.Connection") tmpConn.Open ConnectionString Set OpenConnection=tmpConn Set tmpConn=nothing End Function '──────────────────────────────── ' 執行一個SQL命令，并返回一個數據集對象 Private Function SQLExeCute(strSql) Dim Rs Set Rs=DBConn.ExeCute(strSQL) Set SQLExeCute = Rs Set Rs=nothing End Function '──────────────────────────────── 'IP 效驗 Public Function Valid_IP(ByVal IP) Dim i Dim dot_count Dim test_octet Dim byte_check IP = Trim(IP) ' 確認IP長度 If Len(IP) < &H08 Then Valid_IP = False '顯示錯誤提示 Exit Function End If
i = &H01 dot_count = &H00 For i = 1 To Len(IP) If Mid(IP, i, &H01) = "." Then ' 增加點的記數值 ' 并且設置text_octet 值為空 dot_count = dot_count + &H01 test_octet = "" If i = Len(IP) Then ' 如果點在結尾則IP效驗失敗 Valid_IP = False ' 顯示錯誤提示 Exit Function End If Else test_octet = test_octet & Mid(IP, i, &H01) ' 使用錯誤屏蔽來檢查數據段值的正確性 On Error Resume Next ' 進行強制類型轉換 ' 如果轉換失敗就可通過檢查Err是否為真來確認 byte_check = CByte(test_octet) If (Err) Then ' 強制類型轉換產生錯誤 ' 所取段值的數據不為數值 ' 或所取段值的數據長度大于&HFF ' 則類型不為byte類型 ' IP 地址的正確性為假 Valid_IP = False Exit Function End If End If Next
' 通過上一步的驗證，現在應該要檢查小點是否有3個 If dot_count <> &H03 Then Valid_IP = False Exit Function End If ' 一切正常，那么該IP為正確的IP地址 Valid_IP = True End Function '──────────────────────────────── ' 轉換一個數值為IP Public Function CStringIP(ByVal anNewIP) Dim lsResults Dim lnTemp Dim lnIndex For lnIndex = &H03 To &H00 Step -&H01 lnTemp = Int(anNewIP / (&H100 ^ lnIndex)) lsResults = lsResults & lnTemp & "." anNewIP = anNewIP - (lnTemp * (&H100 ^ lnIndex)) Next lsResults = Left(lsResults, Len(lsResults) - &H01) CStringIP = lsResults End function '──────────────────────────────── ' 轉換一個IP到數值 Public Function CLongIP(ByVal asNewIP) Dim lnResults Dim lnIndex Dim lnIpAry lnIpAry = Split(asNewIP, ".", &H04) For lnIndex = &H00 To &H03 if Not lnIndex = &H03 Then lnIpAry(lnIndex) = lnIpAry(lnIndex) * (&H100 ^ (&H03 - lnIndex)) End if lnResults = lnResults + lnIpAry(lnIndex) Next CLongIP = lnResults End function '──────────────────────────────── ' 取Client IP Public Function GetClientIP() dim uIpAddr ' 本函數參考webcn.Net/aspHouse 文獻<取真實的客戶IP> uIpAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If uIpAddr = "" Then uIpAddr = Request.ServerVariables("REMOTE_ADDR") GetClientIP = uIpAddr uIpAddr = "" End function '──────────────────────────────── ' 讀取IP所在地的信息 Public function GetIpAddrInfo() Dim tmpIpAddr Dim IpAddrVal Dim ic,charSpace Dim tmpSQL charSpace = "" IpAddrVal = IpAddress If Not Valid_IP(IpAddrVal) Then GetIpAddrInfo =NULL Exit Function End If '將IP字符串劈開成數組好進行處理 tmpIpAddr = Split(IpAddrVal,".",-1,1) For ic = &H00 To Ubound(tmpIpAddr) '補位操作,保證每間隔滿足3個字符 Select Case Len(tmpIpAddr(ic)) Case &H01 :charSpace = "00" Case &H02 :charSpace = "0" Case Else :charSpace = "" End Select tmpIpAddr(ic) = charSpace & tmpIpAddr(ic) Next IpAddrVal = tmpIpAddr(&H00) & "." & tmpIpAddr(&H01) & "." & tmpIpAddr(&H02) & "." & tmpIpAddr(&H03)
'以下為查詢，IP地址庫基于《追捕》的IP數據庫,感謝"馮志宏"先生的貢獻 '庫結構如下： 'CREATE TABLE [dbo].[wry] ( ' [STARTIP] [nvarchar] (17) COLLATE Chinese_PRC_CI_AS NULL , --起始IP段 ' [ENDIP] [nvarchar] (17) COLLATE Chinese_PRC_CI_AS NULL , --終止IP段 ' [COUNTRY] [nvarchar] (16) COLLATE Chinese_PRC_CI_AS NULL , --國家或者地區 ' [LOCAL] [nvarchar] (54) COLLATE Chinese_PRC_CI_AS NULL , --本地地址 ' [THANK] [nvarchar] (23) COLLATE Chinese_PRC_CI_AS NULL --感謝修正IP地址用戶姓名 ') ON [PRIMARY] '經過分析庫的數據存放結構，總結出準確的查詢方法，具體看下面的查詢過程 tmpSQL = "select * from wry where (startIP<='" & IpAddrVal & "') and (ENDIP>='" & IpAddrVal & "') " & _ " and left(startIP," & Len(tmpIpAddr(&H00)) & ") = '" & tmpIpAddr(&H00) & "'" & _ " and left(endip," & Len(tmpIpAddr(&H00)) & ")='" & tmpIpAddr(&H00) & "'" charSpace = GetDbIpInfo(tmpSQL) If Len(charSpace)=&H00 Then GetIpAddrInfo = NULL Else GetIpAddrInfo = charSpace End If charSpace = Null tmpSQL = Null end function '──────────────────────────────── ' 返回數據查詢的字符串 Private function GetDbIpInfo(byVal sql) Dim OpenIpSearchRs Dim result Set OpenIpSearchRs = SQLExeCute(sql) If Not OpenIpSearchRs.Eof Then result = NullToSpace(OpenIpSearchRs("COUNTRY")) & "," & NullToSpace(OpenIpSearchRs("LOCAL")) & "," & NullToSpace(OpenIpSearchRs("THANK")) Else result = NULL End If OpenIpSearchRs.Close Set OpenIpSearchRs=Nothing GetDbIpInfo = result End function '──────────────────────────────── ' 將數據庫空記錄轉換為空字符 Private function NullToSpace(byVal rsstr) If isNull(rsStr) Then NullToSpace = "" Else NullToSpace = Trim(rsStr) End If End Function End Class %>
