导航

« How to Remember Things Without Memorization常用正则表达式实例  »

2011-4-7 22:37:36

vb.net 获取pr值,Alexa排名源码

虚位以待 VB.NET

calf喜欢用vb，近来突然想起做一个ie的自定义浏览器，同时想获取所浏览网站的Pr值 (PageRank)和Alexa排名,vb.net的代码实例实在难找，在网上众里寻它N回，终于让偶给找到了个比较好的代码，经过自己的小小修改终于可以用vb(vb.net 2008),获取pr和Alexa了
首先添加一个类，代码如下：

折叠ASP/Visual Basic Code复制内容到剪贴板
  1. Imports System   
  2. Imports System.IO   
  3.   
  4. Public Class CheckSum   
  5.     Public Const GOOGLE_MAGIC As UInt32 = 3862272608   
  6.   
  7.     Public Function zeroFill(ByVal a As UInt32, ByVal b As Integer) As UInt32   
  8.         Dim z As UInt32 = 2147483648   
  9.         If (Convert.ToBoolean(z And a)) Then  
  10.             a = (a >> 1)   
  11.             a = a And (Not z)   
  12.             a = a Or &H40000000   
  13.             a = (a >> (b - 1))   
  14.         Else  
  15.             a = (a >> b)   
  16.         End If  
  17.         Return a   
  18.     End Function  
  19.   
  20.     Public Function mix(ByVal a As UInt32, ByVal b As UInt32, ByVal c As UInt32) As UInt32()   
  21.         a = ReduceUInt32(a, b)   
  22.         a = ReduceUInt32(a, c)   
  23.         'a ^= Convert.ToUInt32(zeroFill(c, 13))   
  24.         'a = PowerValue(a, Convert.ToUInt32(zeroFill(c, 13)))   
  25.         a = a Xor zeroFill(c, 13)   
  26.   
  27.         b = ReduceUInt32(b, c)   
  28.         b = ReduceUInt32(b, a)   
  29.         'b ^= Convert.ToUInt32(a << 8)   
  30.         b = b Xor (a << 8)   
  31.   
  32.         c = ReduceUInt32(c, a)   
  33.         c = ReduceUInt32(c, b)   
  34.         'c ^= Convert.ToUInt32(zeroFill(b, 13))   
  35.         c = c Xor zeroFill(b, 13)   
  36.   
  37.         a = ReduceUInt32(a, b)   
  38.         a = ReduceUInt32(a, c)   
  39.         'a ^= Convert.ToUInt32(zeroFill(c, 12))   
  40.         a = a Xor zeroFill(c, 12)   
  41.   
  42.         b = ReduceUInt32(b, c)   
  43.         b = ReduceUInt32(b, a)   
  44.         'b ^= Convert.ToUInt32(a << 16)   
  45.         b = b Xor (a << 16)   
  46.   
  47.         c = ReduceUInt32(c, a)   
  48.         c = ReduceUInt32(c, b)   
  49.         'c ^= Convert.ToUInt32(zeroFill(b, 5))   
  50.         c = c Xor zeroFill(b, 5)   
  51.   
  52.         a = ReduceUInt32(a, b)   
  53.         a = ReduceUInt32(a, c)   
  54.         'a ^= Convert.ToUInt32(zeroFill(c, 3))   
  55.         a = a Xor zeroFill(c, 3)   
  56.   
  57.         b = ReduceUInt32(b, c)   
  58.         b = ReduceUInt32(b, a)   
  59.         'b ^= Convert.ToUInt32(a << 10)   
  60.         b = b Xor (a << 10)   
  61.   
  62.         c = ReduceUInt32(c, a)   
  63.         c = ReduceUInt32(c, b)   
  64.         'c ^= Convert.ToUInt32(zeroFill(b, 15))   
  65.         c = c Xor zeroFill(b, 15)   
  66.   
  67.         Dim returnArray() As UInt32 = {a, b, c}   
  68.   
  69.         Return returnArray   
  70.     End Function  
  71.   
  72.     Public Function GoogleCH(ByVal url As UInt32(), ByVal length As UInt32, ByVal init As UInt32) As UInt32   
  73.         If length = 0 Then  
  74.             length = Convert.ToUInt32(url.Length - 1)   
  75.         End If  
  76.   
  77.         Dim a As UInt32 = 2654435769   
  78.         Dim b As UInt32 = 2654435769   
  79.         Dim c As UInt32 = init   
  80.         Dim k As Integer = 0   
  81.         Dim len As UInt32 = length   
  82.         Dim m_mix(3) As UInt32   
  83.   
  84.         While len >= 12   
  85.             'a += Convert.ToUInt32(url(k + 0) + (url(k + 1) << 8) + (url(k + 2) << 16) + (url(k + 3) << 24))   
  86.             a = AddUInt32(a, Convert.ToUInt32(url(k + 0) + (url(k + 1) << 8) + (url(k + 2) << 16) + (url(k + 3) << 24)))   
  87.             b = AddUInt32(b, Convert.ToUInt32(url(k + 4) + (url(k + 5) << 8) + (url(k + 6) << 16) + (url(k + 7) << 24)))   
  88.             c = AddUInt32(c, Convert.ToUInt32(url(k + 8) + (url(k + 9) << 8) + (url(k + 10) << 16) + (url(k + 11) << 24)))   
  89.             m_mix = mix(a, b, c)   
  90.             a = m_mix(0)   
  91.             b = m_mix(1)   
  92.             c = m_mix(2)   
  93.   
  94.             k += 12   
  95.             len -= 12   
  96.         End While  
  97.   
  98.         c += length   
  99.   
  100.         Select Case len             ' all the case statements fall through    
  101.             Case 11   
  102.                 c = AddUInt32(c, Convert.ToUInt32(url(k + 10) << 24))   
  103.                 c = AddUInt32(c, Convert.ToUInt32(url(k + 9) << 16))   
  104.                 c = AddUInt32(c, Convert.ToUInt32(url(k + 8) << 8))   
  105.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 7) << 24))   
  106.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 6) << 16))   
  107.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 5) << 8))   
  108.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 4)))   
  109.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 3) << 24))   
  110.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  111.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  112.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  113.             Case 10   
  114.                 c = AddUInt32(c, Convert.ToUInt32(url(k + 9) << 16))   
  115.                 c = AddUInt32(c, Convert.ToUInt32(url(k + 8) << 8))   
  116.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 7) << 24))   
  117.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 6) << 16))   
  118.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 5) << 8))   
  119.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 4)))   
  120.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 3) << 24))   
  121.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  122.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  123.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  124.             Case 9   
  125.                 c = AddUInt32(c, Convert.ToUInt32(url(k + 8) << 8))   
  126.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 7) << 24))   
  127.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 6) << 16))   
  128.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 5) << 8))   
  129.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 4)))   
  130.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 3) << 24))   
  131.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  132.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  133.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  134.                 ' the first byte of c is reserved for the length   
  135.             Case 8   
  136.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 7) << 24))   
  137.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 6) << 16))   
  138.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 5) << 8))   
  139.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 4)))   
  140.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 3) << 24))   
  141.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  142.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  143.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  144.             Case 7   
  145.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 6) << 16))   
  146.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 5) << 8))   
  147.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 4)))   
  148.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 3) << 24))   
  149.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  150.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  151.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  152.             Case 6   
  153.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 5) << 8))   
  154.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 4)))   
  155.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 3) << 24))   
  156.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  157.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  158.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  159.             Case 5   
  160.                 b = AddUInt32(b, Convert.ToUInt32(url(k + 4)))   
  161.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 3) << 24))   
  162.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  163.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  164.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  165.   
  166.             Case 4   
  167.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 3) << 24))   
  168.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  169.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  170.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  171.             Case 3   
  172.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 2) << 16))   
  173.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  174.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  175.             Case 2   
  176.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 1) << 8))   
  177.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  178.             Case 1   
  179.                 a = AddUInt32(a, Convert.ToUInt32(url(k + 0)))   
  180.                 ' case 0: nothing left to add   
  181.         End Select  
  182.         m_mix = mix(a, b, c)   
  183.         '-------------------------------------------- report the result   
  184.         Return m_mix(2)   
  185.     End Function  
  186.   
  187.     Public Function GoogleCH(ByVal url As String, ByVal length As UInt32) As UInt32   
  188.         Dim m_urluint(url.Length) As UInt32   
  189.         Dim i As Integer  
  190.         For i = 0 To url.Length - 1   
  191.             m_urluint(i) = Convert.ToUInt32(url(i))   
  192.         Next  
  193.         Return GoogleCH(m_urluint, length, GOOGLE_MAGIC)   
  194.     End Function  
  195.   
  196.     Public Function GoogleCH(ByVal sURL As String) As UInt32   
  197.         Return GoogleCH(sURL, 0)   
  198.     End Function  
  199.   
  200.     Public Function GoogleCH(ByVal url() As UInt32, ByVal length As UInt32) As UInt32   
  201.         Return GoogleCH(url, length, GOOGLE_MAGIC)   
  202.     End Function  
  203.   
  204.     Public Function c32to8bit(ByVal arr32() As UInt32) As UInt32()   
  205.         Dim arr8((arr32.GetLength(0) - 1) * 4 + 3) As UInt32   
  206.         Dim i As Integer  
  207.         For i = 0 To arr32.GetLength(0) - 1   
  208.             Dim bitOrder As Integer  
  209.             For bitOrder = i * 4 To i * 4 + 3   
  210.                 arr8(bitOrder) = arr32(i) And 255   
  211.                 arr32(i) = zeroFill(arr32(i), 8)   
  212.             Next  
  213.         Next  
  214.         Return arr8   
  215.     End Function  
  216.   
  217.     Public Function AddUInt32(ByVal a As UInt32, ByVal b As UInt32) As UInt32   
  218.         Dim resultValue As UInt32   
  219.   
  220.         Dim a64 As UInt64 = Convert.ToUInt64(a)   
  221.         Dim b64 As UInt64 = Convert.ToUInt64(b)   
  222.         Dim result64 As Int64 = a64 + b64   
  223.   
  224.         Dim sStr As String = Convert.ToString(result64, 2)   
  225.         Dim sResult As String  
  226.         If sStr.Length > 32 Then  
  227.             sResult = sStr.Substring(sStr.Length - 32)   
  228.         Else  
  229.             sResult = sStr   
  230.         End If  
  231.   
  232.         resultValue = Convert.ToUInt32(sResult, 2)   
  233.         Return resultValue   
  234.     End Function  
  235.   
  236.     Public Function ReduceUInt32(ByVal a As UInt32, ByVal b As UInt32) As UInt32   
  237.         Dim resultValue As UInt32   
  238.   
  239.         Dim aTemp As Int64 = a   
  240.         Dim bTemp As Int64 = b   
  241.   
  242.         Dim resultTemp As Int64 = aTemp - bTemp   
  243.   
  244.         Dim resultBinStr As String = Convert.ToString(resultTemp, 2)   
  245.         Dim sResult As String  
  246.         If resultBinStr.Length > 32 Then  
  247.             sResult = resultBinStr.Substring(resultBinStr.Length - 32)   
  248.         Else  
  249.             sResult = resultBinStr   
  250.         End If  
  251.   
  252.         resultValue = Convert.ToUInt32(sResult, 2)   
  253.         Return resultValue   
  254.     End Function  
  255.   
  256.     Public Function GetUInt32Value(ByVal a As Int64) As UInt32   
  257.         Dim tempValue As Int64 = a   
  258.   
  259.         Dim resultBinStr As String = Convert.ToString(tempValue, 2)   
  260.         Dim sResult As String  
  261.         If resultBinStr.Length > 32 Then  
  262.             sResult = resultBinStr.Substring(resultBinStr.Length - 32)   
  263.         Else  
  264.             sResult = resultBinStr   
  265.         End If  
  266.         tempValue = Convert.ToUInt32(sResult, 2)   
  267.         Return tempValue   
  268.     End Function  
  269.   
  270.     Public Function Mul(ByVal x As UInt32, ByVal y As UInt32)   
  271.         Dim r As UInt32 = 0   
  272.         Dim i As Int32 = 0   
  273.   
  274.         For i = 32 To 0 Step -1   
  275.             r = r << 1   
  276.             If x >> i And 1 Then  
  277.                 Dim r64 As Int64 = r   
  278.                 Dim y64 As Int64 = y   
  279.                 Dim tempResult As Int64 = r64 + y64   
  280.   
  281.                 r = GetUInt32Value(tempResult)   
  282.             End If  
  283.         Next  
  284.   
  285.         Return r   
  286.     End Function  
  287.   
  288.     Public Function PowerValue(ByVal a As UInt32, ByVal b As UInt32)   
  289.         Dim resultValue As UInt32 = a   
  290.   
  291.         Dim i As Integer  
  292.         For i = 1 To b - 1   
  293.             resultValue = Mul(resultValue, a)   
  294.         Next  
  295.   
  296.         Return resultValue   
  297.     End Function  
  298.   
  299.     Public Function DEC_to_BIN(ByVal Dec As Int64) As String  
  300.         DEC_to_BIN = ""  
  301.         If Dec > 0 Then  
  302.             Do While Dec > 0   
  303.                 DEC_to_BIN = Math.Abs(Dec Mod 2) & DEC_to_BIN   
  304.                 Dec = Dec \ 2   
  305.             Loop  
  306.         Else  
  307.   
  308.         End If  
  309.     End Function  
  310.   
  311.     Public Function BIN_to_DEC(ByVal Bin As String) As UInt32   
  312.         Dim i As UInt32   
  313.         For i = 1 To Len(Bin)   
  314.             BIN_to_DEC = BIN_to_DEC * 2 + Val(Mid(Bin, i, 1))   
  315.         Next i   
  316.     End Function  
  317.   
  318.     'new,ToolBar edition>>=2.0.114   
  319.     Public Function CalculateChecksum(ByVal sURL As String) As String  
  320.         Dim ch As UInt32 = GoogleCH("info:" + sURL)   
  321.   
  322.         ch = (((ch \ 7) << 2) Or ((Convert.ToUInt32(ch Mod 13)) And 7))   
  323.   
  324.         Dim prbuf(20) As UInt32   
  325.         prbuf(0) = ch   
  326.         Dim i As Integer  
  327.         For i = 1 To 20 - 1   
  328.             prbuf(i) = prbuf(i - 1) - 9   
  329.         Next  
  330.         ch = GoogleCH(c32to8bit(prbuf), 80)   
  331.   
  332.         Return String.Format("6{0}", ch)   
  333.     End Function  
  334.   
  335.     'old,ToolBar edition<2.0.114   
  336.     Public Function CalculateChecksumOld(ByVal sURL As String) As String  
  337.   
  338.         Dim ch As UInt32 = GoogleCH("info:" + sURL)   
  339.   
  340.         Dim CalculateChecksum As String = "6" + Convert.ToString((ch))   
  341.         Return CalculateChecksum   
  342.     End Function  
  343.   
  344.   
  345.   
  346. End Class  

 

