www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\inc\cls_keyword.asp

    <%
Dim cmWords
Set cmWords = new KeywordAnalyzer_Cls

Class KeywordAnalyzer_Cls
	Private m_intWordLength,m_blnKeyword,re
	Private m_strKeyword

	Private Sub Class_Initialize()
		m_intWordLength = 30
		m_blnKeyword = True
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
	End Sub

	Private Sub Class_Terminate()
		Set re=Nothing
		Set cmWords=Nothing
	End Sub

	Public Function ParseKeyword(ByVal strWord)
		Dim i,n,d,m_strLength
		Dim m_strWord,m_str,NoiseWords
		Dim m_arrKeyword,TempKeyword()
		strWord = Trim(strWord)
		m_strLength = Len(strWord)
		If m_strLength = 0 Then
			ParseKeyword = Array("")
			Exit Function
		End If
		strWord = Left(strWord,100)
		d = 0
		NoiseWords = ",-,.,about,1,2,3,4,5,6,7,8,9,0,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,after,all,also,an,and,another,any,are,as,at,be,because,been,before,being,between,both,but,by,came,can,come,could,did,do,each,for,from,get,got,had,has,have,he,her,here,him,himself,his,how,if,in,into,is,it,like,make,many,me,might,more,most,much,must,my,never,now,of,on,only,or,other,our,out,over,said,same,see,should,since,some,still,such,take,than,that,the,their,them,then,there,these,they,this,those,through,to,too,under,up,very,was,way,we,well,were,what,where,which,while,who,with,would,you,your,的,一,不,在,人,有,是,为,以,于,上,他,而,后,之,来,及,了,因,下,可,到,由,这,与,也,此,但,并,个,其,已,无,小,我,们,起,最,再,今,去,好,只,又,或,很,亦,某,把,那,你,乃,它,"
		For i = 1 To m_strLength
			If d = 0 Then
				m_str = Mid(strWord, i, 1)
				If CheckInputType(m_str,3) Then
					d = 1
					If CheckInputType(m_str,2) Then
						m_strWord = m_strWord & " "
					Else
						m_strWord = m_strWord & " " & m_str
					End If
				Else
					m_strWord = m_strWord & m_str
				End If
			Else
				m_str = Mid(strWord, i, 1)
				If CheckInputType(m_str,2) Then
					d = 0
					If CheckInputType(m_str,3) Then
						m_strWord = m_strWord & " "
					Else
						m_strWord = m_strWord & " " & m_str
					End If
				Else
					m_strWord = m_strWord & m_str
				End If
			End If
		Next
		m_arrKeyword = Split(m_strWord, " ")
		n = 0
		For i = 0 To UBound(m_arrKeyword)
			If InStr(NoiseWords,","& LCase(m_arrKeyword(i)) & ",") = 0 And m_arrKeyword(i) <> "" Then
				ReDim Preserve TempKeyword(n)
				TempKeyword(n) = m_arrKeyword(i)
				n = n + 1
			End If
		Next
		If n = 0 Then
			ReDim Preserve TempKeyword(0)
			TempKeyword(0) = ""
		End If
		'm_strWord = Join(TempKeyword, " ")
		ParseKeyword = TempKeyword
	End Function

	Public Function removeNoiseWord(strWord)
		Dim NoiseWords
		NoiseWords = Array(".","about","1","2","3","4","5","6","7","8","9","0","a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z","after","all","also","an","and","another","any","are","as","at","be","because","been","before","being","between","both","but","by","came","can","come","could","did","do","each","for","from","get","got","had","has","have","he","her","here","him","himself","his","how","if","in","into","is","it","like","make","many","me","might","more","most","much","must","my","never","now","of","on","only","or","other","our","out","over","said","same","see","should","since","some","still","such","take","than","that","the","their","them","then","there","these","they","this","those","through","to","too","under","up","very","was","way","we","well","were","what","where","which","while","who","with","would","you","your","的","一","不","在","人","有","是","为","以","于","上","他","而","后","之","来","及","了","因","下","可","到","由","这","与","也","此","但","并","个","其","已","无","小","我","们","起","最","再","今","去","好","只","又","或","很","亦","某","把","那","你","乃","它")
	End Function

	Public Function CheckKeyword(strWord)
		CheckKeyword = True
		If strWord = "" Then
			CheckKeyword = False
			Exit Function
		End If
		Dim FobWords,i
		FobWords = Array(91,92,304,305,430,431,437,438,12460,12461,12462,12463,12464,12465,12466,12467,12468,12469,12470,12471,12472,12473,12474,12475,12476,12477,12478,12479,12480,12481,12482,12483,12485,12486,12487,12488,12489,12490,12496,12497,12498,12499,12500,12501,12502,12503,12504,12505,12506,12507,12508,12509,12510,12532,12533,65339,65340)
		For i = 1 to Ubound(FobWords,1)
			If InStr(strWord,ChrW(FobWords(i))) > 0 Then
				CheckKeyword = False
				Exit Function
			End If
		Next
		FobWords = Array("~","!","@","#","$","%","^","&","*","(",")","-","+","=","`","[","]","{","}",";",":","""","'",",","<",">",".","/","\","|","?","_","about","1","2","3","4","5","6","7","8","9","0","a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z","after","all","also","an","and","another","any","are","as","at","be","because","been","before","being","between","both","but","by","came","can","come","could","did","do","each","for","from","get","got","had","has","have","he","her","here","him","himself","his","how","if","in","into","is","it","like","make","many","me","might","more","most","much","must","my","never","now","of","on","only","or","other","our","out","over","said","same","see","should","since","some","still","such","take","than","that","the","their","them","then","there","these","they","this","those","through","to","too","under","up","very","was","way","we","well","were","what","where","which","while","who","with","would","you","your","的","一","不","在","人","有","是","为","以","于","上","他","而","后","之","来","及","了","因","下","可","到","由","这","与","也","此","但","并","个","其","已","无","小","我","们","起","最","再","今","去","好","只","又","或","很","亦","某","把","那","你","乃","它")
		strWord = Left(strWord,100)
		'strWord = Replace(strWord,"[","")
		'strWord = Replace(strWord,"]","")
		strWord = Replace(strWord,"　"," ")
		strWord = Replace(strWord,"--"," ")
		strWord = Replace(strWord,"="," ")
		strWord = Replace(strWord,"'","''")
		strWord = Replace(strWord, Chr(0), "")
		For i = 0 To Ubound(FobWords,1)
			If strWord=FobWords(i) Then
				CheckKeyword = False
				Exit Function
			End If
		Next
	End Function

	Public Function CheckInputType(ByVal str,ByVal stype)
		CheckInputType = True
		If IsNull(str) Then Exit Function
		Select Case stype
			Case 0		'-- 数字
				re.Pattern="[^0-9]"
				CheckInputType = re.Test(str)
			Case 1		'-- 英文
				re.Pattern="[^A-Za-z]"
				CheckInputType = re.Test(str)
			Case 2		'-- 中文
				re.Pattern="[^\u4E00-\u9FA5]"
				CheckInputType = re.Test(str)
			Case 3		'-- 英文和数字
				re.Pattern="[^A-Za-z0-9-\.]"
				CheckInputType = re.Test(str)
			Case Else	'-- 双字节字符(包括汉字在内)
				re.Pattern="[^\x00-\xff]"
				're.Pattern="[^.*(\,.*;~`+~!)+$)]"
				CheckInputType = re.Test(str)
		End Select
	End Function

	Public Function Re_Replace(ByVal str,ByVal retxt,ByVal replacetxt)
		retxt = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(retxt, "[", "\["), "]", "\]"), "(", "\("), ")", "\)"), "$", "\$"), "^", "\^"), "{", "\{"), "}", "\}"), "+", "\+"), ".", "\.")
		re.Pattern = retxt
		re_Replace = re.Replace(str,replacetxt)
	End Function
End Class
%>