关键字排名(Keyword Ranking)_hta

Real-time ranking of keywords entered on search engines
Monitors all queries and lists last queries and top 10

File Name : keywordranking.hta
Requirement : IE6
Author : Jean-Luc Antoine
Submitted : 09/12/2003
Category : HTA
Remember : The file extension has to be *.HTA

将下面的代码保存为keyword.hta即可。保存时注意编码，推荐用utf8格式。

复制代码 代码如下:

<html><head>
<title>Keyword Ranking, (c) Jean-Luc Antoine</title>
<HTA:APPLICATION APPLICATIONNAME="Search Engine Tools"
 BORDER="thick" BORDERSTYLE="normal"
 CAPTION="yes" CONTEXTMENU="yes"
 INNERBORDER="yes" MAXIMIZEBUTTON="yes" MINIMIZEBUTTON="yes"
 NAVIGABLE="no" SCROLL="yes" SCROLLFLAT="no"
 SELECTION="yes" SHOWINTASKBAR="yes" SINGLEINSTANCE="no"
 SYSMENU="yes" VERSION="0.3" WINDOWSTATE="normal">
<script language=vbscript>
Option Explicit
' Versions :
'  v0.3 Queries and words : simultaneously ranking
'  v0.2 New look, options, many SE
'   Multilingual system
'  v0.1 First draft, keyword rank and last queries
'Todo :
' Gérer systématiquement à la fois Keyword et Phrase
' Sur les keyword, permettre de zoomer (showmodeless) sur les phrases contenant le keyword pour connaître le ranking des variations
' Lister en permanence les mots-clefs monitorés avec leur occurence et permettre le même zoom
' Mettre en gras les keywords monitorés
' Temps de mesure
' Afficher pourcentage en plus du nb d'occurences
' Monitorer X mots-clefs et leur apparition/fréquence relative
' Faire bouton de refresh manuel si ça se bloque (location.reload())
' gérer les fenêtres lancées offline et non pas inline (intercepter events par showmodeless dialog)
' identifier nb de pages retournées par requete et indice de concurrence
' Permettre de sauver le résultat
' http://wordtracker.com/newsinput.txt

Const C_MaxList=20 '### Change this, predefined for TOP 20
Dim d,dw,a(),b(),f(),g(),i
Redim a(C_MaxList)
Redim b(C_MaxList)
For i=0 to C_MaxList-1
 a(i)=0 'Nb d'occurences
 b(i)="" 'Value
Next
Redim f(C_MaxList)
Redim g(C_MaxList)
For i=0 to C_MaxList-1
 f(i)=0 'Nb d'occurences
 g(i)="" 'Value
Next
Set d=CreateObject("Scripting.Dictionary") 'queries
d.CompareMode=1 'vbTextCompare
Set dw=CreateObject("Scripting.Dictionary") 'words
dw.CompareMode=1 'vbTextCompare

sub go(SE)
 Dim s,x,sq,s2,sw
 Select Case SE
 Case 0
  s=RegExpTest("pursuit\?query=.*?&", lycosfr.document.body.innerHTML,15)
 Case 1
  s=RegExpTest("pursuit\?query=.*?&", lycosde.document.body.innerHTML,15)
 Case 2
  s=RegExpTest("[^a-z]q=.*?&", fireballde.document.body.innerHTML,4)
 Case 3
  s=RegExpTest("\?qkw=.*?""", metacrawler.document.body.innerHTML,6)
 Case 4
  s=RegExpTest("return.cool\?query=.*?""", kanoodle.document.body.innerHTML,19)
 Case 5
  s=RegExpTest("/w.galaxy.com/b/q\?k.*?""", galaxy.document.body.innerHTML,21)
 Case Else
  msgbox "Unknown S.E. : " & SE
 End Select
 s="<pre>" & s & "</pre>"

 sq=""
 For x=0 to C_MaxList-1
  If a(x)>0 Then sq="<tr style='background-color:#eeeeee;'><td>" & a(x) & "</td><td>" & b(x) & "</td></tr>" & sq
 Next
 sq="<table style='border:1px solid #222222;'><tr style='background-color:#dddddd;'><th>Total</th><th>" & Disp(5) & "</th></tr>" & sq & "</table>"

 sw=""
 For x=0 to C_MaxList-1
  If f(x)>0 Then sw="<tr style='background-color:#eeeeee;'><td>" & f(x) & "</td><td>" & g(x) & "</td></tr>" & sw
 Next
 sw="<table style='border:1px solid #222222;'><tr style='background-color:#dddddd;'><th>Total</th><th>" & Disp(9) & "</th></tr>" & sw & "</table>"

 s2="<b>" & Disp(7) & " :</b> " & d.Count & "<br>"
 s2=s2 & "<table><tr><td valign=top>"
 s2=s2 & "<b>Top " & C_MaxList & " - " & Disp(5) & "</b><br>" & sq & "</td><td valign=top>"
 s2=s2 & "<b>Top " & C_MaxList & " - " & Disp(9) & "</b><br>" & sw & "</td><td valign=top>"
 s2=s2 & "   <b>" & Disp(6) & " :</b>" & s
 s2=s2 & "</td></tr></table>"
 MaListe.InnerHTML=s2
