📄 accessfunctions.asp
字号:
response.write "页面执行时间：0"&FormatNumber((time-startime) *1000,3) &" 毫秒"
end if
end sub
'函数说明:输出一个页面的执行时间单位为毫秒
'函数引用:call RunTime(startime)
sub listpages(strSQL,FileName,num,page,FileASP)
dim i '计数器
dim nc '库中总记录数
dim np '总页数
dim dqpage '当前页号
dim str1 '最后页代码
dim str2 '链接代码
dim str3 '当前页代码
i=0
set pagesRS=SQLRecordset(strSQL,FileName)
pagesRS.pagesize=num '设置每页的记录数
if pagesRS.recordcount<>0 then
np=pagesRS.pagecount '保存总页数
nc=pagesRS.recordcount '保存总记录数
if page>np then '设置当前页码
dqpage=np
else
dqpage=page
end if
call close(pagesRS,objconn) '关闭数据库
for i=1 to np
if i=np then '最后页代码
str1=""
else
str1=" | "
end if
if atstr(FileASP,"?") then '链接代码
str2=FileASP & "&"
else
str2=FileASP & "?"
end if
if i=dqpage then '当前页代码
str3="<b>" & i & "</b>"
else
str3="" & i
end if
response.write "<a href='"& str2 &"nowpage="& i &"'><font size='3'>"& str3 &"</font></a>"& str1
next
else
response.Write "<font color='#FF0000'>这是一个空的数据集合,没有一条记录!</font>"
nc=0
np=0
end if
response.Write" 第<font color='#FF0000'>"& dqpage &"</font>/"& np &"页"&" 共<font color='#FF0000'>"& nc &"</font>条记录"
end sub
'函数说明:输出一个分页列表的子程序
'函数引用:call listpages(strSQL,数据库文件名,每页的记录数,要显示的当前页码(一般时候为:request("nowpage")),调用本函数的ASP文件名)
sub TextLinks(str,http,text,blank)
dim strblank
if blank then
strblank="target='_blank'"
else
strblank=""
end if
response.write "<a href="& http &" "&strblank&" title='"& text &"'>"& str &"</a>"
end sub
'函数说明:输出一个文字的链接
'函数引用:call TextLinks(文字,链接地址,鼠标移到链接上显示的文字,是否要在新窗口中打开值为true或false)
function getR(db,table,term,fieldname)
strSQL="select TOP 1 * from " & table & " where " & term
set objRSX=SQLRecordset(strSQL,db)
if objRSX.eof then
getR=false
else
getR=objRSX(fieldname)
end if
'关闭记录集对象
objrsx.Close
set objrsx=Nothing
end function
'函数说明:读取数库中符合条件的第一条记录的某字段的值
'函数引用:r=getR("数据库","表","条件","字段")
function modifR(db,table,term,fieldname,xValue)
strSQL="select TOP 1 * from " & table & " where " & term
set objRSX=SQLRecordset(strSQL,db)
if objRSX.eof then
modifR=false
else
ModifyR objRSX,fieldname,xValue
modifR=true
end if
objrsx.Close
set objrsx=Nothing
end function
'函数说明:修改数库中符合条件的第一条记录的某字段的值
'函数引用:Rs=modifR("数据库","表","条件","字段","值")
sub goURL(url)
response.redirect url
end sub
'函数说明:将浏览器端导向至url所指定的网页,注意，网页文件必须是本网站内的！
'函数引用:call goURL("soft.asp")
sub DelRS(db,table,term,num)
strSQL="select * from " & table & " where " & term
set objRS=SQLRecordset(strSQL,db)
i=0
n=0
if num<>0 then
for i=1 to objRS.recordcount
DelR(objRS)
n=n+1
if n=num then
exit for
end if
objRS.movenext
next
end if
objrs.Close
set objrs=Nothing
end sub
'函数说明:删除前n条满足条件的记录
'函数引用:call DelRS("数据库","表","条件",前n条记录)
function countRS(db,table,term)
if trim(term)<>"" then
strSQL="select * from " & table & " where " & term
else
strSQL="select * from " & table
end if
set objRS=SQLRecordset(strSQL,db)
countRS=objRS.recordcount
objrs.Close
set objrs=Nothing
end function
'函数说明:返回数据库中满足条件的记录的总数量
'函数引用:n=countRS("数据库","表","条件",前n条记录)%>
<%sub box(ms) %>
<script language="JavaScript">
alert("<%=ms%>")
</script>
<%end sub
'函数说明:在浏览器中弹出一个信息窗口
'函数引用:call box("字符信息")
sub BoxGoUrl(ms,url)%>
<script language="JavaScript">
alert("<%=ms%>")
</script>
<html>
<head>
<title>转向...</title>
<meta http-equiv=refresh content='0; url=<%=url%>'>
</head>
<body>
</body>
</html>
<%end sub
'函数说明:在浏览器中弹出一个信息窗口,并转向其它网址
'函数引用:call BoxGoUrl("字符信息","转向的网址")
sub CloseRS(objRS)
objrs.Close
set objrs=Nothing
end sub
'函数说明：关闭数据库,objrs为记录集
'函数引用：call CloseRS(记录集对象)
sub linkcss(cssfile)
response.write "<link href='"&cssfile&"' rel='stylesheet' type='text/css'>"
end sub
'函数说明：链入CSS样式表文件
'函数引用：call linkcss(css文件名)
sub runSQL(conn,strSQL)
conn.Execute sql
end sub
'函数说明：执行SQL语句
'函数引用：call runSQL(conn数据库链接,SQL语句字符串)
function textTOhtml(text)
if text<>"" then
text=charSWAPstr(text,chr(13),"<BR>")
text=charSWAPstr(text," "," ")
text=charSWAPstr(text,"&","&")
text=charSWAPstr(text,"<","<")
text=charSWAPstr(text,">",">")
text=charSWAPstr(text,chr(34),""")
end if
textTOhtml=text
end function
'函数说明:将文本字符串转为网页Html代码
'函数引用:X = textTOhtml(文本字符串)
function htmlTOtext(html)
ln=len(html)
if ln>=1 then
for i=1 to ln
if mid(html,i,len("<BR>"))="<BR>" then html = strSWAPstr(html,i,i+len("<BR>")-1,chr(13))
if mid(html,i,len("<BR>"))=" " then html = strSWAPstr(html,i,i+len(" ")-1," ")
next
end if
end function
'函数说明：将html语句转换成文本
'函数引用：x = htmlTOtext(html语句)
function strSPstr(text,str1,str2)
ln=len(text)
if ln>=len(str2) then
for i=1 to ln
if mid(str1,i,len(str2))=str2 then html = strSWAPstr(html,i,i+len(str1)-1,str2)
next
end if
end function
'函数说明：将text串中的所有str1串变成str2串
'函数引用：x = strSPstr(text,str1,str2)
sub print(x)
response.write x
end sub
'函数说明：在浏览器中输出指定的内容
'函数引用：call print(x)
function UpLoadFile(FilePath)
dim upfile
set upfile=CreateObject("Adodb.Stream")
upfile.mode=3
upfile.type=1
upfile.open
upfile.write Request.BinaryRead(Request.TotalBytes)
upfile.SaveToFile Server.MapPath(FilePath),2
upfile.Close
set upfile=nothing
UpLoadFile=true
end function
'函数说明：用Adodb.Stream上传文件,上传成功则返回值为true
'函数引用：x=UpLoadFile(将文件保存为的文件路径)
Function GetIP()
GetIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetIP = "" Then GetIP = Request.ServerVariables("REMOTE_ADDR")
End Function
'函数说明：获取用户真实IP函数:GetIP()
Function SelfName()
SelfName = Mid(Request.ServerVariables("URL"),InstrRev(Request.ServerVariables("URL"),"/")+1)
End Function
'函数说明：获取本页文件名:SelfName()
Function GetExt(filename)
GetExt = Mid(filename,InstrRev(filename,".")+1)
End Function
'函数说明：获取文件后缀名:GetExt(filename)
Function ChkBadWords(fString)
Dim BadWords,bwords,i
BadWords = "我操|操你|操他|你妈的|他妈的|狗|杂种|屄|屌|王八|强奸|做爱|处女|泽民|***|法伦|洪志|法輪"
If Not(IsNull(BadWords) or IsNull(fString)) Then
bwords = Split(BadWords, "|")
For i = 0 to UBound(bwords)
fString = Replace(fString, bwords(i), string(Len(bwords(i)),"*"))
Next
ChkBadWords = fString
End If
End Function
'函数说明：过滤不良字符:ChkBadWords(fString)
Function HTMLEncode(fString)
If Not IsNull(fString) And fString <> "" Then
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, Chr(32), " ")
fString = Replace(fString, Chr(9), " ")
fString = Replace(fString, Chr(13), "")
fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
fString = Replace(fString, Chr(10), "<BR>")
fString = Replace(fString, Chr(255), " ")
HTMLEncode = fString
End If
End Function
'函数说明：过滤HTML字符函数:HTMLEncode(fString)
Function stripHTML(strHTML)
Dim objRegExp,strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML,"")
strOutput = Replace(strOutput, "<","<")
strOutput = Replace(strOutput, ">",">")
stripHTML = strOutput
Set objRegExp = Nothing
End Function
'函数说明：清除HTML标记:stripHTML(strHTML)
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -