关键字密度查询工具我在网上找了很久，还是没找到一个合适的关键字密度查询工具，为什么呢？因为我的站是utf-8编码的，而网上提供的大部分是GB2312的。还是继续找关键字密度查询工具，结果找到一个，不过不是通过输入网址的，而是自己要把代码拷过去的。这样的关键字密度查询工具虽然用起来不是很方面，但我一时也没找到比较好的关键字密度查询工具。如果你找到了，一定要联系我。要求：只要你找的关键字密度查询工具支持UTF-8编码就可以了。
Sub ClearB_OnClick
MyWords.txt_Info.value=""
MyWords.txt_OnlyText.value=""
MyWords.txt_Info.focus()
end sub
Sub ChkB_OnClick
strKW=MyWords.MyKeyword.value
str=replace(MyWords.txt_Info.value," ","")
str=replace(str," ","")
str=replace(str,">","")
str=replace(str,"<","")
str=replace(str,chr(9),"")
str=replace(str,chr(10),"")
str=replace(str,chr(13),"")
str=replace(str,chr(34),"")
str=str&"<" & "script"&"><"& "/script" & ">"
htmDes="
0 then
LenDes=len(htmDes)
whereHtmDesL=whereHtmDesL+LenDes
whereHtmDesR=InStr(whereHtmDesL, Str, ">",1)
MyHtmDes=mid(Str,whereHtmDesL,whereHtmDesR-whereHtmDesL)
str=MyHtmDes&str
end if
htmDes="0 then
LenDes=len(htmDes)
whereHtmDesL=whereHtmDesL+LenDes
whereHtmDesR=InStr(whereHtmDesL, Str, ">",1)
MyHtmDes=mid(Str,whereHtmDesL,whereHtmDesR-whereHtmDesL)
str=MyHtmDes&str
end if
LenStr=len(str)
'msgbox "LenStr="&LenStr
If InStr(1, Str, "<" & "script",1) > 0 And InStr(1, Str, "<" & "/script" & ">",1) > 0 Then
OnlyText = ""
i = 1
Do Until i > LenStr
tmpStrL = InStr(i , Str, "<" & "script", 1)
'MsgBox "tmpStrL="&tmpStrL
If tmpStrL > 0 Then
tmpStrR = InStr(tmpStrL, Str, "<" & "/script" & ">",1)
'MsgBox "tmpStrR="&tmpStrR
If tmpStrR = 0 Then tmpStrR = LenStr
'MsgBox "i="&i
OnlyText = OnlyText & Mid(Str, i, tmpStrL-i)
'MsgBox Mid(Str, i, tmpStrL-i)
i = tmpStrR + 9
Else
i = i + 1
End If
Loop
Str = OnlyText
End If
Str =Str&"<%"
OnlyText = ""
i = 1
Do Until i > LenStr
tmpStrL = InStr(i, Str, "<%", 1)
'MsgBox "tmpStrL=" & tmpStrL
If tmpStrL > 0 Then
tmpStrR = InStr(tmpStrL, Str, "%>", 1)
'MsgBox "tmpStrR=" & tmpStrR
If tmpStrR = 0 Then tmpStrR = LenStr
'MsgBox "i=" & i
OnlyText = OnlyText & Mid(Str, i, tmpStrL - i)
'MsgBox Mid(Str, i, tmpStrL - i)
i = tmpStrR + 2
Else
i = i + 1
End If
Loop
Str = OnlyText
Str =Str&"<"
OnlyText = ""
i = 1
Do Until i > LenStr
tmpStrL = InStr(i, Str, "<", 1)
'MsgBox "tmpStrL=" & tmpStrL
If tmpStrL > 0 Then
tmpStrR = InStr(tmpStrL, Str, ">", 1)
'MsgBox "tmpStrR=" & tmpStrR
If tmpStrR = 0 Then tmpStrR = LenStr
'MsgBox "i=" & i
OnlyText = OnlyText & Mid(Str, i, tmpStrL - i)
'MsgBox Mid(Str, i, tmpStrL - i)
i = tmpStrR + 1
Else
i = i + 1
End If
Loop
Str = OnlyText
LenStr=len(str)
LenKW=len(replace(strKW," ",""))
if LenStr0 then
KeywordTimes=0
i=1
do until i> LenStr
tmpStr=instr(i,str,strKW,1)
if tmpStr>0 then
KeywordTimes=KeywordTimes+1
i=tmpStr+1
else
i=i+1
end if
loop
strlenKW=int(KeywordTimes*LenKW*1000/LenStr+0.5)/10
fmlenKW=cstr(strlenKW)
if left(fmlenKW,1)="." then fmlenKW= "0" & fmlenKW
msgbox "有"& LenStr& "个字符，关键字出现"&KeywordTimes&"次，关键字密度为" & strlenKW & "%。" ,64,"11-1.cn 字符计算"
else
msgbox "有"& LenStr& "个字符" ,64,"LoveSEO.com字符计算"
end if
MyWords.txt_Info.focus()
end sub
