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