asp制作顯示IP圖片

本程序采用動網論壇格式數據庫,可從動網論壇的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 '=========加文字水印====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 = False Jpeg.Canvas.Font.Quality = 4 ' '輸出質量 Jpeg.Canvas.PrintText 30,30,"-------------------------------------" '水印位置及文字 Jpeg.Canvas.PrintText 30,50," 你的ＩＰ: "& 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,"個性簽名來自風易在線 www.knowsky.com" 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^® Internet Explorer 7.0" ElseIf InStr(User_Agent, "MSIE 6") Then ClientInfo = "Microsoft^® Internet Explorer 6.0" ElseIf InStr(User_Agent, "MSIE 5") Then ClientInfo = "Microsoft^® Internet Explorer 5.0" ElseIf InStr(User_Agent, "MSIE 4") Then ClientInfo = "Microsoft^® Internet Explorer 4.0" ElseIf InStr(User_Agent, "Netscape") Then ClientInfo = "Netscape^®" ElseIf InStr(User_Agent, "Opera") Then ClientInfo = "Opera^®" 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 %>