請高手指導一下，目前寫了一大半但仍有問題
帳號:csdntest
密碼:Test1234 <--注意有大小寫之分
目的:登入
https://login.yahoo.com/config/login?.intl=tw&.partner=&.last=&.src=https://bbs.csdn.net/topics/wrtch&.scrumb=0&.pd=c=R.kjIs2p2e5IjYgxHnmFvubWqw--&pkg=&stepid=i&&.done=https%3a//login.yahoo.com/config/validate%3f.src=wrtch%26.pc=1164%26.scrumb=0%26.done=https%3a//login.wretch.cc/IDintegration/?ref=%25252F
並輸入帳號、密碼 ->登入 ->網誌 ->發表新文章(舊版)
以上 大家使用帳號、密碼可以先登入看看
原本就有用一個webbrowser的版本來處理，只是想要再提升速度，勢必要使用封包的方式發送
不知道是不是還要作一些referer或是cookie的管理，這裏我概念不清楚，code也完全土法綀鋼硬弄出來的
可望高手給意見，跪求協助
或是請高手加入QQ
QQ:1795544930
Dim LoginOoutHttpRequest$
Dim sUrl$ 'As String
Dim sMethod$ 'As String
Dim sBody ' As String
Dim sResponse$ 'As String
Dim UserID 'As String '用戶名
Dim PassWord 'As String '密碼
Dim URL_Get 'As String
Dim URL_Post 'As String
Dim login_u
Dim login_challenge
Dim login_done
Dim login_pd
Dim Article_post_c
Dim Article_post_t
Dim Atricle_year
Dim Atricle_mon
Dim Atricle_day
Dim Atricle_hour
Dim Atricle_mins
LoginPostForm() = Array(".u", ".challenge", ".done", ".pd")
ArticlePostForm() = Array(".c", ".t")
UserID = "csdntest"
PassWord = "Test1234"
On Error Resume Next
URL_Get = "http://tw.rd.yahoo.com/referurl/wretch/kk/l/haha/M/logout/*http://www.wretch.cc/index/logout.php?url=http%3A%2F%2Ftw.yahoo.com"
Call Method_GetUrl(URL_Get)
'取得要登入的網址
URL_Get = "https://login.yahoo.com/config/login?.intl=tw&.partner=&.last=&.src=https://bbs.csdn.net/topics/wrtch&.scrumb=0&.pd=c=R.kjIs2p2e5IjYgxHnmFvubWqw--&pkg=&stepid=i&&.done=https%3a//login.yahoo.com/config/validate%3f.src=wrtch%26.pc=1164%26.scrumb=0%26.done=https%3a//login.wretch.cc/IDintegration/?ref=%25252F"
'取該網址的源碼給抓出來
Text12.Text = Method_GetUrl(URL_Get)
'使用正則表達式將源碼裏的form欄位的值給抓出來
Dim data_array As String
data_array = LoginPostForm(0)
login_u = XmlhttpTestRegExp(data_array, Text12.Text)
data_array = LoginPostForm(1)
login_challenge = XmlhttpTestRegExp(data_array, Text12.Text)
data_array = LoginPostForm(2)
login_done = XmlhttpTestRegExp(data_array, Text12.Text)
data_array = LoginPostForm(3)
login_pd = XmlhttpTestRegExp(data_array, Text12.Text)
'將抓出來的值放到sBody裏，準備post出去
'sBody = ".tries=1&.src=https://bbs.csdn.net/topics/wrtch&.md5=&.hash=&.js=&.last=&promo=&.intl=tw&.lang=zh-Hant-TW&.bypass=&.partner=&.u=" & login_u & " &.v=0&.challenge=" & login_challenge & "&.yplus=&.emailCode=&pkg=&stepid=i&.ev=&hasMsgr=1&.chkP=Y&.done=" & login_done & "&.pd=" & login_pd & " .ws=1&.cp=0&nr=0&pad=3&aad=3&login=" & UserID & "&passwd=" & PassWord & "&.persistent=y&.save=%E7%99%BB%E5%85%A5&passwd_raw="
sBody = ".tries=1&.src=https://bbs.csdn.net/topics/wrtch&.md5=&.hash=&.js=&.last=&promo=&.intl=tw&.lang=zh-Hant-TW&.bypass=&.partner=&.u=" & login_u & " &.v=0&.challenge=" & login_challenge & "&.yplus=&.emailCode=&pkg=&stepid=i&.ev=&hasMsgr=1&.chkP=Y&.done=" & login_done & "&.pd=" & login_pd & " .ws=1&.cp=0&nr=0&pad=3&aad=3&login=" & UserID & "&passwd=" & PassWord & "&.persistent=y&.save=登入&passwd_raw="
MsgBox "sBody" & sBody
URL_Post = "https://login.yahoo.com/config/login?.intl=tw&.partner=&.last=&.src=https://bbs.csdn.net/topics/wrtch&.scrumb=0&.pd=c=R.kjIs2p2e5IjYgxHnmFvubWqw--&pkg=&stepid=i&&.done=https%3a//login.yahoo.com/config/validate%3f.src=wrtch%26.pc=1164%26.scrumb=0%26.done=https%3a//login.wretch.cc/IDintegration/?ref=%25252F"
'"https://login.yahoo.com/config/login"
Call Method_PostUrl(URL_Post, sBody)
'登錄之後前往要發文的頁面
URL_Get = "http://www.wretch.cc/blog/modify.php?blog_id=csdntest&func=post&htmlarea=2&switch_editor=1"
'將該頁面的源碼給讀出來
Text12.Text = Method_GetUrl(URL_Get)
data_array = ArticlePostForm(0)
Article_post_c = XmlhttpTestRegExp(data_array, Text12.Text)
data_array = ArticlePostForm(1)
Article_post_t = XmlhttpTestRegExp(data_array, Text12.Text)
Atricle_year = Year(Now)
Atricle_mon = Month(Now)
Atricle_day = Day(Now)
Atricle_hour = Hour(Now)
Atricle_mins = Minute(Now)
'將源碼裏的某些特殊欄的值給讀出來，並準備post出去
URL_Post = "https://login.wretch.cc/blog/do_modify.php"
sBody = "func=post&blog_id=csdntest&.c=" & Article_post_c & "&.t=" & Article_post_t & "&month=" & Atricle_mon & "&day=" & Atricle_day & "&year=" & Atricle_year & "&hour=" & Atricle_hour & "&min=" & Atricle_mins & "&title=good&allow_comment=1&isCloak=0&passwd=&passwd_note=&FriendGroup=all&default_category=229&text=test!!&tburl=%26id%3D&confirm=%E9%80%81%E5%87%BA%E6%96%87%E7%AB%A0"
Call Method_PostUrl(URL_Post, sBody)
Function XmlhttpTestRegExp(postname As String, myString As String)
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim RetStr As String
Dim SourceCode_PD As String
Dim RegCount As Integer
Dim Regstring As String
' Create a regular expression object.
Set objRegExp = New RegExp
objRegExp.Pattern = """" & postname & """" & " value="".*?"""
'MsgBox "pattern = " & objRegExp.Pattern
objRegExp.IgnoreCase = True
objRegExp.Global = True
RegCount = 0
'Test whether the String can be compared.
If (objRegExp.Test(myString) = True) Then
'Get the matches.
Set colMatches = objRegExp.Execute(myString) ' Execute search
' objRegExp.Pattern = "&(.*)" '抓出sub=1的超網址
For Each objMatch In colMatches ' Iterate Matches collection.
MsgBox "Restr = " & objMatch.Value
Regstring = Trim(Replace(objMatch.Value, "value="https://bbs.csdn.net/topics/, ""))
Regstring = Trim(Replace(Regstring, postname, ""))
Regstring = Trim(Replace(Regstring, """", ""))
' Regstring = Trim(objRegExp.Replace(Regstring, ""))
Next
RetStr = Regstring
Else
RetStr = "String Matching Failed"
End If
Function Method_GetUrl(ByVal GetUrl$)
On Error Resume Next
Dim MessageData
'StrConv
Set LoginOoutHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MsgBox "GetUrl" & GetUrl
With LoginOoutHttpRequest
.Option(6) = True
.open "GET", GetUrl, True
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows; U; Windows NT 5.1; zh-CN; rv:1.9.2.25) Gecko/20111212 Firefox/3.6.25"
.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
.setRequestHeader "Connection", "Keep-Alive"
.send
.waitForResponse
Method_GetUrl = .responseText
End With
Set LoginOoutHttpRequest = Nothing
End Function
Function Method_PostUrl(ByVal PostUrl$, SendData)
On Error Resume Next
'StrConv
Set LoginOoutHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MsgBox "PostUrl" & PostUrl$
MsgBox "SendData" & SendData
With LoginOoutHttpRequest
.open "POST", PostUrl, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows; U; Windows NT 5.1; zh-CN; rv:1.9.2.25) Gecko/20111212 Firefox/3.6.25"
.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Accept-Encoding", "gzip,deflate"
.setRequestHeader "x-requested-with", "XMLHttpRequest"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Connection", "Keep-Alive"
.setRequestHeader "Accept-Language", "zh-tw"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS124759; GTB7.5; .NET CLR 1.1.4322; .NET CLR 2.0.50727; InfoPath.2)"
.setRequestHeader "Host", "login.yahoo.com"
.setRequestHeader "Content-Length", Len(SendData)
MsgBox "Len(SendData) = " & Len(SendData)
.Option(6) = True
.Option(4) = 13056
.send SendData
.waitForResponse
Method_PostUrl = .responseText
End With
Set LoginOoutHttpRequest = Nothing
End Function
uj5u.com熱心網友回復：
先解決登入，然后再考慮其它功能吧。登入部分未加密，不太復雜。
uj5u.com熱心網友回復：
我可以做的，看看有什么需求，QQ 1085992075轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/145024.html
標籤：網絡編程
上一篇：dbgird顯示不了資料