页面要害字密度查询原代码
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>页面要害字密度查询-站长工具-我爱3GP</title>
<meta content="页面要害字密度查询,站长工具,提供各类站长常用查询工具,包括ALEXA排名查询,GOOGLE PR查询,搜查引擎收录查询,要害词排名查询,要害词密度查询,HTML/JS代码互转,简繁转换。" />
<meta content="页面要害字密度查询,站长工具,查询工具,转换工具" />
<style type="text/css">
<!--
.biao {
background-position: center;
border: 2px solid #d4d4d4;
}
td {
color: #336699;
line-height: 150%;
font-size: 13px;
}
th {
color: #336699;
line-height: 150%;
font-size: 14px;
}
hr {
width: 98%;
border-top-style: dotted;
border-right-style: dotted;
border-bottom-style: dotted;
border-left-style: dotted;
color: #336699;
}
-->
</style>
</head>
<body leftMargin=0 topMargin=0 marginwidth="0">
<%
On Error Resume Next
Server.ScriptTimeOut=9999999
function getHTTPPage(Path)
t = GetBody(Path)
getHTTPPage=BytesToBstr(t,"GB2312")
End function
function GetBody(url)
on error resume next
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False, "", ""
.Send
GetBody = .ResponseBody
End With
Set Retrieval = Nothing
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 clearHTMLCode(originCode)
dim reg
set reg = new RegExp
reg.Pattern = "<[^>]*>"
reg.Global = true
clearHTMLCode = reg.Replace(originCode, "")
end function
function reallen(str)
dim l,t,c,i
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
next
reallen=t
end function
function CheckTheChar(TheChar,TheString)
'TheChar="要检测的字符串"
'TheString="待检测的字符串"
If inStr(TheString,TheChar) Then
For n =1 to Len(TheString)
If Mid(TheString,n,Len(TheChar))=TheChar Then
CheckTheChar=CheckTheChar+1
End if
Next
Else
CheckTheChar=0
End If
End function
function Checkin(s)
s=trim(s)
s=replace(s," ","")
s=replace(s," ","")
s=replace(s," ","")
s=replace(s,vbCrlf,"")
s=replace(s,chr(9),"")
Checkin=s
end function
url=request("domain")
key=checkin(request("keywords"))
if len(url)<10 then
url="http://www.5i3gp.cn"
end if
if len(key)<2 then
key="3gp"
end if
getsms=gethttppage(url)
getsms=lcase(checkin(clearhtmlcode(getsms)))
'response.write getsms
'response.end
pagelen=reallen(getsms)
keylen=reallen(key)
keynum=CheckTheChar(key,getsms)
keylentotal=keylen*keynum
keyper=Round((keylentotal/pagelen)*100,2)
%>
<br>
<table cellpadding="3" cellspacing="3">
<tr>
<th colspan="2">欢迎您利用本站的 要害词密度 查询工具<br />假设您觉得本站对您有协助，请收藏或许引荐给您的冤家。</th>
</tr>
<tr>
<td colspan="2"><hr /></td>
</tr>
<tr>
<td>
<table cellpadding="0" cellspacing="0">
<form action="pagekey.asp" method="post">
<tr>
<th>>>页面 要害字/要害词 密度 查询<<</th>
</tr>
<tr>
<td bgcolor="#6699cc"></td>
</tr>
<tr>
<td>页 面：<input onblur="if (value ==''){value='http://www.5i3gp.cn'}" onfocus="this.select()" size="35" value="<%=url%>"></td>
</tr>
<tr>
<td>要害词：<input onblur="if (value ==''){value='3gp'}" onfocus="this.select()" size="15" value="<%=key%>"> <input type="submit" value="查 询"> </td>
</tr>
<tr><td>注：字符长度按字节算，每个中文、半角符号占两字节，每个英文、全角符号占一字节;页面长度不包括空格、换行、制表符。<br /></td></tr>
</form>
</table>
</td>
<td>
<table cellpadding="0" cellspacing="0">
<tr>
<td>页面代码总长度：<%=pagelen%> 字节<br />
要害字符串长度：<%=keylen%> 字节<br />
要害字出现频率：<%=keynum%> 次<br />
要害字符总长度：<%=keylentotal%> 字节<br />
密度后果计算：<%=keyper%>%<br />
密度建议值：2%≦密度≦8%</td>
</tr>
</table>
</td>
</tr>
</table>
</body>
</html>