再加一个函数（可以在另一个模块里加），代码如下：

折叠ASP/Visual Basic Code复制内容到剪贴板
  1. '==============================   
  2.  ' if return value = -1, it means there is an error   
  3.  Public Function GetPr(ByVal sUrl As String) As Integer  
  4.      Dim iPageRank As Integer = -1   
  5.   
  6.      Dim responseFromServer As String = ""  
  7.      'Dim cs As GetPageRank = New GetPageRank()   
  8.      Dim cs As CheckSum = New CheckSum()   
  9.      'Dim cs As PageRankCrack.PageRank = New PageRank()   
  10.      Dim s As String = cs.CalculateChecksum(sUrl)   
  11.   
  12.      Try  
  13.          Dim HttpWReq As Net.HttpWebRequest   
  14.          '           HttpWReq = Net.WebRequest.Create("http://www.google.cn/search?client=navclient-auto&features=Rank:&q=info:" + sUrl + "&ch=" + s)   
  15.          HttpWReq = Net.WebRequest.Create("http://66.249.89.149/search?client=navclient-auto&ch=6138193407&ie=UTF-8&oe=UTF-8&features=Rank:FVN&q=info:" + sUrl + "&ch=" + s)   
  16.   
  17.          'http://66.249.89.149/search?client=navclient-auto&ch=6138193407&ie=UTF-8&oe=UTF-8&features=Rank:FVN&q=info:   
  18.          HttpWReq.UserAgent = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30)"  
  19.          HttpWReq.Accept = "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/xaml+xml, application/vnd.ms-xpsdocument, application/x-ms-xbap, application/x-ms-application, */*"  
  20.   
  21.   
  22.          Dim HttpWResp As Net.HttpWebResponse = HttpWReq.GetResponse()   
  23.          Dim dataStream As Stream = HttpWResp.GetResponseStream()   
  24.          Dim reader As StreamReader   
  25.          reader = New StreamReader(dataStream, System.Text.Encoding.GetEncoding("UTF-8"))   
  26.          responseFromServer = reader.ReadToEnd()   
  27.   
  28.      Catch ex As Exception   
  29.          ' do nothing   
  30.      End Try  
  31.   
  32.      Dim sp() As String = Split(responseFromServer, ":")   
  33.      If sp.Length = 3 Then  
  34.          iPageRank = Convert.ToInt32(sp(2).ToString())   
  35.      End If  
  36.   
  37.      Return iPageRank   
  38.      'If iPageRank <> -1 Then   
  39.      '    lblResult.Text = "success! Page Rank = " + iPageRank.ToString()   
  40.      'Else   
  41.      '    lblResult.Text = "error!"   
  42.      'End If   
  43.  End Function  

 

