关键字密度查询工具我在网上找了很久，还是没找到一个合适的关键字密度查询工具，为什么呢？因为我的站是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="<metaNAME=DescriptionCONTENT=" whereHtmDesL=InStr(1, Str, htmDes,1) if whereHtmDesL>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="<metaNAME=keywordsCONTENT=" whereHtmDesL=InStr(1, Str, htmDes,1) if whereHtmDesL>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 LenStr<LenKW then msgbox "关键字居然比文章长！",64,"不作计算" exit sub end if MyWords.txt_OnlyText.value=OnlyText if LenKW<>0 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 ..:::关键字密度查询:::.. 请拷贝你的网页源文件到此 源码框 关键字 关键字密度查询结论框
