asp常用函數(shù)集合，非常不錯以后研究
更新時間：2008年01月12日 16:36:13 作者：
asp常用函數(shù)集合，非常不錯以后研究
function gfv(str)
gfv = request.form(str)
end function
function guv(str)
guv = request.querystring(str)
end function
function alertbox(str,kindnum)
select case kindnum
case "1"
response.write("<script>alert(""" & str & """);</script>")
response.end()
case "2"
response.write("<script>alert(""" & str & """);window.history.back();</script>")
response.end()
case "3"
response.write("<script>alert(""" & str & """);window.close();</script>")
response.end()
end select
end function
sub WRITE_LINE(str)
response.write ltrim(str)
end sub
sub LOADING_BUFFER_INI
response.expires = 0
response.expiresabsolute = now() - 1
response.addheader "pragma","no-cache"
response.addheader "cache-control","private"
response.cachecontrol = "no-cache"
end sub
sub LOADING_ADMIN_HEAD
WRITE_LINE "<html><head><title></title>"
WRITE_LINE "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
WRITE_LINE "<meta http-equiv=""Content-Language"" content=""gb2312"">"
WRITE_LINE "<link href=""../images/ncms/css.css"" rel=""stylesheet"" type=""text/css""></head>"
WRITE_LINE "<body leftmargin=""1"" topmargin=""10"" scroll=""auto"">"
end sub
sub LOADING_ADMIN_FOOT
if isobject("conn") then
conn.close:set conn = nothing
elseif isobject("commentconn") then
commentconn.close:set commentconn = nothing
elseif isobject("collectconn") then
collectconn.close:set collectconn = nothing
end if
WRITE_LINE "<table align=""center"" width=""100%"" cellpadding=""2"" cellspacing=""1"" border=""0"">"
WRITE_LINE "<tr>"
WRITE_LINE "<td align=""middle"" valign=""middle"">"
WRITE_LINE "<table bgcolor=""#c0c0c0"" align=""center"" width=""98%"" cellpadding=""2"" cellspacing=""1"">"
WRITE_LINE "<tr>"
WRITE_LINE "<td bgcolor=""#f0f0f0"" height=""50""><div align=""center""><font face=""verdana,arial,helvetica,sans-serif"" size=""1""><b>©2006 - 2008 CopyRight NCMS All Rights Reserved.Version:" & Version & " <a href=""http://www.50z.cn/"" target=""_blank"">BBS</a></b></font></div></td>"
WRITE_LINE "</tr>"
WRITE_LINE "</table>"
WRITE_LINE "</td>"
WRITE_LINE "</tr>"
WRITE_LINE "</table>"
WRITE_LINE "</body></html>"
end sub
'===============================================================================================
'楚河|漢界 來個小廣告:如果您發(fā)現(xiàn)本程序BUG或不足之處或有好的改進方法,請聯(lián)系我:QQ574634!萬分感謝!
'===============================================================================================
Function IsValidEmail(Str)
IsValidEmail = False
Dim RegEx,Match
Set RegEx = New RegExp
RegEx.Pattern = "^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
RegEx.IgnoreCase = True
Set Match = RegEx.Execute(Str)
If Match.Count Then IsValidEmail = True
End Function
Function ChkNum(Byval Num)
Dim tNum:tNum = ""
If Num = "" Or Not IsNumeric(Num) Then
Response.Write("<script>alert(""參數(shù)類型錯誤!"");history.back();</script>")
Response.End()
ElseIf len(Num) > 8 Then
Response.Write("<script>alert(""參數(shù)超出范圍!"");history.back();</script>")
Response.End()
Else
tNum = clng(left(Num,8))
End If
ChkNum = tNum
End Function
Function ChkStr(ByVal Str)
Dim TempStr
TempStr = Replace(Replace(Str,"'",""),Chr(39),"")
Dim RegEx
Set RegEx = New RegExp
RegEx.IGnoreCase = True
RegEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|url|eval|\t"
If RegEx.Test(LCase(TempStr)) Then
TempStr = ""
End If
Set RegEx = Nothing
ChkStr = TempStr
End Function
Function FuckJP(ByVal Str)
If IsNull(Str) Or IsEmpty(Str) Then Exit Function
Dim F,I
F = Array("ゴ","ガ","ギ","グ","ゲ","ザ","ジ","ズ","ヅ","デ","ド","ポ","ベ","プ","ビ","パ","ヴ","ボ","ペ","ブ","ピ","バ","ヂ","ダ","ゾ","ゼ")
FuckJP = Str
For I = 0 To 25
FuckJP = Replace(FuckJP,F(I),"")
Next
End Function
Function ChkInput(Str)
Dim RegEx
Set RegEx = New RegExp
RegEx.IgnoreCase = True
RegEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|url|eval|\t"
If RegEx.Test(LCase(Str)) Then
Response.Write("處理 URL 時服務器出錯，請與系統(tǒng)管理員聯(lián)系。")
Response.End()
End If
Set RegEx = Nothing
ChkInput = Str
End Function
Function ChkPost()
Dim From_Url:From_Url = CStr(Request.ServerVariables("HTTP_REFERER"))
Dim Serv_Url:Serv_Url = CStr(Request.ServerVariables("SERVER_NAME"))
If Mid(From_Url,8,Len(Serv_Url)) <> Serv_Url Then
Response.Write("處理 URL 時服務器出錯，請與系統(tǒng)管理員聯(lián)系。")
Response.End()
End If
End Function
Function GetIP()
Dim StrIP_List,StrIP,IP_Ary
StrIP_List = Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'","")
If InStr(StrIP_List,",") <> 0 Then
IP_Ary = Split(StrIP_List,",")
StrIP = IP_Ary(0)
Else
StrIP = StrIP_List
End If
If StrIP = Empty Then StrIP = Replace(Request.ServerVariables("REMOTE_ADDR"),"'","")
GetIP = StrIP
End Function
Function Highlight(byVal strContent,byRef arrayWords)
Dim intCounter,strTemp,intPos,intTagLength,intKeyWordLength,bUpDate
If Len(arrayWords) < 1 Then Highlight = strContent:Exit Function
For intPos = 1 To Len(strContent)
bUpDate = False
If Mid(strContent,intPos,1) = "<" Then
On Error Resume Next
intTagLength = (InStr(intPos,strContent,">",1) - intPos)
If Err.Number <> 0 Then
Highlight = strContent
Err.Clear
End If
strTemp = strTemp & Mid(strContent,intPos,intTagLength)
intPos = intPos + intTagLength
End If
If arrayWords <> "" Then
intKeyWordLength = Len(arrayWords)
If LCase(Mid(strContent,intPos,intKeyWordLength)) = LCase(arrayWords) Then
strTemp = strTemp & "<strong style=""color:#ff0000;background:#fff000;"">" & Mid(strContent,intPos,intKeyWordLength) & "</strong>"
intPos = intPos + intKeyWordLength - 1
bUpDate = True
End If
End If
If bUpDate = False Then
strTemp = strTemp & Mid(strContent,intPos,1)
End If
Next
Highlight = strTemp
End Function
Function SendToNcms(Str1,Str2,Str3,Str4)
On Error Resume Next
WRITE_LINE "<script>setTimeout(""document.form.submit()"",0);</script>"
WRITE_LINE "<form name=""form"" action=""http://ncms.cn/users/receive.asp"" method=""post"">"
WRITE_LINE "<input name=""k1"" type=""hidden"" value=""" & Str1 & """>"
WRITE_LINE "<input name=""k2"" type=""hidden"" value=""" & Str2 & """>"
WRITE_LINE "<input name=""k3"" type=""hidden"" value=""" & Str3 & """>"
WRITE_LINE "<input name=""k4"" type=""hidden"" value=""" & Str4 & """>"
WRITE_LINE "<input name=""kx"" type=""hidden"" value=""203674122566320014"">"
WRITE_LINE "</form>"
End Function
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
Function GetVer(ClassStr)
On Error Resume Next
GetVer = ""
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(ClassStr)
If 0 = Err Then GetVer = xTestObj.Version
Set xTestObj = Nothing
Err = 0
End Function
Function ReplaceRemoteUrl(sHTML,sSavePath,sExt)
Dim s_Content:s_Content = sHTML
If IsObjInstalled("Microsoft.XMLHTTP") = False Then
ReplaceRemoteUrl = s_Content
Exit Function
End If
If sSavePath = "" Then sSavePath = "" & site_root & "/" & site_upload & "/" & site_bimg & "/"
If sExt = "" Then sExt = "jpg|gif|png|bmp|swf"
Dim RegEx,RemoteFile,RemoteFileurl,SaveFileName,OutPutPath,SaveFileType,RanNum,NewFileName
Set RegEx = New RegExp
RegEx.IgnoreCase = True
RegEx.Global = True
RegEx.Pattern = "(http://(.+?)\.(" & sExt & "))"
Set RemoteFile = RegEx.Execute(s_Content)
For Each RemoteFileurl In RemoteFile
SaveFileType = Mid(RemoteFileurl,InstrRev(RemoteFileurl,".") + 1)
Randomize
RanNum = Int(900 * Rnd) + 100
NewFileName = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & RanNum & "." & SaveFileType
SaveFileName = sSavePath & NewFileName
OutPutPath = "" & site_root & "/tools/loadimg.asp?FileName=" & NewFileName & ""
Call SaveRemoteFile(SaveFileName,RemoteFileurl)
s_Content = Replace(s_Content,RemoteFileurl,OutPutPath)
Next
ReplaceRemoteUrl = NewFileName & "|" & s_Content
End Function
Sub SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl)
Dim Ads,Retrieval,GetRemoteData
On Error Resume Next
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get",s_RemoteFileUrl,False,"",""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject("ADODB.Stream")
Ads.Type = 1
Ads.Open
Ads.Write GetRemoteData
Ads.SaveToFile Server.Mappath(s_LocalFileName),2
Ads.Cancel()
Ads.Close()
Set Ads = Nothing
End Sub
Class Cls_vbsPage
Private oConn
Private iPagesize
Private sPageName
Private sDbType
Private iRecType
Private sJsUrl
Private sField
Private sTable
Private sCondition
Private sOrderBy
Private sPkey
Private iRecCount
Private Sub Class_Initialize
iPageSize=10
sPageName="Page"
sDbType="AC"
iRecType=0
sJsUrl=""
sField=" * "
End Sub
Public Property Set Conn(ByRef Value)
Set oConn=Value
End Property
Public Property Let PageSize(ByVal intPageSize)
iPageSize=CheckNum(intPageSize,0,0,iPageSize,0)
End Property
Public Property Let PageName(ByVal strPageName)
sPageName=IIf(Len(strPageName)<1,sPageName,strPageName)
End Property
Public Property Let DbType(ByVal strDbType)
sDbType=UCase(IIf(Len(strDbType)<1,sDbType,strDbType))
End Property
Public Property Let RecType(ByVal intRecType)
iRecType=CheckNum(intRecType,0,0,iRecType,0)
End Property
Public Property Let JsUrl(ByVal strJsUrl)
sJsUrl=strJsUrl
End Property
Public Property Let Pkey(ByVal strPkey)
sPkey=strPkey
End Property
Public Property Let Field(ByVal strField)
sField=IIf(Len(strField)<1,sField,strField)
End Property
Public Property Let Table(ByVal strTable)
sTable=strTable
End Property
Public Property Let Condition(ByVal strCondition)
Dim s
s=strCondition
sCondition=IIf(Len(s)>2," WHERE "&s,"")
End Property
Public Property Let OrderBy(ByVal strOrderBy)
Dim s
s=strOrderBy
sOrderBy=IIf(Len(s)>4," ORDER BY "&s,"")
End Property
Public Property Get RecCount()
If iRecType>0 Then
i=iRecType
Elseif iRecType=0 Then
i=CheckNum(Request.Cookies("ShowoPage")(sPageName),1,0,0,0)
Dim s
s=Trim(Request.Cookies("ShowoPage")("sCond"))
IF i=0 OR sCondition<>s Then
i=oConn.Execute("SELECT COUNT("&sPkey&") FROM "&sTable&" "&sCondition,0,1)(0)
Response.Cookies("ShowoPage")(sPageName)=i
Response.Cookies("ShowoPage")("sCond")=sCondition
End If
Else
i=oConn.Execute("SELECT COUNT("&sPkey&") FROM "&sTable&" "&sCondition,0,1)(0)
End If
iRecCount=i
RecCount=i
End Property
Public Property Get ResultSet()
Dim s
s=Null
i=iRecCount
If i>0 Then
Dim iPageCount,iPageCurr
iPageCount=Abs(Int(-Abs(i/iPageSize)))
iPageCurr=CheckNum(Request.QueryString(sPageName),1,1,1,iPageCount)
Select Case sDbType
Case "MSSQL"
Set Rs=server.CreateObject("Adodb.RecordSet")
Set Cm=Server.CreateObject("Adodb.Command")
Cm.CommandType=4
Cm.ActiveConnection=oConn
Cm.CommandText="sp_Util_Page"
Cm.parameters(1)=i
Cm.parameters(2)=iPageCurr
Cm.parameters(3)=iPageSize
Cm.parameters(4)=sPkey
Cm.parameters(5)=sField
Cm.parameters(6)=sTable
Cm.parameters(7)=Replace(sCondition," WHERE ","")
Cm.parameters(8)=Replace(sOrderBy," ORDER BY ","")
Rs.CursorLocation=3
Rs.LockType=1
Rs.Open Cm
Case "MYSQL"
ResultSet_Sql="SELECT "&sField&" FROM "&sTable&" "&sCondition&" "&sOrderBy&" LIMIT "&(iPageCurr-1)*iPageSize&","&iPageSize
Set Rs=oConn.Execute(ResultSet_Sql)
Case Else
Dim Rs,ResultSet_Sql
Set Rs = Server.CreateObject ("Adodb.RecordSet")
ResultSet_Sql="SELECT "&sField&" FROM "&sTable&" "&sCondition&" "&sOrderBy
Rs.Open ResultSet_Sql,oConn,1,1,&H0001
Rs.AbsolutePosition=(iPageCurr-1)*iPageSize+1
End Select
s=Rs.GetRows(iPageSize)
Rs.close
Set Rs=Nothing
End If
ResultSet=s
End Property
Private Sub Class_Terminate()
If IsObject(oConn) Then oConn.Close:Set oConn=Nothing
End Sub
Private Function CheckNum(ByVal strStr,ByVal blnMin,ByVal blnMax,ByVal intMin,ByVal intMax)
Dim i,s,iMi,iMa
s=Left(Trim(""&strStr),32):iMi=intMin:iMa=intMax
If IsNumeric(s) Then
i=CDbl(s)
i=IIf(blnMin=1 And i<iMi,iMi,i)
i=IIf(blnMax=1 And i>iMa,iMa,i)
Else
i=iMi
End If
CheckNum=i
End Function
Private Function IIf(ByVal blnBool,ByVal strStr1,ByVal strStr2)
Dim s
If blnBool Then
s=strStr1
Else
s=strStr2
End If
IIf=s
End Function
Public Sub ShowPage()
%>
<script language="javascript" type="text/javascript" src="<%=sJsUrl%>/page.js"></script>
<script language="javascript" type="text/javascript">
var s = new Cls_jsPage(<%=iRecCount%>,<%=iPageSize%>,3,"s");
s.setPageSE("<%=sPageName%>=","");
s.setPageInput("<%=sPageName%>");
s.setUrl("");
s.setPageFrist("首頁","<<");
s.setPagePrev("上頁","<");
s.setPageNext("下頁",">");
s.setPageLast("尾頁",">>");
s.setPageText("[{$PageNum}]","第{$PageNum}頁");
s.setPageTextF(" {$PageTextF} "," {$PageTextF} ");
s.setPageSelect("{$PageNum}","第{$PageNum}頁");
s.setPageCss("","","");
s.setHtml("共{$RecCount}記錄 頁次{$Page}/{$PageCount} 每頁{$PageSize}條 {$PageFrist} {$PagePrev} {$PageText} {$PageNext} {$PageLast} {$PageInput} {$PageSelect}");
s.Write();
</script>
<%
End Sub
End Class
Function GetHttpPage(HttpUrl)
On Error Resume Next
If IsNull(HttpUrl) = True Or Len(HttpUrl) < 18 Or HttpUrl = "$False$" Then
GetHttpPage = "$False$"
Exit Function
End If
Dim Http
Set Http = Server.CreateObject("Microsoft.XMLHTTP")
Http.Open "GET",HttpUrl,False
Http.Send()
If Http.Readystate <> 4 Then
Set Http = Nothing
GetHttpPage = "$False$"
Exit function
End If
GetHTTPPage = BytesToBstr(Http.ResponseBody,"GB2312")
Set Http = Nothing
If Err.Number <> 0 Then
Err.Clear
Exit Function
End If
End Function
Function BytesToBstr(Body,Cset)
Dim ObjStream
Set ObjStream = Server.CreateObject("ADODB.Stream")
ObjStream.Type = 1
ObjStream.Mode = 3
ObjStream.Open
ObjStream.Write Body
ObjStream.Position = 0
ObjStream.Type = 2
ObjStream.Charset = Cset
BytesToBstr = ObjStream.ReadText
ObjStream.Close
Set ObjStream = Nothing
End Function
Function GetAllLinkTags(ContStr)
Dim RegEx,Match,Matches,TempStr
Set RegEx = New RegExp
RegEx.Pattern = "<a .*?>.*?</a>"
RegEx.IGnoreCase = True
RegEx.Global = True
Set Matches = RegEx.Execute(ContStr)
For Each Match In Matches
TempStr = TempStr & Match.Value & "|||"
Next
Set Matches = Nothing
Set RegEx = Nothing
GetAllLinkTags = TempStr
End Function
Function GetOtherContent(Str,StartStr,LastStr)
On Error Resume Next
Dim RegEx,SearchStr,Matches,Matche
Str = Replace(Replace(Str,Chr(13),""),Chr(10),"")
StartStr = Replace(Replace(StartStr,Chr(13),""),Chr(10),"")
LastStr = Replace(Replace(LastStr,Chr(13),""),Chr(10),"")
SearchStr = StartStr & ".*" & LastStr
Set RegEx = New RegExp
RegEx.IgnoreCase = True
RegEx.Global = True
RegEx.Pattern = SearchStr
Set Matches = RegEx.Execute(Str)
For Each Matche In Matches
If Matche <> "" Then
GetOtherContent = Matche
RegEx.Pattern = StartStr
GetOtherContent = RegEx.Replace(GetOtherContent,"")
RegEx.Pattern = LastStr & ".*|\n"
GetOtherContent = RegEx.Replace(GetOtherContent,"")
Else
GetOtherContent = ""
End If
If Err.Number <> 0 Then
Err.Clear
GetOtherContent = ""
End If
Exit For
Next
End Function
Function FormatUrl(NewsLinkStr,ObjUrl)
Dim URLSearchLoc
If Left(LCase(NewsLinkStr),7) <> "http://" Then
Dim CheckURLStr,TempCollectObjUrl,CheckObjUrl
NewsLinkStr = Replace(Replace(Replace(NewsLinkStr,"'",""),"""","")," ","")
TempCollectObjUrl = Left(ObjUrl,InStrRev(ObjUrl,"/"))
CheckObjUrl = NewsLinkStr
CheckURLStr = Left(NewsLinkStr,3)
If Left(NewsLinkStr,1) = "/" Then
URLSearchLoc = InStr(ObjUrl,"http://") + 2
FormatUrl = Left(ObjUrl,InStr(URLSearchLoc,ObjUrl,"/") - 1)
FormatUrl = FormatUrl & NewsLinkStr
ElseIf CheckURLStr = "../" Then
Do While Not CheckURLStr <> "../"
CheckObjUrl = Mid(CheckObjUrl,4)
If Right(TempCollectObjUrl,1) = "/" Then TempCollectObjUrl = Left(TempCollectObjUrl,Len(TempCollectObjUrl) - 1)
TempCollectObjUrl = Left(TempCollectObjUrl,InStrRev(TempCollectObjUrl,"/"))
CheckURLStr = Left(CheckObjUrl,3)
Loop
FormatUrl = TempCollectObjUrl & CheckObjUrl
Else
FormatUrl = TempCollectObjUrl & NewsLinkStr
End If
Else
FormatUrl = NewsLinkStr
End If
End Function
Function ReplaceContentStr(ContentStr)
Dim TempContentStr
TempContentStr = ContentStr
If RuleDataBox(14,0) = 1 Then
TempContentStr = LoseHtml(TempContentStr)
Else
TempContentStr = LoseNoteTag(TempContentStr)
If RuleDataBox(15,0) = 1 Then TempContentStr = LoseStyleTag(TempContentStr)
If RuleDataBox(16,0) = 1 Then TempContentStr = LoseDivTag(TempContentStr)
If RuleDataBox(17,0) = 1 Then TempContentStr = LoseATag(TempContentStr)
If RuleDataBox(18,0) = 1 Then TempContentStr = LoseFontTag(TempContentStr)
If RuleDataBox(19,0) = 1 Then TempContentStr = LoseSpanTag(TempContentStr)
If RuleDataBox(20,0) = 1 Then TempContentStr = LoseObjectTag(TempContentStr)
If RuleDataBox(21,0) = 1 Then TempContentStr = LoseIFrameTag(TempContentStr)
If RuleDataBox(22,0) = 1 Then TempContentStr = LoseScriptTag(TempContentStr)
If RuleDataBox(23,0) = 1 Then TempContentStr = LoseClassTag(TempContentStr)
TempContentStr = LoseTableTag(TempContentStr)
TempContentStr = LoseTDTag(TempContentStr)
TempContentStr = LoseTRTag(TempContentStr)
End If
ReplaceContentStr = TempContentStr
End Function
Function CNReplaceContentStr(ContentStr)
Dim TempContentStr
TempContentStr = ContentStr
If CNRuleDataBox(14,0) = 1 Then
TempContentStr = LoseHtml(TempContentStr)
Else
TempContentStr = LoseNoteTag(TempContentStr)
If CNRuleDataBox(15,0) = 1 Then TempContentStr = LoseStyleTag(TempContentStr)
If CNRuleDataBox(16,0) = 1 Then TempContentStr = LoseDivTag(TempContentStr)
If CNRuleDataBox(17,0) = 1 Then TempContentStr = LoseATag(TempContentStr)
If CNRuleDataBox(18,0) = 1 Then TempContentStr = LoseFontTag(TempContentStr)
If CNRuleDataBox(19,0) = 1 Then TempContentStr = LoseSpanTag(TempContentStr)
If CNRuleDataBox(20,0) = 1 Then TempContentStr = LoseObjectTag(TempContentStr)
If CNRuleDataBox(21,0) = 1 Then TempContentStr = LoseIFrameTag(TempContentStr)
If CNRuleDataBox(22,0) = 1 Then TempContentStr = LoseScriptTag(TempContentStr)
If CNRuleDataBox(23,0) = 1 Then TempContentStr = LoseClassTag(TempContentStr)
TempContentStr = LoseTableTag(TempContentStr)
TempContentStr = LoseTDTag(TempContentStr)
TempContentStr = LoseTRTag(TempContentStr)
End If
CNReplaceContentStr = TempContentStr
End Function
Function LoseHtml(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<\/*[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
Set RegEx = Nothing
LoseHtml = ClsTempLoseStr
End function
Function LoseClassTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(class=){1,}(""|\'){0,1}\S+(""|\'|>|\s){0,1}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseClassTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseScriptTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(<script){1,}[^<>]*>[^\0]*(<\/script>){1,}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseScriptTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseIFrameTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(<iframe){1,}[^<>]*>[^\0]*(<\/iframe>){1,}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseIFrameTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseObjectTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(<object){1,}[^<>]*>[^\0]*(<\/object>){1,}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseObjectTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseSpanTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}span[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseSpanTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseFontTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}font[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseFontTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseATag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}a[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseATag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseDivTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}div[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseDivTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseStyleTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "(<style){1,}[^<>]*>[^\0]*(<\/style>){1,}"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseStyleTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseNoteTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<!--\/*[^<>]*-->"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseNoteTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseTableTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}table[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseTableTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseTDTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}td[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseTDTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
Function LoseTRTag(ContentStr)
Dim ClsTempLoseStr,RegEx
ClsTempLoseStr = Cstr(ContentStr)
Set RegEx = New RegExp
RegEx.Pattern = "<(\/){0,1}tr[^<>]*>"
RegEx.IgnoreCase = True
RegEx.Global = True
ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
LoseTRTag = ClsTempLoseStr
Set RegEx = Nothing
End Function
%>
相關文章
常用ASP函數(shù)集【經(jīng)驗才是最重要的】...2007-01-01![簡單的ASP中經(jīng)常用到的代碼[推薦]](http://img.jbzj.com/images/xgimg/bcimg1.png)
簡單的ASP中經(jīng)常用到的代碼[推薦]...2007-03-03
再發(fā)幾個ASP不錯的函數(shù)...2007-08-08
asp下實現(xiàn)IP限制函數(shù)代碼...2007-11-11
Asp Conn.execute的參數(shù)與返回值總結
這篇文章主要介紹了Asp Conn.execute的參數(shù)與返回值總結,數(shù)據(jù)庫對象的execute方法參數(shù)與返回值總結,需要的朋友可以參考下2014-07-07
ASP智能搜索的實現(xiàn)...2006-08-08
推薦4款傻瓜型的ASP服務器軟件（asp運行環(huán)境一鍵搭建工具）
雖然現(xiàn)在各種語言大行其道，但是asp的成熟性以及易用性還是有很大的客戶量存在，要運行ASP程序，必須安裝調(diào)試ASP的環(huán)境，而IIS對于普通用戶來說，安裝起來還是有一定的難度的，這里我來推薦幾款傻瓜型的ASP服務器軟件，比較適合初級站長。2014-08-08
asp下實現(xiàn)代碼的“運行代碼”“復制代碼”“保存代碼”功能源碼
asp下實現(xiàn)代碼的“運行代碼”“復制代碼”“保存代碼”功能源碼...2007-06-06
利用ASP實現(xiàn)事務處理的方法...2007-03-03
這篇文章主要介紹了ASP正則表達式清除HTML指定標簽的方法，告訴大家如何精準的過濾掉某些特定的屬性標簽和參數(shù)，感興趣的小伙伴們可以參考一下2015-09-09