最后调用就可以了（以下为例子，具体自己替换）  

ASP/Visual Basic Code复制内容到剪贴板
  1. Try  
  2.   
  3.     Dim queryUrl As String = searchE(txtUrl.Text, "^.+\.(com.cn|com|net.cn|net|org.cn|org|gov.cn|gov|cn|mobi|me|info|name|biz|cc|tv|asia|hk|网络|公司|中国)\/") '用正则从网址中获取主域名   
  4.   
  5.     lblPr.Text = "Pr: " & GetPr(queryUrl) 'dim pr as string=GetPr("spersky.com")   
  6.     Dim strConfig As String = "http://data.alexa.com/data?cli=10&dat=snba&url=" & queryUrl  'queryUrl 代表网址如spersky.com   
  7.     Dim reader As New Xml.XmlTextReader(strConfig)   
  8.     Dim alexaInfo As String = ""  
  9.     While reader.Read   
  10.         If reader.Name = "POPULARITY" Then  
  11.             alexaInfo = reader.GetAttribute("TEXT")  'strConfig的值复制到地址栏，看结果，就会明白为什么要这样   
  12.         End If  
  13.     End While  
  14.     reader.Close()   
  15.     If alexaInfo = "" Then  
  16.         lblAlexa.Text = "Alexa: " & "Nameless"  
  17.     Else  
  18.         lblAlexa.Text = "Alexa: " & alexaInfo   
  19.     End If  
  20.   
  21. Catch ex As Exception   
  22.     MsgBox(ex)   
  23.     Exit Sub  
  24. End Try  

 

  • 顶一下
发布:Calf | 分类:编程学习 | 评论:0 | 引用:0 | 浏览:
虚位以待




原创文章如转载，请注明：转载自落日故乡

本文链接地址：http://www.spersky.com/post/vbnetgetpr.html

发表评论:

◎欢迎参与讨论，请在这里发表您的看法、交流您的观点。

内容搜索


虚位以待

常用链接

最新评论及回复

Powered By Z-Blog

Copyright spersky All Rights Reserved.Theme Moonlight,Calf modified.n 浙ICP备16017820号-1