首页 | 站长免费中心 | 新手上路 | 网站运营 | 网页制作 | 图片设计 | 动画设计 | 网页编程 | 网页特效 | 本站专题 | 虚拟主机 | 域名注册 | 网站建设 | 程序下载
       免费空间资源 | 新闻咨询 | 免费域名 | 免费网盘 | 网站推广 | 网站策划 | 建站经验 | 网站优化 | 网页代码 | 源码下载 | 音乐小偷 | 网络赚钱 | 论坛交流
网站建设
网站建设
虚拟主机
虚拟主机
域名注册
域名注册
711网络首页
站长工具
站长工具
网站源码
网站源码
站长论坛
站长论坛

 711网络 网页编程ASP代码

asp制作显IP图片

来源: 互联网    日期:2006-12-2
 

先上传个图,稍后贴上代码
'
[img]http://www.51tiao.com/ip/ip.asp[/img]

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

<!--#include file="conn.asp"-->
<!--#include file="inc/config.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

'=========加文字水印=================
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<sup>&reg;</sup> ", ClientInfo(1), 0, "")
Jpeg.Canvas.PrintText 30,130,"-------------------------------------"
Jpeg.Canvas.PrintText 30,145,"个性签名来自风易在线 Www.Wind88.Net"
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.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>&reg;</sup> Internet Explorer 7.0"
  ElseIf InStr(User_Agent, "MSIE 6") Then
   ClientInfo = "Microsoft<sup>&reg;</sup> Internet Explorer 6.0"
  ElseIf InStr(User_Agent, "MSIE 5") Then
   ClientInfo = "Microsoft<sup>&reg;</sup> Internet Explorer 5.0"
  ElseIf InStr(User_Agent, "MSIE 4") Then
   ClientInfo = "Microsoft<sup>&reg;</sup> Internet Explorer 4.0"
  ElseIf InStr(User_Agent, "Netscape") Then
   ClientInfo = "Netscape<sup>&reg;</sup>"
  ElseIf InStr(User_Agent, "Opera") Then
   ClientInfo = "Opera<sup>&reg;</sup>"
  Else
   ClientInfo = "Other"
  End If
 End If
End Function


' ============================================
' 按照指定的正则表达式替换字符
' ============================================
Public Function RegExpFilter(Patrn, Str, sType, ReplaceWith)
 Dim RegEx
 Set RegEx = New RegExp
 If sType = 1 Then
  RegEx.Global = True
 Else
  RegEx.Global = False
 End If
 RegEx.Pattern = Patrn
 RegEx.IgnoreCase = True
 RegExpFilter = RegEx.Replace(Str, ReplaceWith)
End Function


Public Function ReqIP()
 ReqIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
 If ReqIP = "" or IsNull(ReqIP) Then ReqIP = Request.ServerVariables("REMOTE_ADDR")
End Function
%> 



更多的asp制作显IP图片请到论坛查看: http://BBS.TC711.COM



【 双击滚屏 】 【 评论 】 【 收藏 】 【 打印 】 【 关闭 】 来源: 互联网    日期:2006-12-2   

发 表 评 论
查看评论

  您的大名:
  • 尊重网上道德,遵守中华人民共和国的各项有关法律法规
  • 承担一切因您的行为而直接或间接导致的民事或刑事法律责任
  • 本站管理人员有权保留或删除其管辖留言中的任意内容
  • 本站有权在网站内转载或引用您的评论
  • 参与本评论即表明您已经阅读并接受上述条款
认证编码: 刷新验证码
点评内容: 字数0
  精品推荐  
  本月推荐  
  友情赞助  

关于我们 | 联系我们 | 广告投放 | 留言反馈 | 免费程序 | 虚拟主机 | 网站建设 |  网站推广 |  google_sitemap baidu_sitemap RSS订阅
本站所有资源均来自互联网,如有侵犯您的版权或其他问题,请通知管理员,我们会在最短的时间回复您
Copyright © 2005-2015 Tc711.Com All Rights Reserved 版权所有·711网络   蜀ICP备05021915号
110网监备案 信息产业备案 不良信息举报