asp制作显示IP图片

2018-09-06 11:33

阅读:443

  本程序采用动网论坛格式数据库,可从动网论坛的data目录找到 数据库文件为:ipaddress.MDB
------------------------------------
File: Ip.asp

  <!--#include file=conn.asp-->
<!--#include file=inc/config.asp-->
ConnDatabase
Dim tempip,myipnumeber,sql,rs1
Dim country,city
tempip=ReqIP
tempip = Split(tempip,.)
if Ubound(tempip)=3 then
For i=0 To Ubound(tempip)
tempip(i)=left(tempip(i),3)
if isnumeric(tempip(i)) then
tempip(i)=cint(tempip(i))
else
tempip(i)=0
end if
next
myipnumeber=tempip(0)*256*256*256+tempip(1)*256*256+tempip(2)*256+tempip(3)
End If
sql=select country,city from DV_Address where IP1<=myipnumeber and IP2>=myipnumeber
set rs1=conn.execute(sql)
if not rs1.eof Then
country = rs1(0)
city = rs1(1)
Else
city =
End If
rs1.close : Set rs1 = Nothing
CloseDatabase

  Dim LocalFile,TargetFile
LocalFile = Server.MapPath(Ip.gif)
Dim Jpeg
Set Jpeg = Server.CreateObject(Persits.Jpeg)
If -2147221005=Err then
Response.write 没有这个组件,请安装! 检查是否安装AspJpeg组件
Response.End()
End If
Jpeg.Open (LocalFile) 打开图片
If err.number then
Response.write打开图片失败,请检查路径!
Response.End()
End if
Dim aa
aa=Jpeg.Binary 将原始数据赋给aa

  =========加文字水印====
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 = False
Jpeg.Canvas.Font.Quality = 4 输出质量
Jpeg.Canvas.PRintText 30,30,------------------------------------- 水印位置及文字
Jpeg.Canvas.PrintText 30,50, 你的IP: ReqIP
Jpeg.Canvas.PrintText 30,70, 你的位置: country city
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,个性签名来自风易在线
bb=Jpeg.Binary 将文字水印处理后的值赋给bb,这时,文字水印没有不透明度

  
============调整文字透明度================
Set MyJpeg = Server.CreateObject(Persits.Jpeg)
MyJpeg.OpenBinary aa

  Set Logo = Server.CreateObject(Persits.Jpeg)
Logo.OpenBinary bb
MyJpeg.DrawImage 0,0, Logo, 0.9 0.3是透明度
cc=MyJpeg.Binary 将最终结果赋值给cc,这时也可以生成目标图片了
Response.BinaryWrite cc 将二进输出给浏览器
set aa=nothing
set bb=nothing
set cc=nothing
Jpeg.close : Set Jpeg = Nothing
MyJpeg.Close : Set MyJpeg = Nothing
Logo.Close : Set Logo = Nothing
%>

  --------------------------------------------------
File: conn.asp

  <%dim conn,dbpath,UserIP
sub ConnDatabase
On Error Resume next
DBPath = Server.MapPath(IP.MDB)
conn.Open Provider=Microsoft.Jet.OLEDB.4.0;Data Source= DBPath
If Err Then
err.Clear
Set Conn = Nothing
Response.Write 数据库正在更新中,请稍后再试!
Response.End
End If
End Sub

  Sub CloseDatabase
Conn.close
Set Conn = Nothing
End Sub%>

  -------------------------------------------------
File: config.asp

  <%
Dim User_Agent
User_Agent = Request.ServerVariables(HTTP_USER_AGENT)

============================================
获取客户端配置
============================================
Public Function ClientInfo(sType)
If sType = 0 Then
If InStr(User_Agent, Windows 98) Then
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) or InStr(User_Agent, linux) or InStr(User_Agent, SunOS) or InStr(User_Agent, BSD) Then
ClientInfo = Unix Linux
Else
ClientInfo = Other
End If
ElseIf sType = 1 Then
If InStr(User_Agent, MSIE 7) Then
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
&n


评论


亲,登录后才可以留言!