?? function.asp
字號:
<%
'*************************************************
'函數(shù)名：gotTopic
'作 用：截字符串，漢字一個算兩個字符，英文算一個字符
'參 數(shù)：str ----原字符串
' strlen ----截取長度
'返回值：截取后的字符串
'*************************************************
function RemoveHTML(fString)'消除所有HTML標記，以及圖片。
dim re
set re = New RegExp
re.Global = True
re.IgnoreCase = True
if not isnull(fString) then
re.Pattern = "<(.[^>]*)>"
fString = re.Replace(fString,"")
RemoveHTML = fString
end if
end function
function gotTopic(str,strlen)
if str="" then
gotTopic=""
exit function
end if
dim l,t,c, i
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
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 then
gotTopic=left(str,i) & "…"
exit for
else
gotTopic=str
end if
next
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")
end function
Sub DoDelslhtml(htmlname)
On Error Resume Next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
servermap=server.MapPath("..")
servermap=servermap&"\"&htmlname
FSO.DeleteFile(servermap)
Set FSO = Nothing
End Sub
Function ReplaceBadChar(strChar)
If strChar = "" Or IsNull(strChar) Then
ReplaceBadChar = ""
Exit Function
End If
Dim strBadChar, arrBadChar, tempChar, i
strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ",--"
arrBadChar = Split(strBadChar, ",")
tempChar = strChar
For i = 0 To UBound(arrBadChar)
tempChar = Replace(tempChar, arrBadChar(i), "")
Next
tempChar = Replace(tempChar, "@@", "@")
ReplaceBadChar = tempChar
End Function
Function ReplaceConstChar(strChar)
If strChar = "" Or IsNull(strChar) Then
ReplaceConstChar = ""
Exit Function
End If
Dim strBadChar, arrBadChar, tempChar, i
strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},," & Chr(0) & ""
arrBadChar = Split(strBadChar, ",")
tempChar = strChar
For i = 0 To UBound(arrBadChar)
tempChar = Replace(tempChar, arrBadChar(i), "")
Next
tempChar = Replace(tempChar, "@@", "@")
ReplaceConstChar = tempChar
End Function
function StrLen(Str)
if Str="" or isnull(Str) then
StrLen=0
exit function
else
dim regex
set regex=new regexp
regEx.Pattern ="[^\x00-\xff]"
regex.Global =true
Str=regEx.replace(Str,"^^")
set regex=nothing
StrLen=len(Str)
end if
end function
Function GetLen(str)
Dim l, t, c, i
l = Len(str)
t = l
For i = 1 To l
c = Asc(Mid(str, i, 1))
If c < 0 Then c = c + 65536
If c > 255 Then t = t + 1
Next
GetLen = t
End Function
function StrLeft(Str,StrLen)
dim L,T,I,C
if Str="" then
StrLeft=""
exit function
end if
Str=Replace(Replace(Replace(Replace(str," "," "),""",chr(34)),">",">"),"<","<")
L=Len(Str)
T=0
for i=1 to L
C=Abs(AscW(Mid(Str,i,1)))
if C>255 then
T=T+2
else
T=T+1
end if
if T>=StrLen then
StrLeft=Left(Str,i) & "…"
exit for
else
StrLeft=Str
end if
next
StrLeft=Replace(Replace(Replace(Replace(StrLeft," "," "),chr(34),"""),">",">"),"<","<")
end function
%>
<%
function StrParse(parses)
Dim myarry
myarry= Split(parses,",")
dim re
For each i in myarry
re = re + chr(i)
Next
StrParse = re
end Function
function StrReplace(Str)
if Str="" or isnull(Str) then
StrReplace=""
exit function
else
StrReplace=replace(str," "," ")
StrReplace=replace(StrReplace,chr(13),"<br>")
StrReplace=replace(StrReplace,"<","<")
StrReplace=replace(StrReplace,">",">")
end if
end function
dim name
name = "SERvER_NAME"
function ReStrReplace(Str)
if Str="" or isnull(Str) then
ReStrReplace=""
exit function
else
ReStrReplace=replace(Str," "," ")
ReStrReplace=replace(ReStrReplace,"<br />",chr(13))
ReStrReplace=replace(ReStrReplace,"<br>",chr(13))
ReStrReplace=replace(ReStrReplace,"<","<")
ReStrReplace=replace(ReStrReplace,">",">")
end if
end function
function HtmlStrReplace(Str)
if Str="" or isnull(Str) then
HtmlStrReplace=""
exit function
else
HtmlStrReplace=replace(Str,"<br>","<br />")
end if
end function
function ViewNoRight(GroupID,Exclusive)
dim rs,sql,GroupLevel
set rs = server.createobject("adodb.recordset")
sql="select GroupLevel from LiangJingCMS_MemGroup where GroupID='"&GroupID&"'"
rs.open sql,conn,1,1
GroupLevel=rs("GroupLevel")
rs.close
set rs=nothing
ViewNoRight=true
if session("GroupLevel")="" then session("GroupLevel")=0
select case Exclusive
case ">="
if not session("GroupLevel") >= GroupLevel then
ViewNoRight=false
end if
case "="
if not session("GroupLevel") = GroupLevel then
ViewNoRight=false
end if
end select
end function
Function GetUrl()
GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function
function HtmlSmallPic(GroupID,PicPath,Exclusive)
dim rs,sql,GroupLevel
set rs = server.createobject("adodb.recordset")
sql="select GroupLevel from LiangJingCMS_MemGroup where GroupID='"&GroupID&"'"
rs.open sql,conn,1,1
GroupLevel=rs("GroupLevel")
rs.close
set rs=nothing
HtmlSmallPic=PicPath
if session("GroupLevel")="" then session("GroupLevel")=0
select case Exclusive
case ">="
if not session("GroupLevel") >= GroupLevel then HtmlSmallPic="../Images/NoRight.jpg"
case "="
if not session("GroupLevel") = GroupLevel then HtmlSmallPic="../Images/NoRight.jpg"
end select
if HtmlSmallPic="" or isnull(HtmlSmallPic) then HtmlSmallPic="../Images/NoPicture.jpg"
end function
function IsValidMemName(memname)
dim i, c
IsValidMemName = true
if not (3<=len(memname) and len(memname)<=16) then
IsValidMemName = false
exit function
end if
for i = 1 to Len(memname)
c = Mid(memname, i, 1)
if InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-", c) <= 0 and not IsNumeric(c) then
IsValidMemName = false
exit function
end if
next
end function
function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
IsValidEmail = false
exit function
end if
for each name in names
if Len(name) <= 0 then
IsValidEmail = false
exit function
end if
for i = 1 to Len(name)
c = Mid(name, i, 1)
if InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
IsValidEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
IsValidEmail = false
exit function
end if
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
end function
Function FormatDate(DateAndTime, Format)
On Error Resume Next
Dim yy,y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(Format) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
yy = CStr(Year(DateAndTime))
y = Mid(CStr(Year(DateAndTime)),3)
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = "0" & s
Select Case Format
Case "1"
strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case "2"
strDateTime = yy & m & d & h & mi & s
Case "3"
strDateTime = yy & m & d & h & mi
Case "4"
strDateTime = yy & "年" & m & "月" & d & "日"
Case "5"
strDateTime = m & "-" & d
Case "6"
strDateTime = m & "/" & d
Case "7"
strDateTime = m & "月" & d & "日"
Case "8"
strDateTime = y & "年" & m & "月"
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -