function.asp
上传用户:szhf331
上传日期:2022-06-22
资源大小:1032k
文件大小:15k
- <%
- 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,Sql_Conditions)
- Dim temp_Conditions
- temp_Conditions=""
- If Sql_Conditions="" Then
- temp_Conditions="id in ("&id&")"
- elseIf Sql_Conditions<>"" And Len(Replace(Sql_Conditions,"=",""))=Len(Sql_Conditions) Then
- temp_Conditions = "id in ("&Sql_Conditions&")"
- elseIf Sql_Conditions<>"" And ( Len(Replace(Sql_Conditions,"=",""))<>Len(Sql_Conditions) Or Len(Replace(Sql_Conditions,"<",""))<>Len(Sql_Conditions) Or Len(Replace(Sql_Conditions,">",""))<>Len(Sql_Conditions) Or Len(Replace(Sql_Conditions,"(",""))<>Len(Sql_Conditions) ) Then
- temp_Conditions = Sql_Conditions
- End If
- If temp_Conditions<>"" Then temp_Conditions = "where " & temp_Conditions
- set dels=conn.execute("delete from "&Sql_tables& " " & temp_Conditions )
- 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 "<this. 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 &_
- "<this. 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
- Function script(str1,str2)
- If str2<>"" Then
- str2=str2 & "/"
- Else
- str2="inc/"
- End If
- script = "<script src="""& str2 & str1 &".js"" type=""text/javascript""></script>"
- End Function
- Sub ExportToExcel(str1)
- Response.ContentType = "application/vnd.ms-excel"
- Response.AddHeader "Content-Disposition", "attachment;Filename=Results.xls"
- Response.Write "<body>"
- Response.Write "<table border=1>"
- Response.Write str1
- Response.Write "</table>"
- Response.Write "</body>"
- Response.Write "</html>"
- End Sub
- %>