http://www.163.com
在百度中对应的URL链接形式:
http://www.baidu.com/link?url=8cf4db60ee24715a6c22b439e2c3af8bf6ffce8d301ebae868c0899affd34f3b224ae5e870c5a1ab7dea108764f2c54b59ba415cef77cfbef016e5ac06117a14d87061c981bdb985b6234ab094ccc80f6a604c5528c9b227af64484fb5a48038c9734c22014fcedae201ccefef4b5ed272be3eaf81eb8837105e79d306a64ca1fc63b0523cc51e21e20986be3e9dd0f0bfdeb55fba4778befd606055703af02cf8439305debf073a428c17a9c4b9b7c176e44d5c8aaf6e5c8fb16ca00db768e590de361f60c045f219e0de1a47aa277f78560faaef95b0909b49fc26305188e1eb8b65f222b281096b128aeb5ce4618209cdd6974977bc8e77610a95cc12ea9383374dfdbd9882adf92f9f11a138c5662fc98513f5e9f8ba51ff24e23849177ab7ba6880825b85dedb495d8eb2fc1e16882dd7cce6a8e8e49c008ca807a13c2666757b10552d284ff67131754f4c13904a0e890f3df9c997e9319b368c6aebac5573358cc3c0659257bfcf546427d385bfa82672b11f0e24
url=后面的部分有办法解密出来吗?

解决方案 »

  1.   

    源码VB我可以实现其他的不会QQ:370472576.我空间有截图
      

  2.   

     Dim Sint As String
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
    Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
    Const GW_HWNDNEXT = 2
    Const LVM_FIRST As Long = &H1000
    Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
    Const LVSCW_AUTOSIZE_USEHEADER As Long = -2
    Dim SB As String, BS As Integer, JG As Integer
    Private Sub lvAutosizeControl(lv As ListView)
    Dim col2adjust&
    For col2adjust = 0 To lv.ColumnHeaders.Count - 1
    Call SendMessage(lv.hwnd, LVM_SETCOLUMNWIDTH, col2adjust, ByVal LVSCW_AUTOSIZE_USEHEADER)
    Next
    End SubPrivate Sub Command1_Click()
    Me.ListView1.ListItems.Clear
    WebBrowser1.Navigate2 ("http://www.baidu.com/s?wd=" & Text1.Text)
    End Sub
    Private Sub Command2_Click()
    WebBrowser1.Navigate (Sint)
    End SubPrivate Sub Form_Load()
    With ListView1
    .View = lvwReport
    .ColumnHeaders.Add , , "标题:"
    .ColumnHeaders.Add , , "百度Link转向路径:"
    .ColumnHeaders.Add , , "解密后的真实路径:"
    End With
    End Sub
    Private Sub ListView1_Click()
    On Error Resume Next
    Text2.Text = ListView1.SelectedItem.Text
    Text3.Text = ListView1.SelectedItem.SubItems(1)
    Text4.Text = ListView1.SelectedItem.SubItems(2)
    End Sub
    Private Sub ListView1_DblClick()
    On Error Resume Next
     WebBrowser2.Navigate2 (ListView1.SelectedItem.SubItems(2))
    End SubPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim vTag As Variant, i As Integer, vCount As Integer
    On Error Resume Next
    Dim S As String, Names, URLS1, URLS2 As String
    Dim listItem As listItem
    If WebBrowser1.ReadyState = READYSTATE_COMPLETE Then
    Set vTag = WebBrowser1.Document.getElementsByTagName("a")
    vCount = vTag.Length
    For i = 0 To vCount - 1
    S = WebBrowser1.Document.All.tags("a")(i)
    If (Left(S, Len("http://www.baidu.com/link?url="))) = "http://www.baidu.com/link?url=" Then
    Names = Trim((vTag(i).innertext))
     If Names = "" Or Names = "百度快照" Or Names = "百度首页" Or Names = "新闻" Or Names = "网页" Or Names = "贴吧" Or Names = "知道" Or Names = "MP3" Or Names = "图片" Or Names = "视频" Or Names = "地图" Or Names = "搜索设置" _
     Or Names = "把百度添加到桌面" _
     Or Names = "登录" _
     Or Names = "注册" _
     Or Names = "结果中找" _
     Or Names = "帮助" _
     Or Names = "高级搜索" _
     Or Names = "举报" _
     Or Names = "?把来百度推广您的产品" Then '屏蔽无用
     '      举报
    Else
     Set listItem = ListView1.ListItems.Add(, , Names) ' Web1.Document.links.Item(V).innerText)
                        listItem.SubItems(1) = S
                        listItem.SubItems(2) = BaiduUrlLink1.GetTrueUrl(S)
    End If
         If Replace((vTag(i).innertext), ">", "") = "下一页" Then
         Sint = WebBrowser1.Document.All.tags("a")(i)
         Else
         End If
           Else
              
       End If
    Next
      
      
     
        End If 
    Call lvAutosizeControl(ListView1) '把这行拿掉就可以看出Autosize是否生效End Sub
     
    '部分源码  QQ:370472576