¿Cómo detectaron mi IP?
Guardar como archivo .asp. Simplemente agrega una base de datos de IP y listo
Muy simple
Llama al código
-------------- ---- ----
<%
session.codepage="936"
'=========== ==== ===================
'Nombre de archivo: qmipv2.0.asp
'Descripción: Firma Fuente IP V2 .0
'Autor: /, Pantalla khhx@vip.qq.com
'Fecha de actualización: 2008-10-26
'= === =============================
dim ReqIP,User_Agent
ReqIP = Request .ServerVariables("HTTP_X_FORWARDED_FOR")
Si ReqIP = "" O IsNull(ReqIP) Entonces ReqIP = Request.ServerVariables("REMOTE_ADDR")
User_Agent = Request.ServerVariables ("HTTP_USER_AGENT ")
Response.ContentType = "image/gif"'Definir tipo de salida
dim bb,MyJpeg
Dim LocalFile
LocalFile = Server.MapPath("IpImg.gif") 'Preste atención a modificar la posición de la imagen de fondo.
Dim Jpeg
Establecer Jpeg = Server.CreateObject("Persits.Jpeg")
Si -2147221005=Err entonces
Respuesta .write "Este componente no existe, ¡instálelo!" 'Compruebe si el componente AspJpeg está instalado
Response.End()
End If
Jpeg.Open (LocalFile) 'Abre la imagen
Si el número de error es
Response.write "Error al abrir la imagen, ¡comprueba la ruta!" p> Response.End()
p>
Finalizar si
Dim aa
aa=Jpeg.Binary 'Asigna los datos originales a aa
'======= ==Agregar marca de agua de texto=================
Jpeg.Canvas.Font.Color = &Hff0000 'Color del texto de la marca de agua
Jpeg .Canvas.Font.Family = "宋体" 'Font
Jpeg.Canvas.Font.Bold = False 'Si está en negrita
Jpeg.Canvas.Font.Size = 12 'Tamaño de fuente
Jpeg.Canvas.Font.ShadowColor = &Hffffff 'Color de sombra
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = False
Jpeg.Canvas.Font.Quality = 10 ' ' Calidad de salida
Jpeg.Canvas.PrintText 20, 18, "Búsqueda de datos completada:"
Jpeg.Canvas.PrintText 180, 18, "/, Pantalla"
Jpeg.Canvas.PrintText 20, 26, "-- ------------------------------------ "
Jpeg.Canvas.PrintText 24, 36, "Dirección IP: " & ReqIP
Jpeg.Canvas.PrintText 24, 52, "Posicionamiento IP: " & Look_Ip(ReqIP)
Jpeg.Canvas.PrintText 24, 68, "Sistema operativo: " & ClientInfo(0)
Jpeg.Canvas.PrintText 24, 84, "Navegador: " & ClientInfo(1 )
Jpeg.Canvas.PrintText 20, 100, "-------------------------------- ----------"
Jpeg.Canvas.PrintText 20, 116, "Bienvenido a usar /, sistema de posicionamiento IP de pantalla"
Jpeg.Canvas.PrintText 20, 132, "Declaración: No se puede garantizar que el posicionamiento IP sea 100% correcto"
p>
Jpeg.Canvas.PrintText 20, 148, "Hay un cierto error.
Lo anterior es solo para pruebas"
bb=Jpeg.Binary 'Asigne el valor después del procesamiento de la marca de agua de texto a bb. En este momento, la marca de agua de texto no tiene opacidad
'== === =======Ajustar la transparencia del texto================
Establecer MyJpeg = Server.CreateObject("Persits.Jpeg")
MyJpeg.OpenBinary aa
dim Logo1,cc
Establecer Logo1 = Server.CreateObject("Persits.Jpeg")
Logo1. OpenBinary bb
MyJpeg.DrawImage 0,0, Logo1, 0.9 '0.9 es transparencia
cc=MyJpeg.Binary 'Asigna el resultado final a cc. también se puede generar
cc=MyJpeg.Binary p>
Response.BinaryWrite cc 'Salida binaria al navegador
set aa=nada
set bb =nada
establecer cc=nada
Jpeg.close: Establecer Jpeg = Nada
MyJpeg.Close: Establecer MyJpeg = Nada
Logo1.Close: Establecer Logo1 = Nada
' =================================== ==========
' Devolver información de la dirección IP
' ===================== =============== ===========
Función Look_Ip(IP)
Dim Wry, IPType, QQWryVersion, IpCounter
'Establecer objeto de clase
Set Wry = New TQQWry
' Iniciar la búsqueda y devolver los resultados de la búsqueda
' Puede juzgar si la dirección IP está en la base de datos según el valor de retorno de QQWry(IP). Si no existe, puede realizar algunas otras operaciones
' Por ejemplo, puede crear una base de datos para caza, etc., no lo explicaré en detalle aquí
IPType = Wry.QQWry (IP)
' País: campo de país y región
' LocalStr: provincia, ciudad y otros campos de información
Look_Ip = Wry.Country & " " & LocalStr
End Function
' ===== ============================= ============
' Volver al sistema operativo y al navegador
' ================ ====================== =======
Función ClientInfo(sType)
Si sType = 0 Entonces
Si InStr(User_Agent, "Windows 98") Entonces
ClientInfo = "Windows 98"
ElseIf InStr(User_Agent, "Win 9x 4.90" ) Then
ClientInfo = "Windows ME"
El
seIf InStr(User_Agent, "Windows NT 5.0") Entonces
ClientInfo = "Windows 2000"
ElseIf InStr(User_Agent, "Windows NT 5.1") Entonces
ClientInfo = "Windows XP"
ElseIf InStr(User_Agent, "Windows NT 5.2") Luego
ClientInfo = "Windows 2003"
ElseIf InStr(User_Agent , "Windows NT") Entonces
ClientInfo = "Windows NT"
ElseIf InStr(User_Agent, "unix") O InStr(User_Agent, "Linux") O InStr(User_Agent, "SunOS") O InStr(User_Agent, "BSD") Entonces
ClientInfo = "Unix & Linux"
Else
ClientInfo = "Otro"
Fin si
ElseIf sType = 1 Entonces
Si InStr(User_Agent, "MSIE 8") Entonces
ClientInfo = "Microsoft? Internet Explorer 8.0"
ElseIf InStr(User_Agent, "MSIE 7") Entonces
ClientInfo = "Microsoft? Internet Explorer 7.0"
ElseIf InStr(User_Agent, " MSIE 6") Entonces
ClientInfo = "Microsoft? Internet Explorer 6.0"
ElseIf InStr(User_Agent, "MSIE 5") Entonces
ClientInfo = "Microsoft ? Internet Explorer 5.0"
ElseIf InStr(User_Agent, "MSIE 4") Entonces
ClientInfo = "Microsoft?> Internet Explorer 4.0"
ElseIf InStr(? User_Agent, "Netscape") Entonces
ClientInfo = "Netscape?"
ElseIf InStr(User_Agent, "Opera") Entonces
ClientInfo = "Opera?"
Else
ClientInfo = "Otro"
Finalizar si
Finalizar si
Finalizar función
' =============================================
' Clase de búsqueda de posicionamiento físico ScreenIP
' ========
====================================
Clase TQQWry
' =============================================
'Declaración de variables
' ==================================== =========
Dim Country, LocalStr, Buf, OffSet
Private StartIP, EndIP, CountryFlag
Public QQWryFile
FirstStartIP pública, LastStartIP, RecordCount
Transmisión privada, EndIPOff
' ====================== ======================
' Inicialización del módulo de clase
' ========= ===================================
Subclase privada_Inicializar
País = ""
LocalStr = ""
StartIP = 0
EndIP = 0
CountryFlag = 0
FirstStartIP = 0
LastStartIP = 0
EndIPOff = 0
QQWryFile = Server.MapPath("QQWry.dat") 'Biblioteca de IP de QQ Ruta, que se convertirá en una ruta física
End Sub
' ========================= == ==================
' Convertir dirección IP a número entero
' ========= == =================================
Función IPToInt(IP)
Dim IPArray, i
IPArray = Split(IP, ".", -1)
PARA i = 0 a 3
Si no IsNumeric( IPArray(i)) Entonces IPArray(i) = 0
Si CInt(IPArray(i)) < 0 Entonces IPArray(i) = Abs(CInt(IPArray(i)))
Si CInt(IPArray(i)) > 255 Entonces IPArray(i) = 255
Siguiente
IPToInt = (CInt(IPArray(0))*256*256 *256 ) + (CInt(IPArray(1))*256*256) + (CInt(IPArray(2))*256) + CInt(IPArray(3))
Función final
' =============================================
' Dirección IP inversa entera
' ==========================
===================
Función 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)
Función final
' =============================================
'Obtener la ubicación IP inicial
' ================================= === ===========
Función privada GetStartIP(RecNo)
OffSet = FirstStartIP + RecNo * 7
Transmisión. Posición = Desplazamiento
Buf = Stream.Read(7)
EndIPoff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1) )*256 ) + (AscB(MidB(Buf, 7, 1))*256*256)
InicioIP = 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
Función final
' ============================ === ==============
' Obtener la ubicación IP final
' ============= ==== ============================
Función privada 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
Función final
' ======== ==== =====
===========================
'Obtén información regional, incluyendo país, provincia y ciudad
' ==============================================
Sub privado GetCountry(IP)
Si (CountryFlag = 1 o CountryFlag = 2) Entonces
País = GetFlagStr(EndIPOff + 4)
Si CountryFlag = 1 Entonces
LocalStr = GetFlagStr(Stream.Position)
' Lo siguiente se utiliza para obtener información de la versión de la base de datos
Si IP >= IPToInt( "255.255 .255.0") Y IP <= IPToInt("255.255.255.255") Luego
LocalStr = GetFlagStr(EndIPOff + 21)
País = GetFlagStr(EndIPOff + 12)< /p >
Finalizar si
Else
LocalStr = GetFlagStr(EndIPOff + 8)
Finalizar si
Else
País = GetFlagStr(EndIPOff + 4)
LocalStr = GetFlagStr(Stream.Position)
End If
'Filtrar información inútil en el base de datos
País = Trim(País)
LocalStr = Trim(LocalStr)
Si InStr(País, "CZ88.NET") Entonces País = "LeoYung .COM "
Si InStr(LocalStr, "CZ88.NET") Then LocalStr = "LeoYung.COM"
Fin Sub
' ==== == ======================================
' Obtener IP Símbolo de identificación de dirección
' ======================================== == ===
Función privada GetFlagStr(OffSet)
Bandera atenuada
Bandera = 0
Hacer mientras (Verdadero)< /p >
Stream.Position = OffSet
Bandera = AscB(Stream.Read(1))
If(Flag = 1 Or Flag = 2) Entonces
Buf = Stream.Read(3)
Si (Flag = 2 ) Entonces
CountryFlag = 2
EndIPOff = OffSet - 4
Fin si
OffSet = AscB(MidB(Buf, 1,
1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256)
Else
Salir Do
Finalizar si
Bucle
Si (OffSet < 12 ) Entonces
GetFlagStr = ""
Else
Stream.Position = OffSet
GetFlagStr = GetStr()
Finalizar si
Finalizar función
' =============================================
' Obtener información de cadena
' ================================== = ============
Función privada GetStr()
Dim c
GetStr = ""
Do While (True)
c = AscB(Stream.Read(1))
If (c = 0) Then Exit Do
'If es para bytes dobles, combine el byte alto con el byte bajo para formar un carácter
Si c > 127 Entonces
Si Stream.EOS entonces salga Do
GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(C)))
Else
GetStr = GetStr & Chr(c )
Finalizar si
Bucle
Función final
' ================ = ============================
'Función principal, realizar búsqueda de IP
' =============================================
Función pública QQWry(DotIP)
Dim IP, nRet
Dim RangB, RangE, RecNo
IP = IPToInt (DotIP)
Establecer 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)
Última IP de inicio
= 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)
' No se pudo encontrar ninguna dirección IP
Si (RecordCount <= 1) Entonces
País = "Desconocido"
QQWry = 2
Función de salida
p >Finalizar si
RangB = 0
RangE = RecordCount
Hacer mientras (RangB < (RangE - 1))
RecNo = Int((RangB + RangE)/2)
Llamar a GetStartIP (RecNo)
Si (IP = StartIP) Entonces
RangB = RecNo
Salir Do
Finalizar si
Si (IP > StartIP) Entonces
RangB = RecNo
Si no
RangE = RecNo
Finalizar si
Bucle
Llamar a GetStartIP(RangB)
Llamar a GetEndIP()
Si (IPInicio <= IP) Y (IPFinal >= IP) Entonces
' No encontrado
nRet = 0
Si no
' Normal
nRet = 3
Finalizar si
Llamar a GetCountry(IP)
QQWry = nRet
Función final
' ================================== = ==========
' Terminación de clase
' ====================== = ======================
Terminar subclase privada
En caso de error o reanudar siguiente
Stream.Close
Si Err Then Err.Clear
Establecer Stream = Nothing
End Sub
Fin de clase
%>