本程序采用动网论坛格式数据库,可从动网论坛的data目录找到 数据库文件为:IPaddress.MDB
'------------------------------------
'Arquivo: Ip.asp
<!--#include file="conn.asp"-->
<!--#include file="inc/config.asp"-->
<%Response.ContentType = "imagem/gif"
ConnDatabase
Dim tempip,meuipnumeber,sql,rs1
País escuro, cidade
tempip=ReqIP
tempip = Dividir(tempip,".")
se Ubound(tempip)=3 então
Para i = 0 para Ubound (tempip)
tempip(i)=esquerda(tempip(i),3)
se for numérico(tempip(i)) então
tempip(i)=cint(tempip(i))
outro
temperatura(i)=0
terminar se
próximo
meuipnumeber=tempip(0)*256*256*256+tempip(1)*256*256+tempip(2)*256+tempip(3)
Terminar se
sql="selecione país, cidade de DV_Address onde IP1<="&myipnumeber&" e IP2>="&myipnumeber
definir rs1=conn.execute(sql)
se não for rs1.eof Então
país = rs1(0)
cidade = rs1(1)
Outro
país = "51Tiao.Com"
cidade = ""
Terminar se
rs1.close: Definir rs1 = Nada
CloseDatabase
Dim LocalFile, TargetFile
LocalFile = Server.MapPath("Ip.gif")
Escurecer JPEG
Definir Jpeg = Server.CreateObject("Persits.Jpeg")
Se -2147221005=Erro então
Response.write "没有这个组件，请安装!" '检查是否安装AspJpeg组件
Resposta.End()
Terminar se
Jpeg.Open (LocalFile) '打开图 foto
Se err.número então
Response.write"打开图片失败,请检查路径！"
Resposta.End()
Terminar se
Dim aa
aa=Jpeg.Binary '将原始数据赋给aa
'=========加文字水印====http://www.devdao.com/=========== ==
Jpeg.Canvas.Font.Color = &H000000 '水印文字颜色
Jpeg.Canvas.Font.Family = "宋体" '字体
Jpeg.Canvas.Font.Bold = False '是否加粗
Jpeg.Canvas.Font.Size = 12 '字体大小
Jpeg.Canvas.Font.ShadowColor = &Hffffff '阴影色彩
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = Falso
Jpeg.Canvas.Font.Quality = 4 ' '输出质量
Jpeg.Canvas.PrintText 30,30,"-------------------------------------" '水印位置及文字
Jpeg.Canvas.PrintText 30,50," 你的ＩＰ: "& ReqIP
Jpeg.Canvas.PrintText 30,70," 你的位置: "&país&" "&cidade
Jpeg.Canvas.PrintText 30,90," 操作系统: "&ClientInfo(0)
Jpeg.Canvas.PrintText 30,110," 浏 览 器: "&RegExpFilter("Microsoft<sup>®</sup> ", ClientInfo(1), 0, "")
Jpeg.Canvas.PrintText 30.130,"-------------------------------------"
Jpeg.Canvas.PrintText 30.145,"个性签名来自风易在线www.downcodes.com "
bb=Jpeg.Binary '将文字水印处理后的值赋给bb，这时，文字水印没有不透明度
'============调整文字透明度================
Definir MyJpeg = Server.CreateObject("Persits.Jpeg")
MyJpeg.OpenBinary aa
Definir logotipo = Server.CreateObject("Persits.Jpeg")
Logo.OpenBinary bb
MyJpeg.DrawImage 0,0, Logo, 0,9 '0,3 imagem
cc=MyJpeg.Binary '将最终结果赋值给cc,这时也可以生成目标图片了
Response.BinaryWrite cc '将二进输出给浏览器
definir aa = nada
definir bb = nada
definir cc = nada
Jpeg.close: Definir Jpeg = Nada
MyJpeg.Close: Definir MyJpeg = Nada
Logo.Close: Definir logotipo = nada
%>
'---------------------------------------------------------- ---
'Arquivo: conn.asp
<%dim conn,dbpath,UserIP
subConnDatabase
Em caso de erro, retomar próximo
definir conn=server.createobject("adodb.connection")
DBPath = Server.MapPath("IP.MDB")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Fonte de dados=" & DBPath
Se errar então
err.Limpar
Definir conexão = nada
Resposta.Escreva "数据库正在更新中，请稍后再试！"
Resposta.Fim
Terminar se
End Sub
Sub CloseDatabase
Conexão próxima
Definir conexão = nada
Fim Sub%>
'---------------------------------------------------------- ----
'Arquivo: config.asp
<%
Escurecer User_Agent
User_Agent = Request.ServerVariables("HTTP_USER_AGENT")
' ===========================================
' 获取客户端配置
' ===========================================
Função Pública ClientInfo(sType)
Se sType = 0 Então
Se InStr(User_Agent, "Windows 98") Então
ClientInfo = "Windows 98"
ElseIf InStr(User_Agent, "Win 9x 4.90") Then
ClientInfo = "Windows ME"
ElseIf InStr(User_Agent, "Windows NT 5.0") Then
ClientInfo = "Windows 2000"
ElseIf InStr(User_Agent, "Windows NT 5.1") Then
ClientInfo = "Windows XP"
ElseIf InStr(User_Agent, "Windows NT 5.2") Then
ClientInfo = "Windows 2003"
ElseIf InStr(User_Agent, "Windows NT") Then
ClientInfo = "Windows NT"
ElseIf InStr(User_Agent, "unix") ou InStr(User_Agent, "Linux") ou InStr(User_Agent, "SunOS") ou InStr(User_Agent, "BSD") Then
ClientInfo = "Unix e Linux"
Outro
ClientInfo = "Outro"
Terminar se
ElseIf sType = 1 Então
Se InStr(User_Agent, "MSIE 7") Então
ClientInfo = "Microsoft<sup>®</sup> Internet Explorer 7.0"
ElseIf InStr(User_Agent, "MSIE 6") Then
ClientInfo = "Microsoft<sup>®</sup> Internet Explorer 6.0"
ElseIf InStr(User_Agent, "MSIE 5") Then
ClientInfo = "Microsoft<sup>®</sup> Internet Explorer 5.0"
ElseIf InStr(User_Agent, "MSIE 4") Then
ClientInfo = "Microsoft<sup>®</sup> Internet Explorer 4.0"
ElseIf InStr(User_Agent, "Netscape") Then
ClientInfo = "Netscape<sup>®</sup>"
ElseIf InStr(User_Agent, "Opera") Then
ClientInfo = "Opera<sup>®</sup>"
Outro
ClientInfo = "Outro"
Terminar se
Terminar se
Função final
' ===========================================
' 按照指定的正则表达式替换字符
' ===========================================
Função pública RegExpFilter (Patrn, Str, sType, ReplaceWith)
Escurecer RegEx
Definir RegEx = Novo RegExp
Se sType = 1 Então
RegEx.Global = Verdadeiro
Outro
RegEx.Global = Falso
Terminar se
RegEx.Pattern = Padrão
RegEx.IgnoreCase = Verdadeiro
RegExpFilter = RegEx.Replace(Str, SubstituirCom)
Função final
Função Pública ReqIP()
ReqIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
Se ReqIP = "" ou IsNull(ReqIP) Então ReqIP = Request.ServerVariables("REMOTE_ADDR")
Função final
%>