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.3Queries and words : simultaneously ranking
'v0.2New look, options, many SE
'Multilingual system
'v0.1First 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><td>" & a(x) & "</td><td>" & b(x) & "</td></tr>" & sq
Next
sq="<table><tr><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><td>" & f(x) & "</td><td>" & g(x) & "</td></tr>" & sw
Next
sw="<table><tr><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>
<a href=http://www.interclasse.com/scripts/keywordranking.php>
<img src=http://www.interclasse.com/pics/avatar.gif align=left border=0></a>
<H1>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">Lycos.fr</a></td>
<td id=rb width=80><a href="#" Title="Deutsch">Lycos.de</a></td>
<td id=rb width=80><a href="#" Title="Deutsch">firball.de</a></td>
<td id=rb width=80><a href="#" Title="MetaSpy">MetaCrawler</a></td>
<td id=rb width=80><a href="#">Kanoodle</a></td>
<td id=rb width=80><a href="#">Galaxy</a></td>
<td width=60> </td>
</tr></table>
<script>document.write Disp(8)</script><br>
<div id=options>
<script>document.write Disp(1)</script>
<div id=foo class=userData contentEditable=true></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
【关键字排名(Keyword Ranking)】相关文章：