sub exejs(str,exe)
response.Write("alert('"&str&"');"&exe&"")
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) 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, "&", "&")
sTemp = Replace(sTemp, " sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
sTemp = Replace(sTemp, Chr(10), "")
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, "&", "&")
sTemp = Replace(sTemp, " sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
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 & "日 " & 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+"<"
case ">"
result=result+">"
case chr(13)
if session("admin_system")="" then
result=result+""
end if
case chr(34)
result=result+"""
case "&"
result=result+"&"
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
%>
