Keyword rankings (Keyword ranking) _hta

Source: Internet
Author: User
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

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.