asp 代码编写显示 IP 图片 本 程 序 采 用 动 网 论 坛 格 式 数 据 库 , 可 从 动 网 论 坛 的 data 目 录 找 到 数 据 库 文 件 为:IPaddress.MDB '-----------------------------------'File: Ip.asp <%Response.ContentType = "image/gif" 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 country = "51Tiao.Com" 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 '=========加文字水印====devdao/============= 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 = 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
? ", ClientInfo(1), 0, "") Jpeg.Canvas.PrintText 30,130,"-------------------------------------" Jpeg.Canvas.PrintText 30,145,"个性签名来自风易在线 knowsky" 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 set conn=server.createobject("adodb.connection") 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.S