IsvalidFile = False
Dim GName
For Each GName in UP_FileType
If File_Type = GName Then
IsvalidFile = True
Exit For
End If
Next
End Function
Function IsInteger(Para) '检测是否有效的数字
IsInteger=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
IsInteger=True
End If
End Function
Function CheckStr(byVal ChkStr) '检查无效字符
Dim Str:Str=ChkStr
Str=Trim(Str)
If IsNull(Str) Then
CheckStr = ""
Exit Function
End If
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(\r\n){3,}"
Str=re.Replace(Str,"$1$1$1")
Set re=Nothing
Str = Replace(Str,"'","''")
Str = Replace(Str, "select", "select")
Str = Replace(Str, "join", "join")
Str = Replace(Str, "union", "union")
Str = Replace(Str, "where", "where")
Str = Replace(Str, "insert", "insert")
Str = Replace(Str, "delete", "delete")
Str = Replace(Str, "update", "update")
Str = Replace(Str, "like", "like")
Str = Replace(Str, "drop", "drop")
Str = Replace(Str, "create", "create")
Str = Replace(Str, "modify", "modify")
Str = Replace(Str, "rename", "rename")
Str = Replace(Str, "alter", "alter")
Str = Replace(Str, "cast", "cast")
CheckStr=Str
End Function
Function UnCheckStr(Str)
Str = Replace(Str, "select", "select")
Str = Replace(Str, "join", "join")
Str = Replace(Str, "union", "union")
Str = Replace(Str, "where", "where")
Str = Replace(Str, "insert", "insert")
Str = Replace(Str, "delete", "delete")
Str = Replace(Str, "update", "update")
Str = Replace(Str, "like", "like")
Str = Replace(Str, "drop", "drop")
Str = Replace(Str, "create", "create")
Str = Replace(Str, "modify", "modify")
Str = Replace(Str, "rename", "rename")
Str = Replace(Str, "alter", "alter")
Str = Replace(Str, "cast", "cast")
UnCheckStr=Str
End Function
Function HTMLEncode(reString) '转换HTML代码
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = UnCheckStr(Str)
Str = Replace(Str, "&", "&")
Str = Replace(Str, ">", ">")
Str = Replace(Str, " Str = Replace(Str, CHR(32), " ")
Str = Replace(Str, CHR(9), " ")
Str = Replace(Str, CHR(9), " ")
Str = Replace(Str, CHR(34),""")
Str = Replace(Str, CHR(39),"'")
Str = Replace(Str, CHR(13), "")
Str = Replace(Str, CHR(10), "")
HTMLEncode = Str
End If
End Function
Function EditDeHTML(byVal Content)
EditDeHTML=Content
IF Not IsNull(EditDeHTML) Then
EditDeHTML=UnCheckStr(EditDeHTML)
EditDeHTML=Replace(EditDeHTML,"&","&")
EditDeHTML=Replace(EditDeHTML," EditDeHTML=Replace(EditDeHTML,">",">")
EditDeHTML=Replace(EditDeHTML,CHR(34),""")
EditDeHTML=Replace(EditDeHTML,CHR(39),"'")
End IF
End Function
Function DateToStr(DateTime,ShowType) '日期转换函数
Dim DateMonth,DateDay,DateHour,DateMinute
DateMonth=Month(DateTime)
DateDay=Day(DateTime)
DateHour=Hour(DateTime)
DateMinute=Minute(DateTime)
If Len(DateMonth) If Len(DateDay) Select Case ShowType
Case "Y-m-d"
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
Case "Y-m-d H:I A"
Dim DateAMPM
If DateHour>12 Then
DateHour=DateHour-12
DateAMPM="PM"
Else
DateHour=DateHour
DateAMPM="AM"
End If
If Len(DateHour) If Len(DateMinute) DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
Case "Y-m-d H:I:S"
Dim DateSecond
DateSecond=Second(DateTime)
If Len(DateHour) If Len(DateMinute) If Len(DateSecond) DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
Case "YmdHIS"
DateSecond=Second(DateTime)
If Len(DateHour) If Len(DateMinute) If Len(DateSecond) DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond
Case "ym"
DateToStr=Right(Year(DateTime),2)&DateMonth
Case "d"
DateToStr=DateDay
Case Else
If Len(DateHour) If Len(DateMinute) DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
End Select
End Function
Function IsValidUserName(byVal UserName)
Dim i,c
IsValidUserName = True
For i = 1 To Len(UserName)
c = Lcase(Mid(UserName, i, 1))
IF InStr("$!?#^%@~`&*(){};:+='"" ", c) > 0 Then
IsValidUserName = False
Exit Function
End IF
Next
End Function
Function IsValidEmail(Email) '检测是否有效的E-mail地址
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) IsValidEmail = False
Exit Function
End If
For i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) 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), ".") 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 MultiPage(Numbers,Perpage,Curpage,Url_Add) '分页函数
CurPage=Int(Curpage)
Dim URL
URL=Request.ServerVariables("Script_Name")&Url_Add
MultiPage=""
Dim Page,Offset,PageI
If Int(Numbers)>Int(PerPage) Then
Page=10
Offset=2
Dim Pages,FromPage,ToPage
If Numbers Mod Cint(Perpage)=0 Then
Pages=Int(Numbers/Perpage)
Else
Pages=Int(Numbers/Perpage)+1
End If
FromPage=Curpage-Offset
ToPage=Curpage+Page-Offset-1
If Page>Pages Then
FromPage=1
ToPage=Pages
Else
If FromPage Topage=Curpage+1-FromPage
FromPage=1
If (ToPage-FromPage) ElseIF Topage>Pages Then
FromPage =Curpage-Pages +ToPage
ToPage=Pages
If (ToPage-FromPage) End If
End If
MultiPage=" "
For PageI=FromPage TO ToPage
If PageICurPage Then
MultiPage=MultiPage&"["&PageI&"] "
Else
MultiPage=MultiPage&"["&PageI&"] "
End If
Next
If Int(Pages)>Int(Page) Then
MultiPage=MultiPage&" ... ["&pages&"] "
Else
MultiPage=MultiPage&" "
End If
End If
End Function
Function SplitLines(byVal Content,byVal ContentNums) '切割内容
Dim ts,i,l
If IsNull(Content) Then Exit Function
i=1
ts = 0
For i=1 to Len(Content)
l=Mid(Content,i,4)
If l="" Then
ts=ts+1
End If
If ts>ContentNums Then Exit For
Next
If ts>ContentNums Then
Content=Left(Content,i-1)
End If
SplitLines=Content
End Function
Function Generator(Length)
Dim i, tempS
tempS = "abcdefghijklmnopqrstuvwxyz1234567890"
Generator = ""
If isNumeric(Length) = False Then
Exit Function
End If
For i = 1 to Length
Randomize
Generator = Generator & Mid(tempS,Int((Len(tempS) * Rnd) + 1),1)
Next
End Function
Function CutStr(byVal Str,byVal StrLen)
Dim l,t,c,i
l=Len(str)
t=0
For i=1 To l
c=AscW(Mid(str,i,1))
If c255 Then t=t+2 Else t=t+1
IF t>=StrLen Then
CutStr=left(Str,i)&"..."
Exit For
Else
CutStr=Str
End If
Next
End Function
Function Trackback(trackback_url, url, title, excerpt, blog_name)
Dim query_string, objXMLHTTP, objDOM
title = cutStr(Server.URLEncode(title),100)
excerpt = cutStr(Server.URLEncode(excerpt), 252)
url = Server.URLEncode(url)
blog_name = Server.URLEncode(blog_name)
query_string = "title="&title&"&url="&url&"&blog_name="&blog_name&"&excerpt="&excerpt
Set objXMLHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
Set objDom = Server.CreateObject("Microsoft.XMLDOM")
objXMLHTTP.Open "POST", trackback_url, false
objXMLHTTP.setRequestHeader "Content-Type","application/x-www-Form-urlencoded"
'HAndling timeout
On Error Resume Next
objXMLHTTP.SEnd query_string
If objXMLHTTP.readyState 4 Then
objXMLHTTP.waitForResponse 15
End If
If Err.Number 0 Then
Trackback = "0$$TrackBack 错误：无法连接服务器"
Else
If (objXMLHTTP.readyState 4) Or (objXMLHTTP.Status 200) Then
objXMLHTTP.Abort
Trackback = "0$$Trackback 超时"
Else
objDom.async=false
objDom.loadXML(objXMLHTTP.responseText)
If objDom.parseError.errorCode 0 Then
Trackback = "0$$TrackBack 响应解析错误"
Else
If objDom.getElementsByTagName("error")(0).Text="0" Then
Trackback = "1$$Trackback 成功"
Else
Trackback = "0$$Trackback 错误："&objDom.getElementsByTagName("message")(0).Text
End If
End If
End If
End If
Set objXMLHTTP = Nothing
Set objDom = Nothing
End Function
Function DelQuote(strContent)
If IsNull(strContent) Then Exit Function
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(\[quote\])(.*?)(\[\/quote\])"
strContent= re.Replace(strContent,"")
Set re=Nothing
DelQuote=strContent
End Function%>
