本程序采用动网论坛格式数据库, 可从动网论坛的data目录找到 数据库文件为:IPaddress.MDB
'----------------------
'Datei: Ip.asp
<!--#include file="conn.asp"-->
<!--#include file="inc/config.asp"-->
<%Response.ContentType = "image/gif"
ConnDatabase
Tempip,myipnumeber,sql,rs1 dimmen
Düsteres Land, Stadt
tempip=ReqIP
tempip = Split(tempip,".")
wenn Ubound(tempip)=3 dann
Für i=0 bis Ubound(tempip)
tempip(i)=left(tempip(i),3)
if isnumeric(tempip(i)) then
tempip(i)=cint(tempip(i))
anders
tempip(i)=0
Ende wenn
nächste
myipnumeber=tempip(0)*256*256*256+tempip(1)*256*256+tempip(2)*256+tempip(3)
Ende wenn
sql="Wählen Sie Land und Stadt aus DV_Address aus, wobei IP1<="&myipnumeber&" und IP2>="&myipnumeber
set rs1=conn.execute(sql)
wenn nicht rs1.eof Dann
Land = rs1(0)
Stadt = rs1(1)
Anders
Land = "51Tiao.Com"
Stadt = ""
Ende wenn
rs1.close: Setze rs1 = Nichts
CloseDatabase
Dim LocalFile,TargetFile
LocalFile = Server.MapPath("Ip.gif")
Dunkles JPEG
Setze Jpeg = Server.CreateObject("Persits.Jpeg")
Wenn -2147221005=Err dann
Response.write „没有这个组件，请安装!“ '检查查是否安装AspJpeg组件
Response.End()
Ende wenn
Jpeg.Open (LocalFile) '打开图片
Wenn Fehlernummer, dann
Response.write"打开图片失败,请检查路径！"
Response.End()
Ende wenn
Dim aa
aa=Jpeg.Binary '将原始数据赋给aa
'=========加文字水印====http://www.devdao.com/=========== ==
Jpeg.Canvas.Font.Color = &H000000 '水印文字颜色
Jpeg.Canvas.Font.Family = "宋体" '字体
Jpeg.Canvas.Font.Bold = False 'Neue Datei
Jpeg.Canvas.Font.Size = 12 'große Größe
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 ' ' wird angezeigt
Jpeg.Canvas.PrintText 30,30,"-------------------------------------" '水印位置及文字
Jpeg.Canvas.PrintText 30,50,“ Beispiel: „& ReqIP
Jpeg.Canvas.PrintText 30,70,“ Beispiel: „&Land&“ „&Stadt
Jpeg.Canvas.PrintText 30,90,“ Referenz: „&ClientInfo(0)
Jpeg.Canvas.PrintText 30,110,“ oder „&RegExpFilter(“Microsoft<sup>®</sup>“, ClientInfo(1), 0, „“)
Jpeg.Canvas.PrintText 30.130,"-------------------------------------"
Jpeg.Canvas.PrintText 30.145,“个性签名来自风易在线www.downcodes.com
bb=Jpeg.Binary '将文字水印处理后的值赋给bb, 这时, 文字水印没有不透明度
'============调整文字透明度================
Setze 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 Zoll
cc=MyJpeg.Binary '将最终结果赋值给cc,这时也可以生成目标图片了
Response.BinaryWrite cc 'wird nicht als Antwort verwendet
setze aa=nichts
setze bb=nichts
setze cc=nichts
Jpeg.close: Setze Jpeg = Nichts
MyJpeg.Close: Setze MyJpeg = Nothing
Logo.Close: Logo = Nichts festlegen
%>
'---------------------------------------------- ---
'Datei: conn.asp
<%dim conn,dbpath,UserIP
sub ConnDatabase
Bei Fehler Weiter fortsetzen
set conn=server.createobject("adodb.connection")
DBPath = Server.MapPath("IP.MDB")
conn.Open „Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath
Wenn Sie sich irren, dann
ähm.Klar
Setzen Sie Conn = Nothing
Antwort. Schreiben Sie „数据库正在更新中，请稍后再试！“
Antwort.Ende
Ende wenn
End Sub
Sub CloseDatabase
Verbindung schließen
Setzen Sie Conn = Nothing
End Sub%>
'------------------------------ ----
'Datei: config.asp
<%
Dimmen Sie User_Agent
User_Agent = Request.ServerVariables("HTTP_USER_AGENT")
' ==========================================
' 获取客户端配置
' ==========================================
Öffentliche Funktion ClientInfo(sType)
Wenn sType = 0, dann
Wenn InStr(User_Agent, "Windows 98") Dann
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") oder InStr(User_Agent, "Linux") oder InStr(User_Agent, "SunOS") oder InStr(User_Agent, "BSD") Then
ClientInfo = "Unix & Linux"
Anders
ClientInfo = „Andere“
Ende wenn
ElseIf sType = 1 Dann
Wenn InStr(User_Agent, "MSIE 7"), dann
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
ClientInfo = "Netscape<sup>®</sup>"
ElseIf InStr(User_Agent, "Opera") Then
ClientInfo = "Opera<sup>®</sup>"
Anders
ClientInfo = „Andere“
Ende wenn
Ende wenn
Funktion beenden
' ==========================================
' 按照指定的正则表达式替换字符
' ==========================================
Öffentliche Funktion RegExpFilter(Patrn, Str, sType, ReplacementWith)
RegEx dimmen
Setze RegEx = New RegExp
Wenn sType = 1, dann
RegEx.Global = True
Anders
RegEx.Global = Falsch
Ende wenn
RegEx.Pattern = Patrn
RegEx.IgnoreCase = True
RegExpFilter = RegEx.Replace(Str, ReplacementWith)
Funktion beenden
Öffentliche Funktion ReqIP()
ReqIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
Wenn ReqIP = "" oder IsNull(ReqIP), dann ReqIP = Request.ServerVariables("REMOTE_ADDR")
Funktion beenden
%>