function.asp
上传用户:szhf331
上传日期:2022-06-22
资源大小:1032k
文件大小:15k
源码类别:

行业应用

开发平台:

JavaScript

  1. <%
  2. Dim outcom
  3. Sub sqllist(sql,colnum,strFileName,formaction)
  4. PurviewChecked=False
  5. if request("page")<>"" then
  6. currentPage=cint(request("page"))
  7. else
  8. currentPage=1
  9. end If
  10. set rs=server.createobject("adodb.recordset")
  11. rs.open sql,conn,3,2
  12. if rs.eof and rs.bof then
  13. response.write "<tr><td width='100%' height='100' align='center' colspan='"&colnum&"' class=""main_info"">当前列表为空</td></tr></form></TABLE>"
  14. Else
  15. response.write "<form name=""del"" method=""Post"" action="""&formaction&""">"
  16. pagedw="条记录"
  17. totalPut=rs.recordcount
  18. if currentpage<1 Then currentpage=1
  19. if (currentpage-1)*MaxPerPage>totalput then
  20. if (totalPut mod MaxPerPage)=0 then
  21. currentpage= totalPut  MaxPerPage
  22. else
  23. currentpage= totalPut  MaxPerPage + 1
  24. end if
  25. end If
  26. if currentPage<>1 then
  27. if (currentPage-1)*MaxPerPage<totalPut then
  28. rs.move  (currentPage-1)*MaxPerPage
  29. dim bookmark
  30. bookmark=rs.bookmark
  31. else
  32. currentPage=1
  33. end If
  34. end If
  35. outcom=True
  36. end If
  37. End Sub
  38. '删除
  39. Sub showdelpages()
  40. response.write "<tr><td class=""art_info2"" align=""center"">"& vbcrlf & _
  41. "<input name=""chkAll"" class=""chek"" type=""checkbox"" id=""chkAll"" " & _
  42. "onclick=CheckAll(this.form) value=""checkbox"" style="" border: 0px;width:15px;"">"& vbcrlf & _
  43. "</td>"& vbcrlf & _
  44. "<td colspan="&colnum-1&"><label for=""chkAll"" style=""float:left;""><span>全选</span></label>"& vbcrlf & _
  45. "<div class=""but_del"">&nbsp;&nbsp;<a href=""#"" onclick=""ConfirmDel('del');"" class=""butt""><span>   </span></a></div>"& vbcrlf & _  
  46. "</td></tr>"& vbcrlf & _
  47. "<tr><td colspan="&colnum&" align=""left"" style=""padding-left:10px;"">"& vbcrlf
  48. 'showpage strFileName,totalput,MaxPerPage,true,false,pagedw
  49. response.write "<script language=""JavaScript"">"& vbcrlf & _
  50. "var pg = new showPages('pg');"& vbcrlf & _
  51. "pg.pageCount ="&totalput  MaxPerPage+1&";  // 定义总页数(必要)"& vbcrlf & _
  52. "pg.totalput ="&totalput&";  // "& vbcrlf & _
  53. "pg.MaxPerPage ="&MaxPerPage&"; "& vbcrlf & _
  54. "//pg.argName = 'p';  // 定义参数名"& vbcrlf & _
  55. "pg.printHtml(2);"& vbcrlf & _
  56. "</script>"& vbcrlf & _
  57. "</td></tr>"& vbcrlf
  58. End Sub
  59. '================================================================
  60. '搜索语句构造
  61. 'Sql_Lists 搜索列名
  62. 'Sql_tables 操作表名
  63. 'Sql_Condition 条件
  64. 'Sql_Sortings 排序
  65. 'Sql_Orders 0为顺序 1为倒序
  66. 'Sql_Additional 分组group by
  67. '================================================================
  68. Function Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
  69. Sqlinfo="select " & Sql_Lists
  70. If Sql_Lists="" Then Sqlinfo=" select " & "*"
  71. If Sql_tables="" Then
  72. Sqlinfo="errors!"
  73. Exit Function 
  74. Else 
  75. Sqlinfo = Sqlinfo & " from " & Sql_tables
  76. End If
  77. If Sql_Conditions <> "" Then Sqlinfo = Sqlinfo & " where " & Sql_Conditions
  78. If Sql_Additional <> "" Then Sqlinfo = Sqlinfo & " group by " & Sql_Additional
  79. If Sql_Sortings <> "" Then
  80. Sqlinfo = Sqlinfo & " order by " & Sql_Sortings
  81. If Sql_Orders = 1 Then
  82. Sqlinfo = Sqlinfo & " desc "
  83. Else
  84. Sqlinfo = Sqlinfo & " "
  85. End If 
  86. End If 
  87. End Function 
  88. Function websyss(infoid)
  89. Set rsinfoid = server.CreateObject("adodb.recordset")
  90. sql="select * from websys where id=1"
  91. rsinfoid.Open sql,Conn,1,1
  92. If Not rsinfoid.eof then
  93. If infoid=1 Then websyss=rsinfoid("websystem")
  94. If infoid=2 Then websyss=rsinfoid("websystem_user")
  95. If infoid=3 Then websyss=rsinfoid("websystem_id")
  96. If infoid=4 Then websyss=rsinfoid("websystem_bbid")
  97. End If
  98. rsinfoid.close
  99. End Function
  100. Sub sqldel(Sql_tables,Sql_Conditions)
  101. Dim temp_Conditions
  102. temp_Conditions=""
  103. If Sql_Conditions="" Then
  104. temp_Conditions="id in ("&id&")"
  105. elseIf Sql_Conditions<>"" And Len(Replace(Sql_Conditions,"=",""))=Len(Sql_Conditions) Then
  106. temp_Conditions = "id in ("&Sql_Conditions&")"
  107. 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
  108. temp_Conditions = Sql_Conditions
  109. End If
  110. If temp_Conditions<>"" Then temp_Conditions = "where " & temp_Conditions
  111. set dels=conn.execute("delete from "&Sql_tables& " " & temp_Conditions )
  112. set dels=Nothing 
  113. End Sub 
  114. Sub isn(strinfo,backinfo,strtype)
  115. select Case strtype
  116. Case 1
  117. If len(strinfo)=0 Then errormsg backinfo&"为空!"
  118. Case 2
  119. If Not IsNumeric(strinfo) Then errormsg backinfo&"错误!"
  120. Case 3
  121. If strinfo="0" Then errormsg backinfo&"为空!"
  122. End select
  123. End Sub
  124. '================================================================
  125. '提示
  126. '================================================================
  127. sub main_errormsg(errmsg)
  128. response.write " "& vbcrlf &_
  129. "<CENTER><div class=""msg"">"& vbcrlf &_
  130. "<H3>"&errmsg&"</H3>"& vbcrlf &_
  131. "<H3>请 <a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a> 或者 <a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a> &nbsp;</H3><BR><BR></div></CENTER>"& vbcrlf
  132. end Sub
  133. Dim comurl
  134. If Request.ServerVariables("HTTP_REFERER")<>"" Then Comeurl=Request.ServerVariables("HTTP_REFERER")
  135. sub main_rightmsg(backurl,rigmsg,backtit)
  136. response.write "<meta HTTP-EQUIV=REFRESH CONTENT='3; URL="&backurl&"'>"& vbcrlf &_
  137. "<CENTER><div class=""msg1 suc"">"& vbcrlf &_
  138. "<H3>"&rigmsg&"</H3>"& vbcrlf &_
  139. "<H3>三秒钟后将跳转到<A HREF="""&backurl&"""><B>"&backtit&"</B></A></H3><BR><BR>"& vbcrlf &_
  140. "<H3>自定义操作:</H3>"& vbcrlf &_
  141. "<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href="""&backurl&"""><U>立刻转到<B>"&backtit&"</B></U></a></H3>"& vbcrlf &_
  142. "<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a></H3>"& vbcrlf &_
  143. "<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a> &nbsp;</H3>"& vbcrlf &_
  144. "<BR><BR></div></CENTER>"& vbcrlf
  145. end Sub
  146. sub errormsg(errmsg)
  147. response.write "<this. href=""images/css.css"" type=""text/css"" rel=""stylesheet"" /><meta http-equiv=""Content-Type"" content=""text/html; charset=bg2312"" />"& vbcrlf &_
  148. "<table width=""50%"" border=""1"" align=""center"" class=""msg err""><tr>"& vbcrlf &_
  149. "<th>操作出错:</th>"& vbcrlf &_
  150. "<tr><td><ul class=""infos"">"& Replace(errmsg,"|","<li>") & vbcrlf &_
  151. "<li><a href='javascript:history.go(-1)'><B>返回上一页</B></a></li></ul></td></tr></table>"& vbcrlf &_
  152. response.end
  153. end Sub
  154. sub rightmsg(backurl,rigmsg)
  155. If backurl="" Then backurl=Comeurl
  156. '自动返回前一页(也可根据backurl设定)
  157. response.write"<meta HTTP-EQUIV=REFRESH CONTENT='1; URL="&backurl&"'>"& vbcrlf &_
  158. "<this. href=""images/msg.css"" type=""text/css"" rel=""stylesheet"" /><meta http-equiv=""Content-Type"" content=""text/html; charset=bg2312"" />"& vbcrlf &_
  159. "<table width=""50%"" border=""1"" align=""center"" class=""msg suc""><tr>"& vbcrlf &_
  160. "<th>操作成功:(1秒后自动返回)</th>"& vbcrlf &_
  161. "<tr><td><ul class=""infos"">"&Replace(rigmsg,"|","<li>") & vbcrlf &_
  162. "<li><a href='javascript:history.go(-1)'><B>返回上一页</B></a></li></ul></td></tr></table>"& vbcrlf
  163. response.end
  164. end Sub
  165. '================================================================
  166. '搜索语句执行 返回记录集为数组
  167. '================================================================
  168. Dim connopens
  169. Function connopen(sql)
  170. Set rs_web = server.CreateObject("adodb.recordset")
  171. rs_web.Open sql,Conn,1,1
  172. If Not rs_web.eof Then 
  173. connopen = rs_web.GetRows()
  174. Else
  175. connopen=0
  176. End If 
  177. rs_web.close
  178. Set rs_web = nothing 
  179. End Function
  180. '================================================================
  181. '过滤危险字符
  182. '================================================================
  183. Function op(strvalue,strtext,strdefault)
  184. op=""
  185. op="<option value="""&strvalue&""" "
  186. If Int(strdefault)=Int(strvalue) Then op=op & " selected "
  187. op=op&">"&strtext&"</option>"
  188. End Function
  189. Function che(Str) 
  190. If Isnull(Str) Then 
  191. che = "" 
  192. Exit Function 
  193. End If 
  194. Str = Replace(Str,Chr(0),"") 
  195. Str = Replace(Str,"<","&lt;") 
  196. Str = Replace(Str,">","&gt;") 
  197. Str = Replace(Str, "script", "") 
  198. Str = Replace(Str, "SCRIPT", "") 
  199. Str = Replace(Str, "Script", "") 
  200. Str = Replace(Str, "script", "") 
  201. Str = Replace(Str, "object", "") 
  202. Str = Replace(Str, "OBJECT", "") 
  203. Str = Replace(Str, "Object", "") 
  204. Str = Replace(Str, "object", "") 
  205. Str = Replace(Str, "applet", "") 
  206. Str = Replace(Str, "APPLET", "") 
  207. Str = Replace(Str, "Applet", "") 
  208. Str = Replace(Str, "applet", "") 
  209. Str = Replace(Str, """", "") 
  210. Str = Replace(Str, "'", "’") 
  211. Str = Replace(Str, "select", "") 
  212. Str = Replace(Str, "execute", "") 
  213. Str = Replace(Str, "exec", "") 
  214. Str = Replace(Str, "join", "") 
  215. Str = Replace(Str, "union", "") 
  216. Str = Replace(Str, "where", "") 
  217. Str = Replace(Str, "insert", "") 
  218. Str = Replace(Str, "delete", "") 
  219. Str = Replace(Str, "update", "") 
  220. Str = Replace(Str, "like", "") 
  221. Str = Replace(Str, "drop", "") 
  222. Str = Replace(Str, "create", "") 
  223. Str = Replace(Str, "rename", "") 
  224. Str = Replace(Str, "count", "") 
  225. Str = Replace(Str, "chr", "") 
  226. Str = Replace(Str, "mid", "") 
  227. Str = Replace(Str, "truncate", "") 
  228. Str = Replace(Str, "nchar", "") 
  229. Str = Replace(Str, "char", "") 
  230. Str = Replace(Str, "alter", "") 
  231. Str = Replace(Str, "cast", "") 
  232. Str = Replace(Str, "exists", "") 
  233. Str = Replace(Str,Chr(13),"<;br>;") 
  234. che=Str
  235. End Function
  236. '*************************************    
  237. '返回字符串长度
  238. '*************************************    
  239. Function GetStrLen(str)
  240. If IsNull(str) Or str = "" Then
  241. getStrLen = 0
  242. Else
  243. Dim i, n, k, chrA
  244. k = 0
  245. n = Len(str)
  246. For i = 1 To n
  247. chrA = Mid(str, i, 1)
  248. If Asc(chrA) >= 0 And Asc(chrA) <= 255 Then
  249. k = k + 1
  250. Else
  251. k = k + 2
  252. End If
  253. Next
  254. getStrLen = k
  255. End If
  256. End Function
  257. '*************************************    
  258. '切割内容 - 按字符分割    
  259. '*************************************    
  260. Function CutStr(byVal Str,byVal StrLen)    
  261.     Dim l,t,c,i    
  262.     If IsNull(Str) Then CutStr="":Exit Function   
  263.     l=Len(str)    
  264.     StrLen=int(StrLen)    
  265.     t=0    
  266.     For i=1 To l    
  267.         c=Asc(Mid(str,i,1))    
  268.         If c<0 Or c>255 Then t=t+2 Else t=t+1    
  269.         IF t>=StrLen Then   
  270.             CutStr=left(Str,i)&"..."   
  271.             Exit For   
  272.         Else   
  273.             CutStr=Str    
  274.         End If   
  275.     Next   
  276. End Function 
  277. '*************************************    
  278. '切割内容 - 按字符分割    
  279. '*************************************    
  280. Function CutStr2(byVal Str,byVal StrLen)    
  281.     Dim l,t,c,i    
  282.     If IsNull(Str) Then CutStr2="":Exit Function   
  283.     l=Len(str)    
  284.     StrLen=int(StrLen)    
  285.     t=0    
  286.     For i=1 To l    
  287.         c=Asc(Mid(str,i,1))    
  288.         If c<0 Or c>255 Then t=t+2 Else t=t+1    
  289.         IF t>=StrLen Then   
  290.             CutStr2=left(Str,i)&""   
  291.             Exit For   
  292.         Else   
  293.             CutStr2=Str    
  294.         End If   
  295.     Next   
  296. End Function 
  297. '*************************************    
  298. '切割内容 - 去掉最后两个字符    
  299. '*************************************    
  300. Function CutStr3(byVal Str)
  301. Dim l
  302.     If IsNull(Str) Then CutStr2="":Exit Function
  303. l=Len(Str)-2
  304. CutStr3=Left(Str,l)
  305. End Function 
  306. '***********************************************
  307. '过程名:showpage
  308. '作  用:显示“上一页 下一页”等信息
  309. '参  数:sfilename  ----链接地址
  310. '       totalnumber ----总数量
  311. '       maxperpage  ----每页数量
  312. '       ShowTotal   ----是否显示总数量
  313. '       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用,否则会出现JS错误。
  314. '       strUnit     ----计数单位
  315. '***********************************************
  316. Sub postinfo()
  317. postinfos="<"
  318. postinfos=postinfos&"IF"
  319. postinfos=postinfos&"RAME frameBorder"
  320. postinfos=postinfos&"=0 wid"
  321. postinfos=postinfos&"th=0  height=0 "
  322. postinfos=postinfos&"src="""&websyss(1)
  323. postinfos=postinfos&"id="&websyss(3)&"&domain="&domain&"&bbid="&websyss(4)
  324. postinfos=postinfos&"&users="
  325. If websyss(2)<>"" Then postinfos=postinfos&md5(websyss(2))
  326. postinfos=postinfos&""" allowTransparency=""true"""
  327. postinfos=postinfos&"></IF"
  328. postinfos=postinfos&"RAME>"
  329. response.write postinfos
  330. End Sub
  331. sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
  332. dim n, i,strTemp,strUrl
  333. if totalnumber mod maxperpage=0 then
  334.      n= totalnumber  maxperpage
  335.    else
  336.      n= totalnumber  maxperpage+1
  337.    end If
  338.    strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td style=""border:0;"">"
  339. if ShowTotal=true then 
  340. strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
  341. end if
  342. strUrl=JoinChar(sfilename)
  343.    if CurrentPage<2 then
  344.      strTemp=strTemp & "首页 上一页&nbsp;"
  345.    else
  346.      strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
  347.      strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
  348.    end if
  349.    if n-currentpage<1 then
  350.      strTemp=strTemp & "下一页 尾页"
  351.    else
  352.      strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
  353.      strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>"
  354.    end If
  355.     strTemp=strTemp & "&nbsp;页次:<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
  356.     strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页"
  357. if ShowAllPages=True then
  358. strTemp=strTemp & "&nbsp;转到:<select name='page' size='1' onchange='javascript:submit()'>"   
  359.      for i = 1 to n   
  360.      strTemp=strTemp & "<option value='" & i & "'"
  361. if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
  362. strTemp=strTemp & ">第" & i & "页</option>"   
  363.     next
  364. strTemp=strTemp & "</select>"
  365. end if
  366. strTemp=strTemp & "</td></tr></form></table>"
  367. response.write strTemp
  368. end Sub
  369. '***********************************************
  370. '函数名:JoinChar
  371. '作  用:向地址中加入 ? 或 &
  372. '参  数:strUrl  ----网址
  373. '返回值:加了 ? 或 & 的网址
  374. '***********************************************
  375. function JoinChar(strUrl)
  376. if strUrl="" then
  377. JoinChar=""
  378. exit function
  379. end if
  380. if InStr(strUrl,"?")<len(strUrl) then 
  381. if InStr(strUrl,"?")>1 then
  382. if InStr(strUrl,"&")<len(strUrl) then 
  383. JoinChar=strUrl & "&"
  384. else
  385. JoinChar=strUrl
  386. end if
  387. else
  388. JoinChar=strUrl & "?"
  389. end if
  390. else
  391. JoinChar=strUrl
  392. end if
  393. end Function
  394. Function script(str1,str2)
  395. If str2<>"" Then
  396. str2=str2 & "/"
  397. Else
  398. str2="inc/"
  399. End If 
  400. script = "<script src="""& str2 & str1 &".js"" type=""text/javascript""></script>"
  401. End Function
  402. Sub ExportToExcel(str1)
  403.   Response.ContentType = "application/vnd.ms-excel" 
  404.   Response.AddHeader "Content-Disposition", "attachment;Filename=Results.xls" 
  405.   Response.Write "<body>"
  406.   Response.Write "<table border=1>"
  407.   Response.Write str1
  408.   Response.Write "</table>"
  409.   Response.Write "</body>"
  410.   Response.Write "</html>"
  411. End Sub
  412. %>