• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    关键字排名(Keyword Ranking)
    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 (iC_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 (iC_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://www.interclasse.com/pics/avatar.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

    上一篇:A notepad made in HTA(hta实现的记事本)
    下一篇:DOM浏览器(方便需要dom操作的朋友)
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

    关键字排名(Keyword Ranking) 关键字,排名,Keyword,Ranking,