End Sub

Function RegExpTest(patrn, strng, Pos)
 Dim RetStr,regEx, regExw, Match,Matchw,Matches,Matchesw,Matchesws,k,i,j,x,s,w
 Set regEx=New RegExp
 Set regExw=New RegExp
 regEx.Pattern=patrn
 regExw.Pattern="\w+"
 regEx.IgnoreCase=True   ' Set case insensitivity.
 regExw.IgnoreCase=True
 regEx.Global=True   ' Set global applicability.
 regExw.Global=True
 Set Matches=regEx.Execute(strng)   ' Execute search.
 RetStr=""
 For Each Match in Matches
  s=Mid(Match.Value,Pos)
  s=Left(s,Len(s)-1)
  s=Replace(s,"+"," ")
  s=Replace(s,"%20"," ")
  s=trim(s)
  If s<>"" Then
   s=Replace(s,"%21","!"):s=Replace(s,"%22",chr(34))
   s=Replace(s,"%23","#"): s=Replace(s,"%25","%")
   s=Replace(s,"%26","&"):s=Replace(s,"%27","'")
   s=Replace(s,"%28","("):s=Replace(s,"%29",")")
   s=Replace(s,"%2A","*"):s=Replace(s,"%2B","+")
   s=Replace(s,"%2C",","):s=Replace(s,"%2F","/")
   s=Replace(s,"%3A",":")
   s=Replace(s,"%3D","=")
   s=Replace(s,"%3F","?")
   s=Replace(s,"%40","@"):s=Replace(s,"%B4","´")
   s=Replace(s,"%C4","Ä"):s=Replace(s,"%D6","Ö")
   s=Replace(s,"%DC","Ü"):s=Replace(s,"%DF","ß")
   s=Replace(s,"%E0","à"):s=Replace(s,"%E2","â")
   s=Replace(s,"%E4","ä"):s=Replace(s,"%E7","ç")
   s=Replace(s,"%E8","è"):s=Replace(s,"%E9","é")
   s=Replace(s,"%EA","ê"):s=Replace(s,"%EB","ë")
   s=Replace(s,"%F6","ö")
   s=Replace(s,"%F9","ù"):s=Replace(s,"%FC","ü")
   s=Replace(s,"<","<"):s=Replace(s,">",">")
   If d.Exists(s) Then
    k=d.Item(s)+1
    d.Item(s)=k
    i=-1 'If more than the first value, insert it
    do while (a(i+1)<k) and (i<C_MaxList-1)
     i=i+1
    loop
    if i>=0 Then 'i=where to be inserted
     x=0
     For j=0 to C_MaxList-1
      If ucase(b(j))=ucase(s) Then
       x=j
       Exit For
      End If
     Next
     For j=x+1 to i
      a(j-1)=a(j)
      b(j-1)=b(j)
     Next
     a(i)=k
     b(i)=s
    End If
   Else
    d.Add s,1
   End If
   RetStr=RetStr & d.Item(s) & "-" & s & vbCRLF

   'Extract Words
   Set Matchesw=regExw.Execute(s)
   For Each Matchw in Matchesw
    w=Matchw.Value
    If Len(w)>2 Then
     If dw.Exists(w) Then
      k=dw.Item(w)+1
      dw.Item(w)=k
      i=-1 'If more than the first value, insert it
      do while (f(i+1)<k) and (i<C_MaxList-1)
       i=i+1
      loop
      if i>=0 Then 'i=where to be inserted
       x=0
       For j=0 to C_MaxList-1
        If ucase(g(j))=ucase(w) Then
         x=j
         Exit For
        End If
       Next
       For j=x+1 to i
        f(j-1)=f(j)
        g(j-1)=g(j)
       Next
       f(i)=k
       g(i)=w
      End If
     Else
      dw.Add w,1
     End If
    End If
   Next
  End If
 Next
 RegExpTest=RetStr
