Keyword rankings (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

Save the following code as Keyword.hta. Note encoding when saving, recommended in UTF8 format.

Copy Code code as follows:

<title>keyword ranking, (c) Jean-luc antoine</title>
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-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 V Ariations
' 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 to 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 the 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", "O")
S=replace (S, "%DC", "U"): S=replace (S, "%df", "ß")
S=replace (S, "%e0", "à"): S=replace (S, "%e2", "â")
S=replace (S, "%e4", "Ä"): S=replace (S, "%e7", "C")
S=replace (S, "%e8", "è"): S=replace (S, "%e9", "é")
S=replace (S, "%ea", "Ê"): S=replace (S, "%eb", "E")
S=replace (S, "%f6", "O")
S=replace (S, "%F9", "Ù"): S=replace (S, "%FC", "U")
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, 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, 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>

<body bgcolor=white text=black style= "Margin:2" >
<a href=http://www.interclasse.com/scripts/keywordranking.php>
</a>

<table class=topmenu border= "0" cellpadding= "0" cellspacing= "0" ><tr>
&LT;TD width=60 id=rb> </td>
&LT;TD id=rb width=80><a href= "#" onclick= ' options.style.display= ' "block" ' >Options</a></td>
&LT;TD id=rb width=80><a href= "#" title= "French" onclick= "Dispse 0" >Lycos.fr</a></td>
&LT;TD id=rb width=80><a href= "#" title= "Deutsch" onclick= "Dispse 1" >Lycos.de</a></td>
&LT;TD id=rb width=80><a href= "#" title= "Deutsch" onclick= "Dispse 2" >firball.de</a></td>
&LT;TD id=rb width=80><a href= "#" title= "Metaspy" onclick= "Dispse 3" >MetaCrawler</a></td>
&LT;TD id=rb width=80><a href= "#" onclick= "Dispse 4" >Kanoodle</a></td>
&LT;TD id=rb width=80><a href= "#" onclick= "Dispse 5" >Galaxy</a></td>
&LT;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>

Original: http://www.interclasse.com/scripts/keywordranking.php