function.asp

功能说明： 1

<%
sub exejs(str,exe)
  response.Write("<script language='javascript'>alert('"&str&"');"&exe&"</script>")
  response.End()
end sub
 function jiami(str)
  dim p,l,i
  p=""
  l=len(str)
  for i=1 to l
   p=p & chr(asc(mid(str,(l-i+1),1))+(l-i))
  next
  jiami=p
 end function
 function jiemi(str)
  dim p,l,i
  p=""
  l=len(str)
  for i=1 to l
   p=p & chr(asc(mid(str,l-i+1,1))-i+1)
  next
  jiemi=p
 end function
 function length(str)
  dim n,l,i
  l=len(str)
  for i=1 to l
   n=mid(str,i,1)
   if asc(n)>255 or asc(n)<0 then l=l+1
  next
  length=l
 end function
 Sub DoDel(sPathFile)
	On Error Resume Next
	Dim oFSO
	Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
	if oFSO.FileExists(server.MapPath(sPathFile)) then 	oFSO.DeleteFile(Server.MapPath(sPathFile))
	Set oFSO = Nothing
End Sub
' ============================================
' 得到安全字符串,在查询中或有必要强行替换的表单中使用
' ============================================
Function GetSafeStr(str)
	GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function

' ============================================
' 把字符串进行HTML解码,替换server.htmlencode
' 去除Html格式，用于显示输出
' ============================================
Function outHTML(str)
	Dim sTemp
	sTemp = str
	outHTML = ""
	If IsNull(sTemp) = True Then
		Exit Function
	End If
	sTemp = Replace(sTemp, "&", "&amp;")
	sTemp = Replace(sTemp, "<", "&lt;")
	sTemp = Replace(sTemp, ">", "&gt;")
	sTemp = Replace(sTemp, Chr(34), "&quot;")
	sTemp = Replace(sTemp, Chr(10), "<br>")
	outHTML = sTemp
End Function

' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
	Dim sTemp
	sTemp = str
	inHTML = ""
	If IsNull(sTemp) = True Then
		Exit Function
	End If
	sTemp = Replace(sTemp, "&", "&amp;")
	sTemp = Replace(sTemp, "<", "&lt;")
	sTemp = Replace(sTemp, ">", "&gt;")
	sTemp = Replace(sTemp, Chr(34), "&quot;")
	inHTML = sTemp
End Function
'============================================
'检查一个字段值在表中是否已经存在
'zd是字段,zdz是字段值，ta是表格，str是提示信息，exe是执行语句
'==============================================
sub cheta(zd,zdz,ta,str,exe)
 'dim sql,rs
 sql="select "&zd&" from "&ta&" where "&zd&"='"&zdz&"'"
 set rs=conn.execute(sql)
 if not rs.eof or not rs.bof then 
  exejs str,exe
 end if
end sub
'=======================================
'显示类别名
'=======================================
sub title(str,id1,id2)
'  set rs=server.createobject("adodb.recordset")
  if str=1 then 
    sql="select * from class1 where cateid="&id1
	set myrs=conn.execute(sql)
	if not myrs.eof then
	  response.write trim(myrs("title"))
	 else
	 response.Write("未知类别")
	end if 
  elseif str=2 then
   sql="select * from class2 where id1="&id1&" and cateid="&id2
	set myrs=conn.execute(sql)
	if not myrs.eof then
	  response.write trim(myrs("title"))
	 else
	 response.Write("未知类别")
	end if 
  elseif str=3 then 
    sql="select * from adclass where adid="&id1
	set myrs=conn.execute(sql)
	if not myrs.eof then
	 response.Write(trim(myrs("adtitle")))
	 else
	 response.Write("未知类别")
	 end if  
  elseif str=4 then 
    sql="select * from askbigclass where cateid="&id1
	set myrs=conn.execute(sql)
	if not myrs.eof then
	 response.Write(trim(myrs("title")))
	 else
	 response.Write("未知类别")
	 end if
  elseif str=5 then 
    sql="select * from asksmallclass where bigid="&id1&" and cateid="&id2
	set myrs=conn.execute(sql)
	if not myrs.eof then
	 response.Write(trim(myrs("title")))
	 else
	 response.Write("未知类别")
	 end if 
  elseif str=6 then 
    sql="select * from infoclass where cateid="&id1
	set myrs=conn.execute(sql)
	if not myrs.eof then
	 response.Write(trim(myrs("title")))
	 else
	 response.Write("未知类别")
	 end if 	 	
  end if
  set myrs=nothing
 ' set conn=nothing	
end sub
Sub BrandNewDay()
	Dim sDate, y, m, d, w
	Dim sDateChinese
	sDate = Date()
	If Application("date_today") = sDate Then Exit Sub

	y = CStr(Year(sDate))
	m = CStr(Month(sDate))
	If Len(m) = 1 Then m = "0" & m
	d = CStr(Day(sDate))
	If Len(d) = 1 Then d = "0" & d
	w = WeekdayName(Weekday(sDate))
	sDateChinese = y & "年" & m & "月" & d & "日&nbsp;" & w

	Application.Lock
	Application("date_today") = sDate
	Application("date_chinese") = sDateChinese		'今天的中文样式
	Application.Unlock
End Sub
function puton()
 if session("tonguo")<>"OK" then 
   exejs"您没有权限访问此页","window.location.href='../../user/logo.asp'"
   response.end
 end if
end function
Function Htmlout(str)
dim result 
dim l 
if isNULL(str) then 
Htmlout="" 
exit function 
end if 
l=len(str) 
result="" 
dim i 
for i = 1 to l 
select case mid(str,i,1) 
case "<" 
result=result+"&lt;" 
case ">" 
result=result+"&gt;" 
case chr(13) 
if session("admin_system")="" then 
result=result+"<br>" 
end if 
case chr(34) 
result=result+"&quot;" 
case "&" 
result=result+"&amp;" 
case chr(32) 
result=result+"+"
case chr(9) 
result=result+" " 
case else 
result=result+mid(str,i,1) 
end select 
next 
Htmlout=result 
End Function
function chr13(c)
 for x=i to c
  tempstr=tempstr&chr(13)
 next
 chr13=tempstr
end function
%>