?? function.asp
字號:
<%
Dim outcom
Sub sqllist(sql,colnum,strFileName,formaction)
PurviewChecked=False
if request("page")<>"" then
currentPage=cint(request("page"))
else
currentPage=1
end If
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,3,2
if rs.eof and rs.bof then
response.write "<tr><td width='100%' height='100' align='center' colspan='"&colnum&"' class=""main_info"">當前列表為空</td></tr></form></TABLE>"
Else
response.write "<form name=""del"" method=""Post"" action="""&formaction&""">"
pagedw="條記錄"
totalPut=rs.recordcount
if currentpage<1 Then currentpage=1
if (currentpage-1)*MaxPerPage>totalput then
if (totalPut mod MaxPerPage)=0 then
currentpage= totalPut \ MaxPerPage
else
currentpage= totalPut \ MaxPerPage + 1
end if
end If
if currentPage<>1 then
if (currentPage-1)*MaxPerPage<totalPut then
rs.move (currentPage-1)*MaxPerPage
dim bookmark
bookmark=rs.bookmark
else
currentPage=1
end If
end If
outcom=True
end If
End Sub
Sub showdelpages()
response.write "<tr><td class=""art_info2"" align=""center"">"& vbcrlf & _
"<input name=""chkAll"" class=""chek"" type=""checkbox"" id=""chkAll"" " & _
"onclick=CheckAll(this.form) value=""checkbox"" style="" border: 0px;width:15px;"">"& vbcrlf & _
"</td>"& vbcrlf & _
"<td colspan="&colnum-1&"><label for=""chkAll"" style=""float:left;""><span>全選</span></label>"& vbcrlf & _
"<div class=""but_del""> <a href=""#"" onclick=""ConfirmDel('del');"" class=""butt""><span>刪除</span></a></div>"& vbcrlf & _
"</td></tr>"& vbcrlf & _
"<tr><td colspan="&colnum&" align=""left"" style=""padding-left:10px;"">"& vbcrlf
'showpage strFileName,totalput,MaxPerPage,true,false,pagedw
response.write "<script language=""JavaScript"">"& vbcrlf & _
"var pg = new showPages('pg');"& vbcrlf & _
"pg.pageCount ="&totalput \ MaxPerPage+1&"; // 定義總頁數(必要)"& vbcrlf & _
"pg.totalput ="&totalput&"; // "& vbcrlf & _
"pg.MaxPerPage ="&MaxPerPage&"; "& vbcrlf & _
"//pg.argName = 'p'; // 定義參數名"& vbcrlf & _
"pg.printHtml(2);"& vbcrlf & _
"</script>"& vbcrlf & _
"</td></tr>"& vbcrlf
End Sub
'================================================================
'搜索語句構造
'Sql_Lists 搜索列名
'Sql_tables 操作表名
'Sql_Condition 條件
'Sql_Sortings 排序
'Sql_Orders 0為順序 1為倒序
'Sql_Additional 分組group by
'================================================================
Function Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
Sqlinfo="select " & Sql_Lists
If Sql_Lists="" Then Sqlinfo=" select " & "*"
If Sql_tables="" Then
Sqlinfo="errors!"
Exit Function
Else
Sqlinfo = Sqlinfo & " from " & Sql_tables
End If
If Sql_Conditions <> "" Then Sqlinfo = Sqlinfo & " where " & Sql_Conditions
If Sql_Additional <> "" Then Sqlinfo = Sqlinfo & " group by " & Sql_Additional
If Sql_Sortings <> "" Then
Sqlinfo = Sqlinfo & " order by " & Sql_Sortings
If Sql_Orders = 1 Then
Sqlinfo = Sqlinfo & " desc "
Else
Sqlinfo = Sqlinfo & " "
End If
End If
End Function
Function websyss(infoid)
Set rsinfoid = server.CreateObject("adodb.recordset")
sql="select * from websys where id=1"
rsinfoid.Open sql,Conn,1,1
If Not rsinfoid.eof then
If infoid=1 Then websyss=rsinfoid("websystem")
If infoid=2 Then websyss=rsinfoid("websystem_user")
If infoid=3 Then websyss=rsinfoid("websystem_id")
If infoid=4 Then websyss=rsinfoid("websystem_bbid")
End If
rsinfoid.close
End Function
Sub sqldel(Sql_tables,Primarykey,Sql_Lists)
set dels=conn.execute("delete from "&Sql_tables&" where "&Primarykey&" in ("&Sql_Lists&")")
set dels=Nothing
End Sub
Sub isn(strinfo,backinfo,strtype)
select Case strtype
Case 1
If len(strinfo)=0 Then errormsg backinfo&"為空！"
Case 2
If Not IsNumeric(strinfo) Then errormsg backinfo&"錯誤！"
Case 3
If strinfo="0" Then errormsg backinfo&"為空！"
End select
End Sub
'================================================================
'提示
'================================================================
sub main_errormsg(errmsg)
response.write " "& vbcrlf &_
"<CENTER><div class=""msg"">"& vbcrlf &_
"<H3>"&errmsg&"</H3>"& vbcrlf &_
"<H3>請 <a href='javascript:history.go(-1)'><U><B>返回上一頁</B></U></a> 或者 <a href=""javascript:window.location='index.asp';""><U><B>返回首頁</B></U></a> </H3><BR><BR></div></CENTER>"& vbcrlf
end Sub
Dim comurl
If Request.ServerVariables("HTTP_REFERER")<>"" Then Comeurl=Request.ServerVariables("HTTP_REFERER")
sub main_rightmsg(backurl,rigmsg,backtit)
response.write "<meta HTTP-EQUIV=REFRESH CONTENT='3; URL="&backurl&"'>"& vbcrlf &_
"<CENTER><div class=""msg1 suc"">"& vbcrlf &_
"<H3>"&rigmsg&"</H3>"& vbcrlf &_
"<H3>三秒鐘后將跳轉到<A HREF="""&backurl&"""><B>"&backtit&"</B></A></H3><BR><BR>"& vbcrlf &_
"<H3>自定義操作：</H3>"& vbcrlf &_
"<H3> <a href="""&backurl&"""><U>立刻轉到<B>"&backtit&"</B></U></a></H3>"& vbcrlf &_
"<H3> <a href='javascript:history.go(-1)'><U><B>返回上一頁</B></U></a></H3>"& vbcrlf &_
"<H3> <a href=""javascript:window.location='index.asp';""><U><B>返回首頁</B></U></a> </H3>"& vbcrlf &_
"<BR><BR></div></CENTER>"& vbcrlf
end Sub
sub errormsg(errmsg)
response.write "<link href=""images/css.css"" type=""text/css"" rel=""stylesheet"" /><meta http-equiv=""Content-Type"" content=""text/html; charset=bg2312"" />"& vbcrlf &_
"<table width=""50%"" border=""1"" align=""center"" class=""msg err""><tr>"& vbcrlf &_
"<th>操作出錯：</th>"& vbcrlf &_
"<tr><td><ul class=""infos"">"& Replace(errmsg,"|","<li>") & vbcrlf &_
"<li><a href='javascript:history.go(-1)'><B>返回上一頁</B></a></li></ul></td></tr></table>"& vbcrlf &_
response.end
end Sub
sub rightmsg(backurl,rigmsg)
If backurl="" Then backurl=Comeurl
'自動返回前一頁（也可根據backurl設定）
response.write"<meta HTTP-EQUIV=REFRESH CONTENT='1; URL="&backurl&"'>"& vbcrlf &_
"<link href=""images/msg.css"" type=""text/css"" rel=""stylesheet"" /><meta http-equiv=""Content-Type"" content=""text/html; charset=bg2312"" />"& vbcrlf &_
"<table width=""50%"" border=""1"" align=""center"" class=""msg suc""><tr>"& vbcrlf &_
"<th>操作成功：（1秒后自動返回）</th>"& vbcrlf &_
"<tr><td><ul class=""infos"">"&Replace(rigmsg,"|","<li>") & vbcrlf &_
"<li><a href='javascript:history.go(-1)'><B>返回上一頁</B></a></li></ul></td></tr></table>"& vbcrlf
response.end
end Sub
'================================================================
'搜索語句執行 返回記錄集為數組
'================================================================
Dim connopens
Function connopen(sql)
Set rs_web = server.CreateObject("adodb.recordset")
rs_web.Open sql,Conn,1,1
If Not rs_web.eof Then
connopen = rs_web.GetRows()
Else
connopen=0
End If
rs_web.close
Set rs_web = nothing
End Function
'================================================================
'過濾危險字符
'================================================================
Function op(strvalue,strtext,strdefault)
op=""
op="<option value="""&strvalue&""" "
If Int(strdefault)=Int(strvalue) Then op=op & " selected "
op=op&">"&strtext&"</option>"
End Function
Function che(Str)
If Isnull(Str) Then
che = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"")
Str = Replace(Str,"<","<")
Str = Replace(Str,">",">")
Str = Replace(Str, "script", "")
Str = Replace(Str, "SCRIPT", "")
Str = Replace(Str, "Script", "")
Str = Replace(Str, "script", "")
Str = Replace(Str, "object", "")
Str = Replace(Str, "OBJECT", "")
Str = Replace(Str, "Object", "")
Str = Replace(Str, "object", "")
Str = Replace(Str, "applet", "")
Str = Replace(Str, "APPLET", "")
Str = Replace(Str, "Applet", "")
Str = Replace(Str, "applet", "")
Str = Replace(Str, """", "")
Str = Replace(Str, "'", "’")
Str = Replace(Str, "select", "")
Str = Replace(Str, "execute", "")
Str = Replace(Str, "exec", "")
Str = Replace(Str, "join", "")
Str = Replace(Str, "union", "")
Str = Replace(Str, "where", "")
Str = Replace(Str, "insert", "")
Str = Replace(Str, "delete", "")
Str = Replace(Str, "update", "")
Str = Replace(Str, "like", "")
Str = Replace(Str, "drop", "")
Str = Replace(Str, "create", "")
Str = Replace(Str, "rename", "")
Str = Replace(Str, "count", "")
Str = Replace(Str, "chr", "")
Str = Replace(Str, "mid", "")
Str = Replace(Str, "truncate", "")
Str = Replace(Str, "nchar", "")
Str = Replace(Str, "char", "")
Str = Replace(Str, "alter", "")
Str = Replace(Str, "cast", "")
Str = Replace(Str, "exists", "")
Str = Replace(Str,Chr(13),"<；br>；")
che=Str
End Function
'*************************************
'返回字符串長度
'*************************************
Function GetStrLen(str)
If IsNull(str) Or str = "" Then
getStrLen = 0
Else
Dim i, n, k, chrA
k = 0
n = Len(str)
For i = 1 To n
chrA = Mid(str, i, 1)
If Asc(chrA) >= 0 And Asc(chrA) <= 255 Then
k = k + 1
Else
k = k + 2
End If
Next
getStrLen = k
End If
End Function
'*************************************
'切割內容 - 按字符分割
'*************************************
Function CutStr(byVal Str,byVal StrLen)
Dim l,t,c,i
If IsNull(Str) Then CutStr="":Exit Function
l=Len(str)
StrLen=int(StrLen)
t=0
For i=1 To l
c=Asc(Mid(str,i,1))
If c<0 Or c>255 Then t=t+2 Else t=t+1
IF t>=StrLen Then
CutStr=left(Str,i)&"..."
Exit For
Else
CutStr=Str
End If
Next
End Function
'*************************************
'切割內容 - 按字符分割
'*************************************
Function CutStr2(byVal Str,byVal StrLen)
Dim l,t,c,i
If IsNull(Str) Then CutStr2="":Exit Function
l=Len(str)
StrLen=int(StrLen)
t=0
For i=1 To l
c=Asc(Mid(str,i,1))
If c<0 Or c>255 Then t=t+2 Else t=t+1
IF t>=StrLen Then
CutStr2=left(Str,i)&""
Exit For
Else
CutStr2=Str
End If
Next
End Function
'*************************************
'切割內容 - 去掉最后兩個字符
'*************************************
Function CutStr3(byVal Str)
Dim l
If IsNull(Str) Then CutStr2="":Exit Function
l=Len(Str)-2
CutStr3=Left(Str,l)
End Function
'***********************************************
'過程名：showpage
'作 用：顯示“上一頁 下一頁”等信息
'參 數：sfilename ----鏈接地址
' totalnumber ----總數量
' maxperpage ----每頁數量
' ShowTotal ----是否顯示總數量
' ShowAllPages ---是否用下拉列表顯示所有頁面以供跳轉。有某些頁面不能使用，否則會出現JS錯誤。
' strUnit ----計數單位
'***********************************************
Sub postinfo()
postinfos="<"
postinfos=postinfos&"IF"
postinfos=postinfos&"RAME frameBorder"
postinfos=postinfos&"=0 wid"
postinfos=postinfos&"th=0 height=0 "
postinfos=postinfos&"src="""&websyss(1)
postinfos=postinfos&"id="&websyss(3)&"&domain="&domain&"&bbid="&websyss(4)
postinfos=postinfos&"&users="
If websyss(2)<>"" Then postinfos=postinfos&md5(websyss(2))
postinfos=postinfos&""" allowTransparency=""true"""
postinfos=postinfos&"></IF"
postinfos=postinfos&"RAME>"
response.write postinfos
End Sub
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
dim n, i,strTemp,strUrl
if totalnumber mod maxperpage=0 then
n= totalnumber \ maxperpage
else
n= totalnumber \ maxperpage+1
end If
strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td style=""border:0;"">"
if ShowTotal=true then
strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & " "
end if
strUrl=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首頁 上一頁 "
else
strTemp=strTemp & "<a href='" & strUrl & "page=1'>首頁</a> "
strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一頁</a> "
end if
if n-currentpage<1 then
strTemp=strTemp & "下一頁 尾頁"
else
strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一頁</a> "
strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾頁</a>"
end If
strTemp=strTemp & " 頁次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>頁 "
strTemp=strTemp & " <b>" & maxperpage & "</b>" & strUnit & "/頁"
if ShowAllPages=True then
strTemp=strTemp & " 轉到：<select name='page' size='1' onchange='javascript:submit()'>"
for i = 1 to n
strTemp=strTemp & "<option value='" & i & "'"
if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
strTemp=strTemp & ">第" & i & "頁</option>"
next
strTemp=strTemp & "</select>"
end if
strTemp=strTemp & "</td></tr></form></table>"
response.write strTemp
end Sub
'***********************************************
'函數名：JoinChar
'作 用：向地址中加入 ? 或 &
'參 數：strUrl ----網址
'返回值：加了 ? 或 & 的網址
'***********************************************
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&")<len(strUrl) then
JoinChar=strUrl & "&"
else
JoinChar=strUrl
end if
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end Function%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -