ASP制作显示来访者信息图片(IP地址+操作系统+浏览器+个性签名)

ASP +ASPJPEG

 

 

这个代码还是老早的代码.我还做了一个比这个还要友好的代码.我再找找吧.这个是个人版.

<%session.codepage="936" ''==================================''描述:签名显IP来源 V2.0''作者：艳雪 ''最后更新日期:2009-9-13''=================================dim ReqIP,User_AgentReqIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")If ReqIP = "" Or IsNull(ReqIP) Then ReqIP = Request.ServerVariables("REMOTE_ADDR")User_Agent = Request.ServerVariables("HTTP_USER_AGENT")Response.ContentType = "image/GIF"''定义输出类型dim bb,MyJpegDim LocalFileLocalFile = 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 = &HCC338F ''水印文字颜色 Jpeg.Canvas.Font.Family = "楷体" ''字体 Jpeg.Canvas.Font.Bold = False ''是否加粗 Jpeg.Canvas.Font.Size = 13 ''字体大小 Jpeg.Canvas.Font.ShadowColor = &H5EA25E ''阴影色彩 Jpeg.Canvas.Font.ShadowYOffset = 1 Jpeg.Canvas.Font.ShadowXOffset = 1 Jpeg.Canvas.Brush.Solid = False Jpeg.Canvas.Font.Quality = 10 '' ''输出质量 Jpeg.Canvas.PrintText 20, 18, "这是您的来访信息:"Jpeg.Canvas.PrintText 180, 18, "艳雪（Yane）"Jpeg.Canvas.PrintText 20, 26, "--------------------------------------"Jpeg.Canvas.PrintText 24, 36, "IP地址: " & ReqIPJpeg.Canvas.PrintText 24, 52, "IP定位: " & Look_Ip(ReqIP)Jpeg.Canvas.PrintText 24, 68, "操作系统: " & ClientInfo(0)Jpeg.Canvas.PrintText 24, 84, "浏览器: " & ClientInfo(1)Jpeg.Canvas.PrintText 20, 100, "--------------------------------------"Jpeg.Canvas.PrintText 20, 116, "欢迎来到[Yx-love.Cn]"Jpeg.Canvas.PrintText 20, 132, "艳雪个人网站"Jpeg.Canvas.PrintText 20, 148, "我的QQ：547227045"bb=Jpeg.Binary ''将文字水印处理后的值赋给bb，这时，文字水印没有不透明度 ''============调整文字透明度================ Set MyJpeg = Server.CreateObject("Persits.Jpeg") MyJpeg.OpenBinary aa dim Logo1,ccSet Logo1 = Server.CreateObject("Persits.Jpeg") Logo1.OpenBinary bb MyJpeg.DrawImage 0,0, Logo1, 0.9 ''0.9是透明度 cc=MyJpeg.Binary ''将最终结果赋值给cc,这时也可以生成目标图片了 Response.BinaryWrite cc ''将二进输出给浏览器 set aa=nothing set bb=nothing set cc=nothing Jpeg.close : Set Jpeg = NothingMyJpeg.Close : Set MyJpeg = NothingLogo1.Close : Set Logo1 = Nothing'' ============================================'' 返回IP地址信息'' ============================================Function Look_Ip(IP) Dim Wry, IPType, QQWryVersion, IpCounter '' 设置类对象 Set Wry = New TQQWry '' 开始搜索，并返回搜索结果 '' 您可以根据 QQWry(IP) 返回值来判断该IP地址在数据库中是否存在，如果不存在可以执行其他的一些操作 '' 比如您自建一个数据库作为追捕等，这里我就不详细说明了 IPType = Wry.QQWry(IP) '' Country：国家地区字段 '' LocalStr：省市及其他信息字段 Look_Ip = Wry.Country & " " & Wry.LocalStrEnd Function'' ============================================'' 返回操作系统及浏览器'' ============================================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 CE") Then ClientInfo = "Windows CE" 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 6.0") Then ClientInfo = "Windows vista" ElseIf InStr(User_Agent, "Windows NT 6.1") Then ClientInfo = "Windows 7" ElseIf InStr(User_Agent, "Windows NT") Then ClientInfo = "Windows NT" ElseIf InStr(User_Agent, "WinWAP") Then ClientInfo = "winwap内核" 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, "TencentTraveler") Then ClientInfo = "TT浏览器" ElseIf InStr(User_Agent, "Maxthon") Then ClientInfo = "傲游浏览器" ElseIf InStr(User_Agent, "306SE") Then ClientInfo = "360安全浏览器" ElseIf InStr(User_Agent, "TheWorld") Then ClientInfo = "世界之窗浏览器" ElseIf InStr(User_Agent, "MSIE 8") Then ClientInfo = "IE 8.0" ElseIf InStr(User_Agent, "MSIE 7") Then ClientInfo = "IE 7.0" ElseIf InStr(User_Agent, "MSIE 6") Then ClientInfo = "IE 6.0" ElseIf InStr(User_Agent, "MSIE 5") Then ClientInfo = "IE 5.0" ElseIf InStr(User_Agent, "MSIE 4") Then ClientInfo = "IE 4.0" ElseIf InStr(User_Agent, "Netscape") Then ClientInfo = "Netscape" ElseIf InStr(User_Agent, "Opera") Then ClientInfo = "Opera" ElseIf InStr(User_Agent, "Firefox") Then ClientInfo = "火狐浏览器" ElseIf InStr(User_Agent, "Chrome") Then ClientInfo = "google浏览器" ElseIf InStr(User_Agent, "WinWAP") Then ClientInfo = "winwap浏览器" ElseIf InStr(User_Agent, "NetCaptor") Then ClientInfo = "NetCaptor" Else ClientInfo = "Other" End If End IfEnd Function'' ============================================'' IP物理定位搜索类'' ============================================Class TQQWry '' ============================================ '' 变量声名 '' ============================================ Dim Country, LocalStr, Buf, OffSet Private StartIP, EndIP, CountryFlag Public QQWryFile Public FirstStartIP, LastStartIP, RecordCount Private Stream, EndIPOff '' ============================================ '' 类模块初始化 '' ============================================ Private Sub Class_Initialize Country = "" LocalStr = "" StartIP = 0 EndIP = 0 CountryFlag = 0 FirstStartIP = 0 LastStartIP = 0 EndIPOff = 0 QQWryFile = Server.MapPath("QQWry.dat") ''QQ IP库路径，要转换成物理路径 End Sub '' ============================================ '' IP地址转换成整数 '' ============================================ Function IPToInt(IP) Dim IPArray, i IPArray = Split(IP, ".", -1) FOr i = 0 to 3 If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0 If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i))) If CInt(IPArray(i)) > 255 Then IPArray(i) = 255 Next IPToInt = (CInt(IPArray(0))*256*256*256) + (CInt(IPArray(1))*256*256) + (CInt(IPArray(2))*256) + CInt(IPArray(3)) End Function '' ============================================ '' 整数逆转IP地址 '' ============================================ Function 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) End Function '' ============================================ '' 获取开始IP位置 '' ============================================ Private Function GetStartIP(RecNo) OffSet = FirstStartIP + RecNo * 7 Stream.Position = OffSet Buf = Stream.Read(7) EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256) StartIP = 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 End Function '' ============================================ '' 获取结束IP位置 '' ============================================ Private Function 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 End Function '' ============================================ '' 获取地域信息，包含国家和和省市 '' ============================================ Private Sub GetCountry(IP) If (CountryFlag = 1 Or CountryFlag = 2) Then Country = GetFlagStr(EndIPOff + 4) If CountryFlag = 1 Then LocalStr = GetFlagStr(Stream.Position) '' 以下用来获取数据库版本信息 If IP >= IPToInt("255.255.255.0") And IP <= IPToInt("255.255.255.255") Then LocalStr = GetFlagStr(EndIPOff + 21) Country = GetFlagStr(EndIPOff + 12) End If Else LocalStr = GetFlagStr(EndIPOff + 8) End If Else Country = GetFlagStr(EndIPOff + 4) LocalStr = GetFlagStr(Stream.Position) End If '' 过滤数据库中的无用信息 Country = Trim(Country) LocalStr = Trim(LocalStr) If InStr(Country, "CZ88.NET") Then Country = "Yx-love.Cn" If InStr(LocalStr, "CZ88.NET") Then LocalStr = "Yx-love.Cn" End Sub '' ============================================ '' 获取IP地址标识符 '' ============================================ Private Function GetFlagStr(OffSet) Dim Flag Flag = 0 Do While (True) Stream.Position = OffSet Flag = AscB(Stream.Read(1)) If(Flag = 1 Or Flag = 2 ) Then Buf = Stream.Read(3) If (Flag = 2 ) Then CountryFlag = 2 EndIPOff = OffSet - 4 End If OffSet = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) Else Exit Do End If Loop If (OffSet < 12 ) Then GetFlagStr = "" Else Stream.Position = OffSet GetFlagStr = GetStr() End If End Function '' ============================================ '' 获取字串信息 '' ============================================ Private Function GetStr() Dim c GetStr = "" Do While (True) c = AscB(Stream.Read(1)) If (c = 0) Then Exit Do ''如果是双字节，就进行高字节在结合低字节合成一个字符 If c > 127 Then If Stream.EOS Then Exit Do GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(C))) Else GetStr = GetStr & Chr(c) End If Loop End Function '' ============================================ '' 核心函数，执行IP搜索 '' ============================================ Public Function QQWry(DotIP) Dim IP, nRet Dim RangB, RangE, RecNo IP = IPToInt (DotIP) Set 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) LastStartIP = 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) '' 在数据库中找不到任何IP地址 If (RecordCount <= 1) Then Country = "未知" QQWry = 2 Exit Function End If RangB = 0 RangE = RecordCount Do While (RangB < (RangE - 1)) RecNo = Int((RangB + RangE)/2) Call GetStartIP (RecNo) If (IP = StartIP) Then RangB = RecNo Exit Do End If If (IP > StartIP) Then RangB = RecNo Else RangE = RecNo End If Loop Call GetStartIP(RangB) Call GetEndIP() If (StartIP <= IP) And ( EndIP >= IP) Then '' 没有找到 nRet = 0 Else '' 正常 nRet = 3 End If Call GetCountry(IP) QQWry = nRet End Function '' ============================================ '' 类终结 '' ============================================ Private Sub Class_Terminate On ErrOr Resume Next Stream.Close If Err Then Err.Clear Set Stream = Nothing End SubEnd Class %>

 

 要想支持其他用户使用.那么我们在URL地址中添加参数.

也就是使用GET的方式.

 

<%
img=Request("img")  '背景图片
qianm=Request("qianm") '个性签名1
qianm2=Request("qianm2")
QQ=Request("qq")   
%>

 

 

然后在下面判断是否为空,如果为空的话就输出以前定义的.这样就可以随意DIY了