Tag: ip138

ip138查询ASP源码

pop：在网上搜集到的，随便修改了一下。要正常使用的话，下载一个最新的纯真IP数据库到目录下就可以查询了。

代码如下：

<%
IP = request("IP")
If IP = "" then
IP = Request.ServerVariables("REMOTE_ADDR")
%>
<style type="text/css">
<!--
.search {
    height: auto;
    width: 200px;
}
.STYLE1 {
    font-size: 12px;
    font-weight: bold;
}
-->
</style>
<title>ip138ASP查询程序</title><table width="400" align="center">
  <tr>
    <td><span class="STYLE1">您的IP是：</span><%=IP%> &nbsp;<span class="STYLE1">来自：</span><%=Disp_IPAddressData(IP,2)%><%=Disp_IPAddressData(IP,3)%>
  <%End if%></td>
  </tr>
</table>

<br />
<table width="400" border="0" align="center">
  <tr>
    <td><span class="STYLE1">请输入您需要查询的IP地址：</span>
      <input name="IP" type="text" id="IP">
        <input type="submit" name="Submit" value="查询">
      </td>
  </tr>
</table>
<p align="center"><br />
<%
' ============================================
' 返回IP信息 Disp_IPAddressData(IP,0)
' ============================================
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
        '''''Look_Ip = Wry.Country & ""
End Function
' ============================================
' 返回IP信息 JS调用
' ============================================
Function Disp_IPAddressData(IP, sType)
        Dim Wry, IPType
        Set Wry = New TQQWry
        IPType = Wry.QQWry(IP)
        Select Case sType
                Case 1 Disp_IPAddressData = IP
                Case 2 Disp_IPAddressData = Wry.Country
                Case 3 Disp_IPAddressData = Wry.LocalStr
                'Case Else Disp_IPAddressData = Wry.Country & "" & Wry.LocalStr
                Case Else Disp_IPAddressData = Wry.Country
        End Select
End Function
' ============================================
' 返回QQWry信息
' ============================================
Function WryInfo()
        Dim Wry, IPType, QQWry_tem(0), QQWry_tem1(1)
        ' 设置类对象
        Set Wry = New TQQWry
        IPType = Wry.QQWry("255.255.255.254")
        ' 读取数据库版本信息
        QQWry_tem(0) = Wry.Country & " " & Wry.LocalStr
        ' 读取数据库IP地址数目
        QQWry_tem1(1) = Wry.RecordCount + 1
        WryInfo = QQWry_tem(0)& " " & QQWry_tem1(1)
End Function

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("QQWry.Dat")
        End Sub
        ' ============================================
        ' IP地址转换成整数
        ' ============================================
        Function IPToInt(IP)
                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
        ' ============================================
        ' 获取字串信息
        ' ============================================
        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
                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
%>
<br />
Copyright (c) pop 2008 Allright Reserved.

结合ip138获取外网ip（BAT、VBS）代码

批处理代码：

代码1工作原理：获取IP到文本里面

@echo off
<"%~f0" more +5 >tmp.vbs
cscript //NoLogo /e:vbscript tmp.vbs %1>ip.txt
echo >nul && del tmp.vbs
goto:eof
set oDOM = WScript.GetObject("http://www.ip138.com/ip2city.asp")

do until oDOM.readyState = "complete"
WScript.sleep 200
Loop
s=oDOM.documentElement.innerText
set re = New RegExp
re.Pattern="(\d+)\.(\d+)\.(\d+)\.(\d+)"
For Each m in re.Execute(s)
WScript.Echo m
Next

代码2工作原理

下载http://www.ip138.com/ip2city.asp，取“您的IP地址是：" 右13位保存到windows目录下 IP.TXT，利用<读取IP.TXT内容并显示，最后得到%n% 就是外网IP地址值，这对我来说用途太大了。

至于大家说是不是原创，我认为没有所谓的原创，我们天生下来是不会VBS的，但是我们会调用代码为我们工作，只要实用有效就行了。

@echo off
echo On Error Resume next >checkip.vbs
echo Url="http://www.ip138.com/ip2city.asp" >>checkip.vbs
echo Set NP = Createobject("Microsoft.XMLHTTP") >>checkip.vbs
echo NP.Open "GET", url, False >>checkip.vbs
echo NP.Send >>checkip.vbs
echo Data=NP.responsebody >>checkip.vbs
echo Set NP = Nothing >>checkip.vbs
echo Data = bytes2BSTR(Data) >>checkip.vbs
echo Here = InstrRev(Data, "您的IP地址是：", -1,0) >>checkip.vbs
echo Data = Mid(Data,Here+9,13) >>checkip.vbs
echo Hers = InstrRev(data, "<",-1,0) >>checkip.vbs
echo Set ICEhack = CreateObject("InternetExplorer.Application") >>checkip.vbs
echo ICEhack.Navigate("about:blank") >>checkip.vbs
echo If Hers ^<^> 0 Then >>checkip.vbs
echo ICEhack.document.parentwindow.clipboardData.SetData "text", Mid(Data,1,Hers-1) >>checkip.vbs
echo Set WshSHell = WScript.CreateObject("WScript.Shell") >>checkip.vbs
echo Set FSO = CreateObject("Scripting.FileSystemObject") >>checkip.vbs
echo Set SCF = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(0),"ip.txt"),2,True) >>checkip.vbs
echo SCF.Write(Data) >>checkip.vbs
echo SCF.Close >>checkip.vbs
echo Else >>checkip.vbs
echo ICEhack.document.parentwindow.clipboardData.SetData "text", Data >>checkip.vbs
echo Set WshSHell = WScript.CreateObject("WScript.Shell") >>checkip.vbs
echo Set FSO = CreateObject("Scripting.FileSystemObject") >>checkip.vbs
echo Set SCF = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(0),"ip.txt"),2,True) >>checkip.vbs
echo SCF.Write(Data) >>checkip.vbs
echo SCF.Close >>checkip.vbs
echo End If >>checkip.vbs
echo ICEhack.Quit >>checkip.vbs
echo fso.DeleteFile(WScript.ScriptName) >>checkip.vbs
echo Function bytes2BSTR(vIn) >>checkip.vbs
echo strReturn = "" >>checkip.vbs
echo For i = 1 To LenB(vIn) >>checkip.vbs
echo ThisCharCode = AscB(MidB(vIn,i,1)) >>checkip.vbs
echo If ThisCharCode ^< ^&H80 Then >>checkip.vbs
echo strReturn = strReturn ^& Chr(ThisCharCode) >>checkip.vbs
echo Else >>checkip.vbs
echo NextCharCode = AscB(MidB(vIn,i+1,1)) >>checkip.vbs
echo strReturn = strReturn ^& Chr(CLng(ThisCharCode) * ^&H100 + CInt(NextCharCode)) >>checkip.vbs
echo i = i + 1 >>checkip.vbs
echo End If >>checkip.vbs
echo Next >>checkip.vbs
echo bytes2BSTR = strReturn >>checkip.vbs
echo End Function >>checkip.vbs
checkip.vbs
set/p n=