- 博客(0)
- 资源 (3)
空空如也
asp连接数据库代码实例
连接数据库代码实例
1,连接数据库代码 文件名称 conn.asp 所有访问数据库的文件都调用此文件<!--#include file=\"Conn.asp\"-->
<%
db=\"data/data.mdb\" \'数据库存放目录
on error resume next
set conn=server.createobject(\"adodb.connection\")
conn.open \"driver={microsoft access driver (*.mdb)};dbq=\"&server.mappath(db)
if err then
err.clear
set conn = Nothing
response.write \"数据库连接出错,请检查conn.asp中的连接字符串。\"
response.end
end if
function CloseDB
Conn.Close
set Conn=Nothing
End Function
%>
<%
dim badword
badword=\"\'|and|select|update|chr|delete|%20from|;|insert|mid|master.|set|chr(37)|=\"
if request.QueryString<>\"\" then
chk=split(badword,\"|\")
for each query_name in request.querystring
for i=0 to ubound(chk)
if instr(lcase(request.querystring(query_name)),chk(i))<>0 then
response.write \"<script language=javascript>alert(\'传参错误!参数 \"&query_name&\" 的值中包含非法字符串!\\n\\n\');location=\'\"&request.ServerVariables(\"HTTP_REFERER\")&\"\'</Script>\"
response.end
end if
next
next
end if
%>
----------------------------------------------
2。增加纪录
<%
if request(\"action\")=\"add\" then
name=request.form(\"name\")
content=request.form(\"content\")
set rs=server.createobject(\"adodb.recordset\")
sql=\"select * from biao\"
rs.open sql,conn,3,2
rs.addnew
rs(\"name\")=name
if content<>\"\" then
rs(\"content\")=content
else
rs(\"content\")=null
end if
rs(\"date\")=date()
rs.update
rs.close
set rs=nothing
response.write \"<script language=javascript>alert(\'添加成功!\');location.href(\'index.asp\');</script>\"
end if
%>
--------------------------------------
3.显示记录
<%
set rs=server.createobject(\"adodb.recordset\")
sql=\"select * from biao order by id desc\"
\'sql=\"select top 10 * from biao order by id desc\"
rs.open sql,conn,1,1
rs.pagesize=15 \'-------设置每页显示的记录数
dim page
page=request(\"page\")
if page<>\"\" and IsNumeric(page) then
page=clng(page)
else
page=1
end if
n=rs.pagecount
if page>n then
page=clng(n)
end if
if rs.eof then
response.write\"<font color=#FF0000>暂没有信息!</font>\"
\'response.end
else
rs.absolutepage=page
end if
i=0
do while not rs.eof and i<rs.pagesize
\'do while not rs.eof
%>
--------如果是每行显示n个纪录开始----------------------------
<%
do while not rs.eof and i<rs.pagesize
\'do while not rs.eof
if i mod 5=0 then \'--------设置每行显示的个数
response.write \"<tr>\"
end if
%>
--------如果是每行显示n个纪录结束-----------------------------
<%=rs(\"id\")%>
<% rs.movenext
i=i+1
loop
%>
<%
response.write(\"共\"&rs.recordcount&\"条信息 \")
if page<>1 then
response.write(\"<a href=?page=1 title=\'首页\'>首页</a> \")
else
response.write(\"首页 \")
end if
if page>1 then
response.write(\"<a href=?page=\"&page-1&\" title=\'上一页\'>上一页</a> \")
else
response.write(\"上一页 \")
end if
if page<n then
response.write(\"<a href=?page=\"&page+1&\" title=\'下一页\'>下一页</a> \")
else
response.write(\"下一页 \")
end if
if page<>n then
response.write(\"<a href=?page=\"&n&\" title=\'尾页\'>尾页</a> \")
else
response.write(\"尾页 \")
end if
response.write(\" 当前页:\"&page&\"/\"&n&\"\")
%>
转到:<select name=\"select\" onChange=\'javascript:window.open(this.options[this.selectedIndex].value,\"_top\")\'>
<%for p=1 to rs.pagecount%>
<option value=\"?page=<%=p%>\" <% if page=p then response.write \"selected\" end if%>>第<%=p%>页</option>
<%next%>
----------------------------------------------
4。更新纪录,删除纪录,删除所有记录
<%
if request(\"action\")=\"manage\" then
call manage()
end if
if request(\"action\")=\"edit\" then
id=request(\"id\")
set rs=server.createobject(\"adodb.recordset\")
sql=\"select * from biao where id=\"&id&\"\"
rs.open sql,conn,1,1
call edit()
end if
if request(\"action\")=\"del\" then
conn.execute(\"delete * from biao where id=\"&request(\"id\")&\"\")
conn.close
response.write\"<script language=\'javascript\'>alert(\'删除成功!\');location.href(\'?action=manage\');</script>\"
end if
if request(\"action\")=\"delall\" then
conn.execute(\"delete * from biao\")
conn.close
response.write\"<script language=\'javascript\'>alert(\'所有信息已成功删除!\');location.href(\'?action=manage\');</script>\"
end if
if request(\"action\")=\"saveedit\" then
name=request.form(\"name\")
hits=request.form(\"hits\")
content=request.form(\"content\")
set rs=server.createobject(\"adodb.recordset\")
sql=\"select * from biao where id=\"&request(\"id\")&\"\"
rs.open sql,conn,3,2
rs(\"name\")=name
rs(\"content\")=content
rs(\"hits\")=hits
rs.update
conn.close
set rs=nothing
response.write \"<script language=javascript>alert(\'编辑成功!\');location.href(\'?id=\"&request(\"id\")&\"&action=edit\');</script>\"
end if
%>
---------------------------------
5。查询纪录
<form name="form1" method="post" action="search.asp">
<input name="keyword" type="text" id="keyword" size="25">
<select name="select" size="1">
<option value="name" selected>名称</option>
<option value="content">说明</option>
<option value="id">id</option>
</select>
<input type="submit" name="Submit" value="查询">
</form>
------search.asp---------------
<%
if request("keyword")<>"" and request("select")<>"" then
sql="select * from biao where "&request("select")&" like '%"&request("keyword")&"%'"
elseif request("keyword")<>"" and request("select")="all" then
sql="select * from biao where name like '%"&request("keyword")&"%' or id like '%"&request("keyword")&"%' or content like '%"&request("keyword")&"%'"
else
response.redirect("index.asp")
end if
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,1
rs.pagesize=15 '-------设置每页显示的记录数
dim page
page=request("page")
if page<>"" and IsNumeric(page) then
page=clng(page)
else
page=1
end if
n=rs.pagecount
if page>n then
page=clng(n)
end if
if rs.eof then
response.write"<font color=#FF0000>查询的信息不存在或者已经删除!</font>"
'response.end
else
rs.absolutepage=page
end if
i=0
do while not rs.eof and i<rs.pagesize
'do while not rs.eof
%>
<%=rs("id")%>
<% rs.movenext
i=i+1
loop
%>
-----------------------------------------
6.有分类的纪录代码
---------------显示分类开始---------------------------------
<%
set rs=server.createobject("adodb.recordset")
sql="select all * from class order by id desc"
rs.open sql,conn,1,1
do while not rs.eof
%>
<a href="class.asp?classname=<%=rs("classname")%>"><b><%=rs("classname")%></b></a>
<%
rs.movenext
i=i+1
loop
%>
---------------显示分类结束--------------------------
-------------显示现在所在分类开始-------------------
<%
set rs=server.createobject("adodb.recordset")
sql="select top 1 * from class where classname='"&request("classname")&"'"
rs.open sql,conn,1,1
do while not rs.eof
%>
<%=rs("classname")%>
<%
rs.movenext
i=i+1
loop
%>
-----------显示现在所在分类结束----------------------
-----------显示此分类的纪录开始------------
<%
set rs=server.createobject("adodb.recordset")
sql="select * from biao where fenlei='"&request("classname")&"'"
rs.open sql,conn,1,1
rs.pagesize=10 '-------设置每页显示的记录数
dim page
page=request("page")
if page<>"" and IsNumeric(page) then
page=clng(page)
else
page=1
end if
n=rs.pagecount
if page>n then
page=clng(n)
end if
if rs.bof or rs.eof then
response.write"<font color=#ff0000>暂没有任何数据!</font>"
'response.end
else
rs.absolutepage=page
end if
i=0
do while not rs.eof and i<rs.pagesize
%>
<%=rs("id")%>
<% rs.movenext
i=i+1
loop
%>
--------------显示此分类的纪录结束----------------
---------删除所在分类纪录开始------------
<% if request("classname")<>"" then%>
<a href="?action=del_fenlei&classname=<%=request("classname")%>" title="删除所有本类信息?" onClick="{if (confirm('您确定要删除所有信息吗?')){return true;}return false;}"><font color=FF0000>清空所有本类信息</font></a>
<%end if%>
if request("action")="del_fenlei" then
classname=request("classname")
conn.execute("delete * from biao where fenlei='"&classname&"'")
CloseDB
response.write"<script language='javascript'>alert('删除本类成功!');location.href('?action=manage');</script>"
end if
---------删除所在分类纪录结束--------------------------------
-------------------------------
7。上传文件或者图片 删除文件代码 (请在同一目录建立文件夹upfile/softpic)
上传文件的页面(调用upsoftpic.asp)
<form name="form" method="post" action="?action=add" onsubmit="return chkform(this)">
<input name="picurl" type="text" id="picurl" size="20">
<iframe name="I1" width="155" height="25" src="upsoftpic.asp" scrolling="no" border="0" frameborder="0">浏览器不支持嵌入式框架,或被配置为不显示嵌入式框架。</iframe>
</form>
upsoftpic.asp
<form action="Upfile.asp?action=upsoftpic" method="POST" enctype="multipart/form-data" class="fontmenu2" onsubmit="up.disabled=true;up.value='上传中,请稍候……'">
<input name="softpic" type="file" class="fontmenu2" size="1">
<input type="submit" value="上传" name="up" >
</form>
upfile.asp
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%Server.ScriptTimeout=999%>
<!--#include file="Conn.asp"-->
<!--#include file="Upload.asp" -->
<!-- 上传软件或者图片开始 -->
<%
if request("action")="upsoftpic" then
set upload=new upload_5xsoft
set file=upload.file("softpic")
fileExt=lcase(right(file.filename,4))
if fileEXT<>".jpg" and fileEXT<>".gif" and fileEXT<>".rar" then '---设置上传类型 ++++fileEXT<>".***"++++++++
response.write"<script>alert('格式不对,请重新上传!');location='"&request.ServerVariables("HTTP_REFERER")&"'</script>"
response.end
end if
if file.fileSize>0 then
formPath="upfile/softpic" '-------上传路径
'formPath="../upfile/softpic"
if right(formPath,1)<>"/" then
formPath=formPath&"/"
end if
vfname = filename(now())
fname = vfname & "." & GetExtendName(file.FileName)
file.SaveAs Server.mappath(formPath&fname) ''保存文件
%>
<script>
parent.form.picurl.value+='upfile/softpic/<%=fname%>' //-上传路径
//parent.frmadd.dreamcontent.value+='[img]upload/<%=ufp%>[/img]'
location.replace('Upsoftpic.asp') //---返回文件
</script>
<%
'------文件名
end if
set file=nothing
set upload=nothing
function filename(fname)
fname = now()
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
filename=fname
end function
function GetExtendName(FileName)
dim ExtName
ExtName = LCase(FileName)
ExtName = right(ExtName,3)
ExtName = right(ExtName,3-Instr(ExtName,"."))
GetExtendName = ExtName
end function
end if
%>
<!-- 上传软件或者图片结束 -->
upload.asp
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft
Class upload_5xsoft
dim objForm,objFile,Version
Public function Form(strForm)
strForm=lcase(strForm)
if not objForm.exists(strForm) then
Form=""
else
Form=objForm(strForm)
end if
end function
Public function File(strFile)
strFile=lcase(strFile)
if not objFile.exists(strFile) then
set File=new FileInfo
else
set File=objFile(strFile)
end if
end function
Private Sub Class_Initialize
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
Version="化境HTTP上传程序 Version 2.0"
set objForm=Server.CreateObject("Scripting.Dictionary")
set objFile=Server.CreateObject("Scripting.Dictionary")
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set Data_5xsoft = Server.CreateObject("adodb.stream")
Data_5xsoft.Type = 1
Data_5xsoft.Mode =3
Data_5xsoft.Open
Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)
Data_5xsoft.Position=0
RequestData =Data_5xsoft.Read
iFormStart = 1
iFormEnd = LenB(RequestData)
vbCrlf = chrB(13) & chrB(10)
sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1
while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iFormStart
Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
set theFile=new FileInfo
'取得文件名
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileName=getFileName(sFileName)
theFile.FilePath=getFilePath(sFileName)
'取得文件类型
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileStart =iInfoEnd
theFile.FileSize = iFormStart -iInfoEnd -3
theFile.FormName=sFormName
if not objFile.Exists(sFormName) then
objFile.add sFormName,theFile
end if
else
'如果是表单项目
tStream.Type =1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iInfoEnd
Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sFormValue = tStream.ReadText
tStream.Close
if objForm.Exists(sFormName) then
objForm(sFormName)=objForm(sFormName)&", "&sFormValue
else
objForm.Add sFormName,sFormValue
end if
end if
iFormStart=iFormStart+iStart+1
wend
RequestData=""
set tStream =nothing
End Sub
Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_5xsoft.Close
set Data_5xsoft =nothing
end if
End Sub
Private function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, ""))
Else
GetFilePath = ""
End If
End function
Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "")+1)
Else
GetFileName = ""
End If
End function
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileType,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
FileType = ""
End Sub
Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=true
if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
Data_5xsoft.position=FileStart
Data_5xsoft.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=false
end function
End Class
</SCRIPT>
删除文件和记录
<%
if request("action")="manage" then
call manage()
end if
if request("action")="edit" then
id=request("id")
set rs=server.createobject("adodb.recordset")
sql="select * from biao where id="&id&""
rs.open sql,conn,1,1
call edit()
end if
if request("action")="del" then
set rs=server.createobject("adodb.recordset")
sql="select * from biao where id="&request("id")&""
rs.open sql,conn,3,2
set fileobj=server.createobject("scripting.filesystemobject")
if fileobj.FileExists(server.mappath(""&rs("picurl"))) then
fileobj.DeleteFile server.mappath(""&rs("picurl"))
end if
rs.delete
conn.close
response.write"<script language='javascript'>alert('删除成功!');location.href('?action=manage');</script>"
end if
if request("action")="delall" then
set rs=server.createobject("adodb.recordset")
sql="select * from biao"
rs.open sql,conn,3,2
set fileobj=server.createobject("scripting.filesystemobject")
i=0
do while not(rs.bof or rs.eof) and i<rs.recordcount
if fileobj.FileExists(server.mappath(""&rs("picurl"))) then'-----------("../" &rs("picurl"))) then
fileobj.DeleteFile server.mappath(""&rs("picurl"))
end if
rs.movenext
i=i+1
loop
conn.execute("delete * from biao")
conn.close
response.write"<script language='javascript'>alert('所有已成功删除!');location.href('?action=manage');</script>"
end if
if request("action")="saveedit" then
name=request.form("name")
picurl=request.form("picurl")
hits=request.form("hits")
content=request.form("content")
set rs=server.createobject("adodb.recordset")
sql="select * from biao where id="&request("id")&""
rs.open sql,conn,3,2
rs("name")=name
rs("content")=content
rs("picurl")=picurl
rs("hits")=hits
rs.update
conn.close
set rs=nothing
response.write "<script language=javascript>alert('编辑成功!');location.href('?id="&request("id")&"&action=edit');</script>"
end if
%>
删除文件
<a title="删除这个?" href="delfile.asp?id=<%=rs("id")%>&struploadfiles=<%=rs("picurl")%>&action=delsoftpic" onClick="{if (confirm('您确定要删除这个吗?')){return true;}return false;}"><font color="#FF0000">删除</font></a>
--------------------------------
--*delfile.asp内容*---
<%if request("action")="delsoftpic" then
picurl=request.form("picurl")
set rs=server.createobject("adodb.recordset")
sql="select * from biao where id="&request("id")&""
rs.open sql,conn,3,2
rs("picurl")=null
struploadfiles=trim(request.querystring("struploadfiles"))
action=trim(request.querystring("action"))
dim fso,arruploadfiles,i
set fso = createobject("scripting.filesystemobject")
fso.deletefile(server.mappath("" & struploadfiles))
set fso = nothing
rs.update
conn.close
set rs=nothing
response.write"<script language='javascript'>alert('删除成功!');location.href('edit.asp?id="&request("id")&"&action=edit');</script>"
end if
%> <a href="javascript:history.back();">[返回] </a>
8。有关ubb
----------ubbcode.asp--------------
<%
const ImagePath="images/emot/"
function UBBCode(strContent)
strContent= FilterJS(strContent)
dim re
dim po,ii
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
po=0
ii=0
re.Pattern="[UPLOAD=(gif|jpg|jpeg|bmp|png)](.[^[]*)(gif|jpg|jpeg|bmp)[/UPLOAD]"
strContent=re.replace(strContent,"<br><IMG SRC=""pic/$1.gif"" border=0> 此主题相关图片如下:<br><SPAN style='CURSOR: hand'><IMG SRC=""upload/$2$1"" border=0 alt=转动滚轮可缩放图片 按此在新窗口浏览图片 onload=""imgload(this)"" onclick=""window.open(this.src,null,'')"" onmousewheel=""return bbimg(this)""></span>")
re.Pattern="[IMG](http|https|ftp)://(.[^[]*)[/IMG]"
strContent=re.replace(strContent,"<img src=$1://$2 border=0 style='cursor:hand' alt=转动滚轮可缩放图片;按此在新窗口浏览图片 onload=""imgload(this)"" onclick=""window.open(this.src,null,'')"" onmousewheel=""return bbimg(this)"">")
re.Pattern="[DIR=*([0-9]*),*([0-9]*)](.[^[]*)[/DIR]"
strContent=re.Replace(strContent,"<object classid=clsid:166B1BCA-3F9C-11CF-8075-444553540000 codebase=http://download.macromedia.com/pub/shockwave/cabs/director/sw.cab#version=7,0,2,0 width=$1 height=$2><param name=src value=$3><embed src=$3 pluginspage=http://www.macromedia.com/shockwave/download/ width=$1 height=$2></embed></object>")
re.Pattern="[QT=*([0-9]*),*([0-9]*)](.[^[]*)[/QT]"
strContent=re.Replace(strContent,"<embed src=$3 width=$1 height=$2 autoplay=true loop=false controller=true playeveryframe=false cache=false scale=TOFIT bgcolor=#000000 kioskmode=false targetcache=false pluginspage=http://www.apple.com/quicktime/>")
re.Pattern="[MP=*([0-9]*),*([0-9]*)](.[^[]*)[/MP]"
strContent=re.Replace(strContent,"<object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=$1 height=$2 ><param name=ShowStatusBar value=-1><param name=Filename value=$3><embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=$3 width=$1 height=$2></embed></object>")
re.Pattern="[RM=*([0-9]*),*([0-9]*)](.[^[]*)[/RM]"
strContent=re.Replace(strContent,"<OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2><PARAM NAME=SRC VALUE=$3><PARAM NAME=CONSOLE VALUE=Clip1><PARAM NAME=CONTROLS VALUE=imagewindow><PARAM NAME=AUTOSTART VALUE=true></OBJECT><br><OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=$1><PARAM NAME=SRC VALUE=$3><PARAM NAME=AUTOSTART VALUE=-1><PARAM NAME=CONTROLS VALUE=controlpanel><PARAM NAME=CONSOLE VALUE=Clip1></OBJECT>")
re.Pattern="([FLASH])(.[^[]*)([/FLASH])"
strContent= re.Replace(strContent,"<a href=""$2"" TARGET=_blank><IMG SRC=" & ImagePath & "swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><PARAM NAME=movie VALUE=""$2""><PARAM NAME=quality VALUE=high><embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed></OBJECT>")
re.Pattern="([FLASH=*([0-9]*),*([0-9]*)])(.[^[]*)([/FLASH])"
strContent= re.Replace(strContent,"<a href=""$4"" TARGET=_blank><IMG SRC=" & ImagePath & "swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=$2 height=$3><PARAM NAME=movie VALUE=""$4""><PARAM NAME=quality VALUE=high><embed src=""$4"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=$2 height=$3>$4</embed></OBJECT>")
re.Pattern="([URL])(.[^[]*)([/URL])"
strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$2</A>")
re.Pattern="([URL=(.[^[]*)])(.[^[]*)([/URL])"
strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$3</A>")
re.Pattern="([EMAIL])(S+@.[^[]*)([/EMAIL])"
strContent= re.Replace(strContent,"<img align=absmiddle src=" & ImagePath & "email1.gif><A HREF=""mailto:$2"">$2</A>")
re.Pattern="([EMAIL=(S+@.[^[]*)])(.[^[]*)([/EMAIL])"
strContent= re.Replace(strContent,"<img align=absmiddle src=" & ImagePath & "email1.gif><A HREF=""mailto:$2"" TARGET=_blank>$3</A>")
'自动识别网址
're.Pattern = "^((http|https|ftp|rtsp|mms):(//|\\)[A-Za-z0-9./=?%-&_~`@':+!]+)"
'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=$1>$1</a>")
're.Pattern = "((http|https|ftp|rtsp|mms):(//|\\)[A-Za-z0-9./=?%-&_~`@':+!]+)$"
'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=$1>$1</a>")
're.Pattern = "([^>=""])((http|https|ftp|rtsp|mms):(//|\\)[A-Za-z0-9./=?%-&_~`@':+!]+)"
'strContent = re.Replace(strContent,"$1<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=$2>$2</a>")
'自动识别www等开头的网址
're.Pattern = "([^(http://|http:\)])((www|cn)[.](w)+[.]{1,}(net|com|cn|org|cc)(((/[~]*|\[~]*)(w)+)|[.](w)+)*(((([?](w)+){1}[=]*))*((w)+){1}([&](w)+[=](w)+)*)*)"
'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=http://$2>$2</a>")
'自动识别Email地址,如打开本功能在浏览内容很多的帖子会引起服务器停顿
're.Pattern = "([^(=)])((w)+[@]{1}((w)+[.]){1,3}(w)+)"
'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=""mailto:$2"">$2</a>")
re.Pattern="[em(.[^[]*)]"
strContent=re.Replace(strContent,"<img src="&ImagePath&"em$1.gif border=0 align=middle>")
re.Pattern="[HTML](.[^[]*)[/HTML]"
strContent=re.Replace(strContent,"<table width='100%' border='0' cellspacing='0' cellpadding='6' class=tableborder1><td><b>以下内容为程序代码:</b><br>$1</td></table>")
re.Pattern="[code](.[^[]*)[/code]"
strContent=re.Replace(strContent,"<table width='100%' border='0' cellspacing='0' cellpadding='6' class=tableborder1><td><b>以下内容为程序代码:</b><br>$1</td></table>")
re.Pattern="[color=(.[^[]*)](.[^[]*)[/color]"
strContent=re.Replace(strContent,"<font color=$1>$2</font>")
re.Pattern="[face=(.[^[]*)](.[^[]*)[/face]"
strContent=re.Replace(strContent,"<font face=$1>$2</font>")
re.Pattern="[align=(center|left|right)](.*)[/align]"
strContent=re.Replace(strContent,"<div align=$1>$2</div>")
re.Pattern="[QUOTE](.*)[/QUOTE]"
strContent=re.Replace(strContent,"<table style=""width:80%"" cellpadding=5 cellspacing=1 class=tableborder1><TR><TD class=tableborder1>$1</td></tr></table><br>")
re.Pattern="[fly](.*)[/fly]"
strContent=re.Replace(strContent,"<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
re.Pattern="[move](.*)[/move]"
strContent=re.Replace(strContent,"<MARQUEE scrollamount=3>$1</marquee>")
re.Pattern="[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)](.[^[]*)[/GLOW]"
strContent=re.Replace(strContent,"<table width=$1 style=""filter:glow(color=$2, strength=$3)"">$4</table>")
re.Pattern="[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)](.[^[]*)[/SHADOW]"
strContent=re.Replace(strContent,"<table width=$1 style=""filter:shadow(color=$2, strength=$3)"">$4</table>")
re.Pattern="[i](.[^[]*)[/i]"
strContent=re.Replace(strContent,"<i>$1</i>")
re.Pattern="[u](.[^[]*)([/u])"
strContent=re.Replace(strContent,"<u>$1</u>")
re.Pattern="[b](.[^[]*)([/b])"
strContent=re.Replace(strContent,"<b>$1</b>")
re.Pattern="[size=([1-4])](.[^[]*)[/size]"
strContent=re.Replace(strContent,"<font size=$1>$2</font>")
strContent=replace(strContent,"<I></I>","")
set re=Nothing
UBBCode=strContent
end function
Function FilterJS(v)
if not isnull(v) then
dim t
dim re
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(javascript)"
t=re.Replace(v,"javascript")
re.Pattern="(jscript:)"
t=re.Replace(t,"jscript:")
re.Pattern="(js:)"
t=re.Replace(t,"js:")
're.Pattern="(value)"
't=re.Replace(t,"value")
re.Pattern="(about:)"
t=re.Replace(t,"about:")
re.Pattern="(file:)"
t=re.Replace(t,"file:")
re.Pattern="(document.cookie)"
t=re.Replace(t,"documents.cookie")
re.Pattern="(vbscript:)"
t=re.Replace(t,"vbscript:")
re.Pattern="(vbs:)"
t=re.Replace(t,"vbs:")
re.Pattern="(on(mouse|exit|error|click|key))"
t=re.Replace(t,"on$2")
're.Pattern="(&#)"
't=re.Replace(t,"&#")
FilterJS=t
set re=nothing
end if
End Function
function HTMLEncode(fString)
if not isnull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
HTMLEncode = fString
end if
end function
function nohtml(str)
dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(<.[^<]*>)"
str=re.replace(str," ")
re.Pattern="(</[^<]*>)"
str=re.replace(str," ")
nohtml=str
set re=nothing
end function
function cutStr(str,strlen)
dim l,t,c
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strlen then
cutStr=left(str,i)&".."
exit for
else
cutStr=str
end if
next
cutStr=replace(cutStr,chr(10),"")
end function
%>
'----------ubbcode.asp结束-----------------------------
<%=left(rs("name"),6)%>
<%=ubbcode(rs("content"))%>
<%=Server.HTMLEncode(rs("content"))%>
----------------------字符截取开始-------------------------------
<% if len(rs("name"))>10 then
response.write "<a href=view.asp?id="&rs("id")&" title='文章标题:"&rs("name")&_
vbcrlf&"阅读次数:"&rs("hits")&vbcrlf&"发表时间:"&rs("date")&"'>"&left(rs("name"),10)&"..</a>"
else
response.write "<a href=view.asp?id="&rs("id")&" title='文章标题:"&rs("name")&_
vbcrlf&"阅读次数:"&rs("hits")&vbcrlf&"发表时间:"&rs("date")&"'>"&rs("name")&"</a>"
end if %>
----------------------字符截取结束---------------------------------
9。有关后台登陆
chk.asp
<%
if session("admin")="" then
response.redirect"index.asp"
end if
%>
md5.asp
<%
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Private m_lOnBits(30)
Private m_l2Power(30)
Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function
Private Function RShift(lValue, iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
RShift = (lValue And &H7FFFFFFE) m_l2Power(iShiftBits)
If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function RotateLeft(lValue, iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Private Function AddUnsigned(lX, lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
Private Function md5_F(x, y, z)
md5_F = (x And y) Or ((Not x) And z)
End Function
Private Function md5_G(x, y, z)
md5_G = (x And z) Or (y And (Not z))
End Function
Private Function md5_H(x, y, z)
md5_H = (x Xor y Xor z)
End Function
Private Function md5_I(x, y, z)
md5_I = (y Xor (x Or (Not z)))
End Function
Private Sub md5_FF(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_GG(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_HH(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_II(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Function ConvertToWordArray(sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448
lMessageLength = Len(sMessage)
lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) BITS_TO_A_BYTE)) (MODULUS_BITS BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
Private Function WordToHex(lValue)
Dim lByte
Dim lCount
For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function
Public Function MD5(sMessage)
m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)
m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)
Dim x
Dim k
Dim AA
Dim BB
Dim CC
Dim DD
Dim a
Dim b
Dim c
Dim d
Const S11 = 7
Const S12 = 12
Const S13 = 17
Const S14 = 22
Const S21 = 5
Const S22 = 9
Const S23 = 14
Const S24 = 20
Const S31 = 4
Const S32 = 11
Const S33 = 16
Const S34 = 23
Const S41 = 6
Const S42 = 10
Const S43 = 15
Const S44 = 21
x = ConvertToWordArray(sMessage)
a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476
For k = 0 To UBound(x) Step 16
AA = a
BB = b
CC = c
DD = d
md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478
md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756
md5_FF c, d, a, b, x(k + 2), S13, &H242070DB
md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A
md5_FF c, d, a, b, x(k + 6), S13, &HA8304613
md5_FF b, c, d, a, x(k + 7), S14, &HFD469501
md5_FF a, b, c, d, x(k + 8), S11, &H698098D8
md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE
md5_FF a, b, c, d, x(k + 12), S11, &H6B901122
md5_FF d, a, b, c, x(k + 13), S12, &HFD987193
md5_FF c, d, a, b, x(k + 14), S13, &HA679438E
md5_FF b, c, d, a, x(k + 15), S14, &H49B40821
md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562
md5_GG d, a, b, c, x(k + 6), S22, &HC040B340
md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51
md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D
md5_GG d, a, b, c, x(k + 10), S22, &H2441453
md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681
md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6
md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87
md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED
md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905
md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9
md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942
md5_HH d, a, b, c, x(k + 8), S32, &H8771F681
md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122
md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C
md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6
md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA
md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085
md5_HH b, c, d, a, x(k + 6), S34, &H4881D05
md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039
md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665
md5_II a, b, c, d, x(k + 0), S41, &HF4292244
md5_II d, a, b, c, x(k + 7), S42, &H432AFF97
md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7
md5_II b, c, d, a, x(k + 5), S44, &HFC93A039
md5_II a, b, c, d, x(k + 12), S41, &H655B59C3
md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92
md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D
md5_II b, c, d, a, x(k + 1), S44, &H85845DD1
md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F
md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
md5_II c, d, a, b, x(k + 6), S43, &HA3014314
md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1
md5_II a, b, c, d, x(k + 4), S41, &HF7537E82
md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235
md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
md5_II b, c, d, a, x(k + 9), S44, &HEB86D391
a = AddUnsigned(a, AA)
b = AddUnsigned(b, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next
'MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
MD5=LCase(WordToHex(b) & WordToHex(c)) 'I crop this to fit 16byte database password :D
End Function
%>
index.asp(登陆页面)
<form method="post" action="Log.asp?action=login" onsubmit="return chklogin(this)">
<input name="admin" type="text" id="admin">
<input name="pwd" type="text" id="pwd">
<input type="submit" name="Submit" value="登陆">
</form>
log.asp
<!--#include file="conn.asp"-->
<!--#include file="Md5.asp"-->
<%
Session.TimeOut=30
if request("action")="login" then
admin=trim(request.form("admin"))
for i=1 to len(admin) '用MID函数读出变量admin中i 位置的一个字符
manage=mid(admin,i,1)
if manage="'" or manage="%" or manage="<" or manage=">" or manage="&" then '如果admin中含有' % < > &字符就转到出错页面
response.redirect "Error.asp"
response.end
end if
next
pwd=trim(request.form("pwd"))
for i=1 to len(pwd) '用MID函数读出变量pwd中i 位置的一个字符
pass=mid(pwd,i,1)
if pass="'" or pass="%" or pass="<" or pass=">" or pass="&" then '如果pass中含有' % < > &字符就转到出错页面
response.redirect "Error.asp"
response.end
end if
next
pwd=md5(pwd)
if admin="" or pwd="" then
Response.Redirect ("Index.asp")
end if
set rs=server.createobject("adodb.recordset")
sql="select * from admin where admin='"&admin&"'and pwd='"&pwd&"'"
rs.open sql,conn,1,1
if not rs.eof then
session("admin")=admin
response.redirect"main.asp"
else
response.redirect"Error.asp"
response.end
end if
end if
if request("action")="logout" then
session("admin")=""
response.redirect"../index.asp"
end if
%>
error.asp
<meta http-equiv="refresh" content="3;URL=index.asp">
登陆出错,三秒钟自动返回
其它想加密的页面调用chk.asp
<!--#include file="chk.asp"-->
pwd.asp修改密码
<% if request("action")="edit" then
admin=trim(request.form("admin"))
pwd=md5(trim(request.form("pwd")))
set rs=server.createobject("adodb.recordset")
sql="select * from admin"
rs.open sql,conn,3,2
rs("admin")=admin
rs("pwd")=pwd
rs.update
set rs=nothing
set conn=nothing
response.write"<script language='javascript'>alert('修改成功!');location.href('Admin_Admin.asp');</script>"
end if
set rs=server.createobject("adodb.recordset")
sql="select * from admin"
rs.open sql,conn,1,1
%>
------------------------
<form method="POST" action="?action=edit">
<input name="admin" type="text" class="fontmenu2" value="<%=rs("admin")%>" size="20">
<input name="pwd" type="password" class="fontmenu2" value="<%=rs("pwd")%>" size="20">
</form>
info.asp(读取服务器基本参数)
<!--#include file="chk.asp"-->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>无标题文档</title>
</head>
<body><table width="100%" border="0" cellpadding=0 cellspacing=1 class="k1" style="border-collapse: collapse">
<tr align="center" bgcolor="#eeeeee" class="fontmenu2">
<td height=25 colspan="2"><font color="#FF0000">恭喜:你已成功登陆后台管理!</font></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td width="24%" height=25> 服务器名:</td>
<td width='76%'> <%=Request.ServerVariables("SERVER_NAME")%></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 服务器IP:</td>
<td> <%=Request.ServerVariables("LOCAL_ADDR")%></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 服务器端口:</td>
<td> <%=Request.ServerVariables("SERVER_PORT")%></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 服务器时间:</td>
<td> <%=now%></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> IIS版本:</td>
<td> <%=Request.ServerVariables("SERVER_SOFTWARE")%></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 服务器操作系统:</td>
<td> <%=Request.ServerVariables("OS")%></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 脚本超时时间:</td>
<td> <%=Server.ScriptTimeout%> 秒</td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 站点物理路径:</td>
<td> <%=request.ServerVariables("APPL_PHYSICAL_PATH")%></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 服务器CPU数量:</td>
<td> <%=Request.ServerVariables("NUMBER_OF_PROCESSORS")%> 个</td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 服务器解译引擎:</td>
<td> <%=ScriptEngine & "/"& ScriptEngineMajorVersion &"."&ScriptEngineMinorVersion&"."& ScriptEngineBuildVersion %></td>
</tr>
<tr bgcolor="#eeeeee" class="fontmenu2">
<td height=25> 本文件路径:</td>
<td> <%=Request.ServerVariables("PATH_TRANSLATED")%></td>
</tr>
</table>
<!--#include file="food.asp"-->
</body>
</html>
2009-05-09
AspJpeg动态服务器组件v2·0注册版
AspJpeg 1、AspJpeg是一款功能强大的基于Microsoft IIS环境的图片处理组件,网络上对其进行详细和深入介绍的中文文章并不多,即使有一般也只是牵涉到图片缩略图和图片水印,这与其为英文版本有着密切的关系。
AspJpeg可以使用很少的代码在您的ASP/ASP.Net应用程序上动态的创建高质量的缩略图象,支持的图象格式有:JPEG, GIF, BMP, TIFF, PNG。
AspJpeg主要可以做到:生成缩略图片、生成水印图片、图片合并、图片切割、数据库支持、安全码技术
ASPJPEG是一款功能相当强大的图象处理组件,用它可以轻松地做出图片的缩略图和为图片加上水印功能。
安装SN:09268-26217-40710
2、AspJpeg功能摘要
支持JPEG, GIF, BMP, TIFF 和 PNG 格式图片. 输出格式始终为 JPEG
源图片可以来源于磁盘、内存、或者记录集(数据库)
缩略图片可以保存到磁盘、内存、或者HTTP流
支持三种更改大小方式: nearest-neighbor, bilinear, and bicubic.
可以在图片之上添加图片或者文字.
支持画中画
支持复制,反转,旋转,锐化,灰度调节.
可以调节压缩比率,以得到最佳输出效果和大小.
从Jpeg图片中抽取EXIF 和 IPTC数据.
CMYK-RGB转换
Read/write access to individual pixels of an image. (从图象中对任意象素进行读/写存取。)
3、AspJpeg系统需求
Windows 95/98/NT/2000/XP/2003, and
IIS 4.0+ and ASP/ASP.NET, or
Visual Basic 5.0+, or
Visual C++ 5.0+, or
any development environment supporting COM.
4、AspJpeg安装
全新安装:
在AspJpeg安装过程中输入序列号即可,如果安装位置磁盘格式为NTFS,则可能出现访问权限问题,需手工设置安装目录对Everyone有访问权限。
更新安装:
如果之前有装过其它版本的AspJpeg组件,则需要先卸载原来的组件,再进行新版本的安装。
先停止IIS
Net Stop iisadmin /y
卸载旧版组件
regsvr32 /u Path/aspjpeg.dl(Path为安装路径)
重启IIS
Net Start w3svc
然后再进行全新安装或复制AspJpeg.dll文件到安装目录进行手工安装:
regsvr32 Path/aspjpeg.dll(Path为安装路径)
如果在正常安装过程中没有输入序列号或手工安装则必须在注册表中加入以下项,为方便起见您可以直接将以下代码保存为.reg文档并导入注册表:
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SOFTWARE\Persits Software\AspUpload3\RegKey]
@="21764-40765-60456"
5、如何创建一个AspJpeg实例?
Set Jpeg = Server.CreateObject("Persits.Jpeg")
6、如何查看到期时间(是否注册成功)?
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Response.Write Jpeg.Expires
注册成功则到期时间为:9999-9-9
否则为:安装日期加1个月期限
7、如何用AspJpeg组件生成图片缩略图?
<%
Set Jpeg = Server.CreateObject("Persits.Jpeg") '创建实例
Path = Server.MapPath("../images/apple.jpg") '处理图片路径
Jpeg.Open Path '打开图片
'调整宽度和高度为原来的50%
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
Jpeg.Save Server.MapPath("apple_small.jpg") '保存图片到磁盘
Jpeg.Close:Set Jpeg = Nothing
%>
8、如何用AspJpeg组件生成图片水印?
<%
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath("images/dodge_viper.jpg")
开始写文字
Jpeg.Canvas.Font.Color = &000000'' red 颜色
Jpeg.Canvas.Font.Family = "Courier New" 字体
Jpeg.Canvas.Font.Bold = True 是否加粗
Jpeg.Canvas.Print 10, 10, "Copyright (c) XYZ, Inc."
打印坐标x 打印坐标y 需要打印的字符
以下是对图片进行边框处理
Jpeg.Canvas.Pen.Color = &H000000'' black 颜色
Jpeg.Canvas.Pen.Width = 2 画笔宽度
Jpeg.Canvas.Brush.Solid = False 是否加粗处理
Jpeg.Canvas.Bar left, top, right, bottom ' 左,上,右,下
Jpeg.Save Server.MapPath("images/dodge_viper_framed.jpg") 保存
%>
9、如何用AspJpeg组件进行图片合并?
AspJpeg 1.3+ enables you to place images on top of each other via the method DrawImage. To use this method, you must create two instances of the AspJpeg objects and populate both of them with images via calls to Open (or OpenBinary). When calling Canvas.DrawImage, the 2nd instance of AspJpeg is passed as an argument to this method, along with the X and Y offsets (in pixels):
使用该方法,您必需创建两个AspJpeg实例对象
<%
Set Jpeg1 = Server.CreateObject("Persits.Jpeg")
Set Jpeg2 = Server.CreateObject("Persits.Jpeg")
Jpeg1.Open Server.MapPath("t.jpg")
Jpeg2.Open Server.MapPath("t1.jpg")
Jpeg1.Canvas.DrawImage 10, 10, Jpeg2 ' optional arguments omitted
jpeg1.save Server.mappath("tt.jpg")
%>
10、如何用AspJpeg组件进行图片切割?
AspJpeg 1.1+ is also capable of cutting off edges from, or cropping, the resultant thumbnails via the method Crop(x0, y0, x1, y1). The size of the cropped image is specified by the coordinates of the upper-left and lower-right corners within the resultant thumbnail, not the original large image.
<%
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath("t.jpg")
jpeg.Crop 20, 30, jpeg.Width - 20, jpeg.Height - 10
jpeg.save Server.mappath("tt.jpg")
Response.write("<img src=tt.jpg>")
%>
11、如何用AspJpeg组件创建安全码?
创建安全码原理上和创建水印差不多。
<%
function make_randomize(max_len,w_n) 'max_len 生成长度,w_n:0 可能包含字母,1:只为数字
randomize
for intcounter=1 to max_len
whatnext=int((1-0+1)*rnd+w_n)
if whatnext=0 then
upper=122
lower=97
else
upper=57
lower=48
end if
strnewpass=strnewpass & chr(int((upper-lower+1)*rnd)+lower)
next
make_randomize=strnewpass
end function
'生成安全码的图片。
random_num=make_randomize(4,1) ''生成4位数字的安全码
session("random_num")=random_num '为么调用session,没有session的安全码是完全没有意义的。呵呵 .
Set Jpeg = Server.CreateObject("Persits.Jpeg") '调用组件
Jpeg.Open Server.MapPath("t.jpg") '打开准备的图片
Jpeg.Canvas.Font.Color = &HFFFFFF
Jpeg.Canvas.Font.Family = "Arial Black"
Jpeg.Canvas.Font.Bold = false
Jpeg.Canvas.PrintText 0, -2, random_num
jpeg.save Server.MapPath("tt.jpg") '保存
%>
<img src="tt.jpg" border="0" align="absmiddle">
12、如何让AspJpeg组件支援数据库?
图片存进数据库只能以二进制数据保存,这里即利用AspJpeg的Binary方法,下面以两个AspJpeg用户手册上的代码为例,具体请参考AspJpeg用户手册:
Opening Images from Memory
<% ' Using ADO, open database with an image blob
strConnect = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath("../db/aspjpeg.mdb")
Set rs = Server.CreateObject("adodb.recordset")
SQL = "select image_blob from images2 where id = " & Request("id")
rs.Open SQL, strConnect, 1, 3
Set Jpeg = Server.CreateObject("Persits.Jpeg")
' Open image directly from recordset
Jpeg.OpenBinary rs("image_blob").Value
' Resize
jpeg.Width = Request("Width")
' Set new height, preserve original aspect ratio
jpeg.Height = jpeg.OriginalHeight * jpeg.Width / jpeg.OriginalWidth
Jpeg.SendBinary
rs.Close
%>
Output to Memory
<%
...
Set rs = Server.CreateObject("adodb.recordset")
rs.Open "images", strConnect, 1, 3
rs.AddNew
rs("image_blob").Value = Jpeg.Binary
rs.Update
...
%>
更多方法介绍:
Canvas.Line(Left, Top, Right, Bottom)
画一条直线
Canvas.Ellipse(Left, Top, Right, Bottom)
画出一个椭圆
Canvas.Circle(X, Y, Radius)
画出一个圆
Canvas.Bar(Left, Top, Right, Bottom)
画出一个长方形,上面有代码介绍了
Canvas.Font.ShadowColor
文字阴影颜色
Canvas.Font.ShadowXOffset As Long
阴影X坐标设定
Canvas.Font.ShadowYOffset As Long
Y坐标设定
Canvas.Font.BkMode As String
文字背景
2009-03-13
空空如也
TA创建的收藏夹 TA关注的收藏夹
TA关注的人