End Function

 

</script>
<script for=window event=onload>
 DoLoad
</script>
<xscript for=window event=onbeforeunload>
  'DoSave
</xscript>
<script>
Sub DoSave
  foo.setAttribute "content", foo.innerHTML
  foo.save "EditContent"
End Sub
sub DoLoad
  foo.load "EditContent"
  content = foo.getAttribute("content")
  if content<>"" Then foo.innerHTML=content
End Sub
Sub DoClear
  foo.innerHTML = ""
End Sub

Function Disp(x)
 Select case getlocale
 Case 1036,2060,3084,5132,4108 'French
 Select Case x
 Case 0 'sous-titre
  Disp="Outil d'analyse de requêtes - 1 backlink svp !"
 Case 1
  Disp="Votre liste de mots à monitorer :"
 Case 2
  Disp="Sauve"
 Case 3
  Disp="R.A.Z"
 Case 4
  Disp="Charge"
 Case 5
  Disp="requêtes"
 Case 6
  Disp="Dernières requêtes"
 Case 7
  Disp="Nb de requêtes lues"
 Case 8
  Disp="Cliquez dans le menu pour activer l'analyse d'un moteur."_
   & " Recliquez pour la désactiver."
 Case 9
  Disp="Mots"
 Case Else
  Disp="###"
 End Select
 Case Else
 Select Case x
 Case 0 'sub title
  Disp="A linkware search engine analysis tool"
 Case 1
  Disp="Your keywords to monitor :"
 Case 2
  Disp="Save"
 Case 3
  Disp="Clear"
 Case 4
  Disp="Load"
 Case 5
  Disp="Queries"
 Case 6
  Disp="Last queries"
 Case 7
  Disp="Amount of scanned queries"
 Case 8
  Disp="Click above to start the queries analyzis on a specific search engine."_
   & " Click again to stop it."
 Case 9
  Disp="Words"
 Case Else
  Disp="###"
 End Select
 End Select
End Function
Sub DispSE(x)
 Select Case x
 Case 0
  if lycosfr.location="about:blank" Then
   lycosfr.location="http://www.recherche.lycos.fr/voyeur"
  Else
   lycosfr.location="about:blank"
  End If
 Case 1
  if lycosde.location="about:blank" Then
   lycosde.location="http://www.lycos.de/inc/content/suche/"_
    & "includes/livesuche_iframe.htm?ergebnisse=&refresh="
  Else
   lycosde.location="about:blank"
  End If
 Case 2
  if fireballde.location="about:blank" Then
   fireballde.location="http://www.fireball.de/livesuche.csp"
  Else
   fireballde.location="about:blank"
  End If
 Case 3
  if metacrawler.location="about:blank" Then
   metacrawler.location="http://www.metaspy.com/info.metac.spy/metaspy/unfiltered.htm"
  Else
   metacrawler.location="about:blank"
  End If
 Case 4
  if kanoodle.location="about:blank" Then
   kanoodle.location="http://www.kanoodle.com/spy/spy.cool"
  Else
   kanoodle.location="about:blank"
  End If
 Case 5
  if galaxy.location="about:blank" Then
   galaxy.location="http://watch.galaxy.com/b/watch?filter"
  Else
   galaxy.location="about:blank"
  End If
 Case Else
  Msgbox "DispSE : not found - " & x
 End Select
End Sub

