关键字排名(Keyword Ranking)

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=http://www.interclasse.com/pics/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

(0)

相关推荐

  • 关键字排名(Keyword Ranking)

    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 extens

  • Python查询阿里巴巴关键字排名的方法

    本文实例讲述了Python查询阿里巴巴关键字排名的方法.分享给大家供大家参考.具体如下: 这里使用python库urllib及pyquery基本东西的应用,实现阿里巴巴关键词排名的查询,其中涉及到urllib代理的设置,pyquery对html文档的解析 1. urllib 基础模块的应用,通过该类获取到url中的html文档信息,内部可以重写代理的获取方法 class ProxyScrapy(object): def __init__(self): self.proxy_robot = Pro

  • 提高关键字在百度里的排名的方法

    1. 处理关键字: 首先收集很多与你的网站或产品有关的关键字了.接下来的工作就是把收集到的关键字进行组合,把它们组成常用的词组或短语.很多人在搜索的时候会使用两个或三个字组成词.据统计,平均是2.3个字.不要用普通的,单个字作为关键字.这样的关键字很难排到搜索引擎的前十位.例如:你有以下几个关键字:"搜索引擎.软件.提高",试着把他们组合为"搜索引擎软件"."搜索引擎提高"等.把字组成关键字短语有利于提高你网站的排名,你将会更有效提高你网站访问量

  • 快速提高网站排名

    快速提高网站排名-关键字工具(Keyword Tool) Google AdWords Keyword Tool https://adwords.google.com/select/m...=KeywordSandbox OVERTURE Search Term Suggestion Tool http://inventory.overture.com/d/sea...tory/suggestion 快速提高网站排名-搜索引擎优化工具-网站优化工具,google排名优化 Google排名监测工具

  • 提高在google中排名的重点

    Google的排名运算法则主要使用了两个部分,第一个部分是它的文字内容匹配系统.Google使用该系统来发现与搜索者键入的搜索词相关的网页:第二部分也是排名运算法则中最最重要的部分,就是Google的专利网页级别技术. (title)中出现的关键字给予较高的权值,所以你应当确保在你网站的标题标签中包含了最重要的关键词,即应围绕你最重要的关键词来决定网页标题的内容.不过网页的标题不可过长,一般最好在35到40个字符之间. Google将从一个网页的头几行文字内容来生成对一个网站的描述.也就是说,你

  • PHP屏蔽过滤指定关键字的方法

    本文实例讲述了PHP屏蔽过滤指定关键字的方法.分享给大家供大家参考.具体分析如下: 实现思路: 一.把关键字专门写在一个文本文件里,每行一个,数量不限,有多少写多少. 二.PHP读取关键字文本,存入一个数组 三.遍历关键字数组,挨个用strpos函数去看看内容有没有关键字,如果有,返回true,没有则返回false PHP代码如下: 复制代码 代码如下: /* PHP中用strpos函数过滤关键字 */ // 关键字过滤函数 function keyWordCheck($content){ //

  • Java的关键字与保留字小结

    JAVA常用关键字及其用法简要说明 Abstract: 抽象的 一个Java语言中的关键字,用在类的声明中来指明一个类是不能被实例化的,但是可以被其它类继承.一个抽象类可以使用抽象方法,抽象方法不需要实现,但是需要在子类中被实现 break: 一个Java的关键字,用来改变程序执行流程,立刻从当前语句的下一句开始执行从.如果后面跟有一个标签,则从标签对应的地方开始执行 case: Java语言的关键字,用来定义一组分支选择,如果某个值和switch中给出的值一样,就会从该分支开始执行. catc

  • PHP中使用strpos函数实现屏蔽敏感关键字功能

    现在网络信息监管很严格,特别是屏蔽关键字.特别是现在WEB2.0时代,网站的内容几乎都是来自网民发布,站长管理即可.如果你希望别人在你站点禁止发布某个关键字,那么就需要预先做处理.用PHP做关键字屏蔽的功能样式有多种多样,如正则是最普遍的一种,这里就不一一例举,本文介绍使用PHP函数strpos屏蔽关键字的功能. 思路: 一.把关键字专门写在一个文本文件里,每行一个,数量不限,有多少写多少. 二.PHP读取关键字文本,存入一个数组 三.遍历关键字数组,挨个用strpos函数去看看内容有没有关键字

  • JAVA关键字及作用详解

    Java关键字及其作用 一. 总览: 访问控制 private protected public 类,方法和变量修饰符 abstract class extends final implements interface native new static strictfp synchronized transient volatile 程序控制 break continue return do while if else for instanceof switch case default 异常

  • JavaScript保留关键字汇总

    JavaScript 标准 所有的现代浏览器已经完全支持 ES5(ECMAScript 5). JavaScript 保留关键字(keyword) Javascript 的保留关键字(标识符)不可以用作变量.标签或者函数名.有些保留关键字是作为 Javascript 以后扩展使用. abstract arguments boolean break byte case catch char class* const continue debugger default delete do doubl

随机推荐