Function finddir(filepath)
finddir=""
for i=1 to len(filepath)
if left(right(filepath,i),1)="/" or left(right(filepath,i),1)="\" then
abc=i
exit for
end if
next
if abc 1 then
finddir=left(filepath,len(filepath)-abc+1)
end if
end Function
'**************************************************
'字符串长度。汉字算两个字符，英文算一个字符。
'**************************************************
function strLength(str)
ON ERROR RESUME NEXT
dim WINNT_CHINESE
WINNT_CHINESE = (len("中国")=2)
if WINNT_CHINESE then
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c if c>255 then
t=t+1
end if
next
strLength=t
else
strLength=len(str)
end if
if err.number0 then err.clear
end function
'*************************************************
'截字符串函数，汉字一个算两个字符，英文算一个字符
'*************************************************
function gotTopic(str,strlen)
dim l,t,c, i
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=(strlen-1) then
gotTopic=left(str,i)
exit for
else
gotTopic=str
end if
next
end function
sub WriteErrMsg(errmsg)
dim strErr
strErr=strErr & "错误信息" & vbcrlf
strErr=strErr & "" & vbcrlf
strErr=strErr & "" & vbcrlf
strErr=strErr & " 错误信息" & vbcrlf
strErr=strErr & " 产生错误的可能原因：" & errmsg &"" & vbcrlf
strErr=strErr & " << 返回上一页" & vbcrlf
strErr=strErr & "" & vbcrlf
strErr=strErr & "" & vbcrlf
response.write strErr
end sub
sub WriteSuccessMsg(SuccessMsg)
dim strSuccess
strSuccess=strSuccess & "信息" & vbcrlf
strSuccess=strSuccess & "" & vbcrlf
strSuccess=strSuccess & "" & vbcrlf
strSuccess=strSuccess & " 执行成功！" & vbcrlf
strSuccess=strSuccess & " " & SuccessMsg &"" & vbcrlf
strSuccess=strSuccess & " 【返回上一页】" & vbcrlf
strSuccess=strSuccess & "" & vbcrlf
strSuccess=strSuccess & "" & vbcrlf
response.write strSuccess
end sub
Function FilterJS(v)
if not isnull(v) then
dim t
dim re
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(javascript)"
t=re.Replace(v,"javascript")
re.Pattern="(jscript:)"
t=re.Replace(t,"jscript:")
re.Pattern="(js:)"
t=re.Replace(t,"js:")
re.Pattern="(value)"
t=re.Replace(t,"value")
re.Pattern="(about:)"
t=re.Replace(t,"about:")
re.Pattern="(file:)"
t=re.Replace(t,"file:")
re.Pattern="(document.cookie)"
t=re.Replace(t,"documents.cookie")
re.Pattern="(vbscript:)"
t=re.Replace(t,"vbscript:")
re.Pattern="(vbs:)"
t=re.Replace(t,"vbs:")
re.Pattern="(on(mouse|exit|error|click|key))"
t=re.Replace(t,"on$2")
re.Pattern="(&#)"
t=re.Replace(t,"＆#")
FilterJS=t
set re=nothing
end if
End Function
function dvHTMLEncode(fString)
if not isnull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), " ")
fString = Replace(fString, CHR(10), " ")
fString = Replace(fString, "script", "")
dvHTMLEncode = fString
end if
end function
function fixchar(fString)
if not isnull(fString) then
fString = replace(fString, ">", "")
fString = replace(fString, " fString = Replace(fString, "like", "")
fString = Replace(fString, "Where", "")
fString = Replace(fString, CHR(32), "")
fString = Replace(fString, CHR(34), "")
fString = Replace(fString, CHR(39), "")
fString = Replace(fString, CHR(37), "")
fString = Replace(fString, "script", "")
fixchar = fString
end if
end function
function nohtml(str)
dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(\ str=re.replace(str," ")
re.Pattern="(\ str=re.replace(str," ")
nohtml=str
set re=nothing
end function
%>
