当前位置 博文首页 > 关键字排名(Keyword Ranking)

    关键字排名(Keyword Ranking)

    作者:admin 时间:2021-01-30 18:08

    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://style.iis7.com/uploads/2021/01/180851161336.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

    js