</script>
<style>
body,td,th,p{font-size: 11px;font-family: Tahoma,Arial;}
.topmenu{
 border:1px solid #222222;
 background-color:#eeeeee;
}
.topmenu a{
 height:15px;
 background-color:#BDDCBD;
 padding-top:1px;
 padding-left:5px;
 padding-right:5px;
 text-decoration:none;
 color:black;
 text-align:center;
 display:block;
}
.topmenu a:hover, .topmenu a:active{
background-color:#89DB89;color:black;
}
#rb{border-right:1px solid #222222;}
A {color:#AAFFCC}
BUTTON {font-size: 7pt;cursor:hand;}
.userData {behavior:url(#default#userdata);}
</style>

</head>

<body bgcolor=white text=black style="margin:2">
<a href=http://www.interclasse.com/scripts/keywordranking.php>
<img src=yun_qi_img/avatar.gif align=left border=0></a>

<H1 style="margin-bottom: 0px;">Keyword Ranking</H1><Script>document.write Disp(0)</Script>

<table class=topmenu border="0" cellpadding="0" cellspacing="0"><tr>
<td width=60 id=rb> </td>
<td id=rb width=80><a href="#" onClick='options.style.display="block"'>Options</a></td>
<td id=rb width=80><a href="#" Title="French" onclick="DispSE 0">Lycos.fr</a></td>
<td id=rb width=80><a href="#" Title="Deutsch" onclick="DispSE 1">Lycos.de</a></td>
<td id=rb width=80><a href="#" Title="Deutsch" onclick="DispSE 2">firball.de</a></td>
<td id=rb width=80><a href="#" Title="MetaSpy" onclick="DispSE 3">MetaCrawler</a></td>
<td id=rb width=80><a href="#" onclick="DispSE 4">Kanoodle</a></td>
<td id=rb width=80><a href="#" onclick="DispSE 5">Galaxy</a></td>
<td width=60> </td>
</tr></table>
<script>document.write Disp(8)</script><br>

<div id=options style="display:none;width:180;border:1px dashed #222222;background-color:#D0D0D0">
<script>document.write Disp(1)</script>
<div id=foo class=userData contentEditable=true style="margin=4;width:170;height:14;border:1px solid;background-color:white"></div>
 <button onClick='DoSave()'><script>document.write Disp(2)</script></button>
 <button onClick='DoClear()'><script>document.write Disp(3)</script></button>
 <button onClick='DoLoad()'><script>document.write Disp(4)</script></button>
  <button onClick='options.style.display="none"'>ok</button>
</div>

<div ID=MaListe></div>

<table width=100%><tr><td>
<iframe id=lycosfr height=200 src="about:blank" onload="go 0" width=100%></iframe>
<iframe id=fireballde height=200 src="about:blank" onload="go 2" width=100%></iframe>
<iframe id=kanoodle height=200 src="about:blank" onload="go 4" width=100%></iframe>
</td><td>
<iframe id=lycosde height=200 src="#" onload="go 1" width=100%></iframe>
<iframe id=metacrawler height=200 src="about:blank" onload="go 3" width=100%></iframe>
<iframe id=galaxy height=200 src="about:blank" onload="go 5" width=100%></iframe>
</td></tr></table>

</body>
</html>

原文：http://www.interclasse.com/scripts/keywordranking.php

时间： 2024-11-13 08:59:43

关键字排名(Keyword Ranking)_hta的相关文章

浅谈决定关键字排名的几大因素

对于一个网站来说,决定关键字排名的因素有很多,也许你也看到很多这方面的文章,有说空间的,有说链接形式的,也有说外链的.笔者研究网站也才一年多,虽然是个菜鸟,但也不想去人云亦云,太高深的知识我不懂,也没有去亲自试验过.今天我讲的几点决定关键字排名的几大因素,都是结合自己的亲身体会的,希望对seo初学者有用,不对的地方也希望老鸟批评指正! 1.内容更新对关键字排名的影响 结合我的亲身体验,对于"内容为王,外链为皇"这句话本人还是相当信服的.我的小站在七月份的时候打理得很不错,每天坚持更新,

关键字排名变化分析看百度新算法

近期优化的一个关键字排名在3月下旬开始出现了大幅调整,这个变化也直接把自己维护关键字网站稳定了半年的排名给干掉了.但是最近发现排名有点怪,这个关键字百度首页前两页排名网站被重新洗牌了,而我的站只是其中被降权的一部分.就此我通过"现货黄金"这个关键字现象,对现在百度算法调整进行一个分析,提高认识 百度自身的产品的占据的排名我们就不去分析了,长期在首页占据三个页面!下面看下除百度外的排名变化:百度合作公司网站排名提升:第一个是合作网站:从目前首页的关键字排名看,有3个页面出自其合作财经合作

浅谈百度关键字排名大幅度下滑的原因

网站优化是一个需要时间的工作,需要不断的磨练才能见到彩虹,但是在见到彩虹之后,如何能让彩虹更长时间的展现.面对目前百度的不断调整,任何一个网站优化人员都不能保证自己做的关键字常年稳居在百度首页的某个位置,关键字下滑之后seoer需要调整心态继续坚持,找出关键字下滑的原因.接下来本人就说下自己网站近期关键字排名下滑的原因. 一.网站内容更新 在网站内容更新方面,由于本人的网站基本上就是一个纯静态的单页面,网站内部链接架构不太好,搜索引擎一般很难收录自己站点的信息,所以本人有很长一段时间没有去更新站

从六方面剖析竞争对手网站关键字排名

优化一个关键字百度排名的很久,排名没稳定就习惯分析别人.现在发现一个站近期一直比我优化的站好.能够经常出现在百度第一页.于是我对这个竞争对手的站进行了我的分析,希望从对它的分析中能够对自己站的排名有有效的帮助.和信主要从以下六个方面分析了竞争对手排名 第一:网站域名历史 有一种说法,网站的域名时间越久在权重排名算法中就会有一定优势,这点去年博百优大赛时有个域名就备受关注.所以这里我也先从这个入手.通过查询该站的域名和建站时间和我优化的站时间都是09年.所以这个网站的建站历史排除 第二:网站内容更

外链优化做到极致关键字排名也能进首页

这几天关注了一个网站,一个关键字排名首页的网站有5个网站,除了一个官方网站外,至少有2个网站是同一个人经营的,因为优化的手法一样,关键点是有些软文带着这2个网站的链接.所以可以肯定的就是同一个人优化的.高手通过强大的外链,实现关键字进百度首页的目标.那么什么是高质量的外链,通过分析下面高手网站优化的外链,可以得到一些启发! 下面是该关键字的竞争度截图,显示的是"高难度",百度指数2000左右,并且有15个竞价网站,第一个网站会吸引4成的流量,剩下的流量仍然有很多网站竞争.就是因为这是精

分析百度关键字排名变动 让排名飞一会

近期对百度算法调整的观察,分析和总结做了不少工作.根据自己的总结和参考了很多朋友的建议,对现在百度的算法调整导致的关键字排名变动,很淡然了.这里分享一下. 第一:算法调整有针对性 自百度对以左旋哥站群为代表站群算法洗牌,导致很多朋友对百度算法一直有一种心理上的暗示.从我优化的几个站的主要关键字排名近期的变化上,发现百度没拿我们太当回事.在K过站群和链轮时,有两个站的排名有过激烈的波动,但是基本都维持在前两页.所以如果网站本身建设上没有作弊优化的话,排名变化也是相对稳定的. 第二:注重返回结果的质

草根浅谈如何稳定网站关键字排名

俗话说打江山难守江山更难,网站关键字排名上去了,如何才可以让其稳定呢?这是众多优化人员非常关心的问题,稳定的关键字排名才能为网站带来流量,而有了流量网站才能更好的盈利.为了让草根站长们守住江山,本人结合自己做优化的一些知识,为大家说下如果稳定网站关键字排名. 一.稳定安全的空间 拥有一个稳定安全的空间是稳定网站关键字的基本条件,如果空间不稳定,经常无法正常访问,那么网站关键字排名将会直线下滑;另外,如果空间安全性不高的话,网站经常被别人攻击或者被挂了大量的黑链接,以致搜索引擎蜘蛛无法正常浏览你的

SEOER如何提高网站关键字排名

seoer每天对着电脑早上查看排名升了欣喜万分掉了一天心情都不好,关键字排名有时候着实让人头大,尤其是百度最近大范围的降低收录量,大幅度削减网站外联着实让很多朋友心痛,比如有时候一天来回浮动好几次,什么样的操作方法有利于网站优化提高网站关键字排名呢?我在这里根据自己的操作经验为大家一一道来. 第一,关键字.关键字好比文章的大脑我们在优化的时候选择好关键字后就要对其进行重点关照了,包括整个网站都要围绕关键字而展开,每个页面都要详细的做好主关键字,辅助关键字以及长尾关键字的布局,这个很重要.长尾关键

实例分析短时间上升关键字排名技巧

百度在8月的一次大更新让很多站长看到外链是越来越难做了,到底如何才能够让排名上去,让快照更新正常呢,真的很让人头疼,最近在负责买酒网,给的任务是在月底让关键字排名上百度首页前五名,而最近一段时间这个网站被百度给K了,而且目前是快照更新不正常,停留在9月初.在短短的十几天时间内把排名搞到首页的确是有点困难,但是作为一名SEOer人员,如果把主管把这个网站给你了,让你去负责,让你去提高排名,这就是工作,这就是任务,没有一点压力的话是不可能的,我们必须根据网站的自身情况去分析,采取一定的有效措施来做最