关键字排名(Keyword Ranking)_hta教程-查字典教程网
关键字排名(Keyword Ranking)
关键字排名(Keyword Ranking)
发布时间:2016-12-28 来源:查字典编辑
摘要:Real-timerankingofkeywordsenteredonsearchenginesMonitorsallqueriesandl...

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"BORDER

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

相关阅读
推荐文章
猜你喜欢
附近的人在看
推荐阅读
拓展阅读
  • 大家都在看
  • 小编推荐
  • 猜你喜欢
  • 最新hta学习
    热门hta学习
    脚本专栏子分类