- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- 下载 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=124244)
-- 发布时间：2018/9/3 9:52:00
-- 下载
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:xl.foxdb |
-- 发布时间：2018/9/3 10:10:00
--
1、对方改版了，你本来访问的页面不存在了，自然有问题。
2、你现在只能根据最新版的内容重新分析重新获取数据才行。这个你自己做吧，不可能人家每次改变都要帮你重新分析重新帮你写代码的。
-- 发布时间：2018/9/3 10:40:00
--
参考代码，细节自行调整
Dim body As String = "gameIndex=301&searchDate=2018-09-02&gameFrom="
Dim req = System.Net.WebRequest.Create("https://kaijiang.aicai.com/open/kcResultByDate.do")
req.Method = "POST"
req.ContentType = "application/x-www-form-urlencoded"
req.UserAgent = "Mozilla/5.0 (Windows NT 6.3; rv:57.0) Gecko/20100101 Firefox/57.0"
Dim aryBuf As Byte() = Encoding.UTF8.GetBytes(body)
req.ContentLength = aryBuf.Length
Dim writer = req.GetRequestStream()
writer.Write(aryBuf, 0, aryBuf.Length)
writer.Close()
writer.Dispose()
Dim pos = req.GetResponse
Dim stm As System.IO.Stream = pos.GetResponseStream()
Dim reader As New System.IO.StreamReader(stm)
Dim str As String = reader.ReadToEnd
pos.Close
stm.Close
reader.close
msgbox(str)
Dim jo As JObject = Jobject.Parse(str)
Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
web.DocumentText = "<html><body><table>" & jo("resultHtml").ToString & "</table></body></html>"
Do Until web.ReadyState = 4
Application.DoEvents
Loop
Dim trs = web.Document.GetElementsByTagName("tr")
msgbox(trs.count)
For Each tr As object In trs
Dim tds = tr.GetElementsByTagName("td")
output.show(tds(0).Innertext)
output.show(tds(1).Innertext)
output.show(tds(2).Innertext)
output.show("--------")
Next
-- 发布时间：2018/9/3 11:22:00
--
谢谢大神
-- 发布时间：2018/9/12 9:06:00
--
甜老师再帮我写个代码吧，我写不好。网址是https://www.km28.com/lottery-gp/cqssc/2018-09-12.html。
| 下载信息 [文件大小： 下载次数： ] | |
| 点击浏览该文件:xl.foxdb |
-- 发布时间：2018/9/12 10:07:00
--
Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
web.navigate("https://www.km28.com/lottery-gp/cqssc/2018-09-11.html")
Do Until web.ReadyState = 4
Application.DoEvents
Loop
Dim tbs = web.Document.GetElementsByTagName("table")
For i As Integer = 0 To 2
Dim tb = tbs(i)
Dim trs = tb.GetElementsByTagName("tr")
msgbox(trs.count)
For Each tr As object In trs
Dim tds = tr.GetElementsByTagName("td")
output.show(tds(0).Innertext)
output.show(tds(1).Innertext)
output.show(tds(2).Innertext)
output.show("--------")
Next
Next
-- 发布时间：2018/9/12 10:53:00
--
谢谢甜老师
-- 发布时间：2018/9/12 12:34:00
--
甜老师有时间可否帮我写完整，参考3楼代码还是不得其解.拜托了
-- 发布时间：2018/9/12 14:39:00
--
甜老师有时间可否帮我写完整，参考3楼代码还是不得其解.拜托了
你在这段代码那里增加行，赋值，如
For Each tr As object In trs
Dim tds = tr.GetElementsByTagName("td")
Dim nr As Row = Tables("表A").addnew
nr("第一列") = tds(0).Innertext
output.show(tds(0).Innertext)
output.show(tds(1).Innertext)
output.show(tds(2).Innertext)
output.show("--------")
Next
-- 发布时间：2018/9/12 16:04:00
--
可以下载的了，以前的代码下载效果更好，用旧代码应该怎样改？望老师指点。
1 Dim startDate As Date = "2018-9-12"
2 Dim endDate As Date = "2018-9-12"
3 Dim dt As DataTable = DataTables("数据下载日期表")
4 Dim d As Date = startDate
5 Do While d ＜= endDate
6 If d ＞ Date.today Then
7 msgbox("不能查找大于今天的数据" & d)
8 Else
9 Dim fdr As DataRow = dt.Find("日期 = #" & d & "#")
10 If fdr Is Nothing Then
11 fdr = dt.AddNew
12 fdr("日期") = d
13 End If
14 End If
15 d = d.AddDays(1)
16 Loop
17 Dim dt2 As DataTable = DataTables("老时时彩")
18 Dim web As new System.Windows.Forms.WebBrowser
19 For Each rw As DataRow In dt.Select("下载 = false")
20 StartDate = rw("日期")
21 Dim str As String = Format(startDate, "yyyy-MM-dd_yyyy-MM-dd")
22 str = "https://www.km28.com/lottery-gp/cqssc/2018-09-12.html=" & str & "&key=" & Rand.Next(10000)
23
24 web.Navigate(str)
25 Do Until web.ReadyState = 4
26 Application.DoEvents
27 Loop
28 Dim i As Integer = 0
29 For Each dl As object In web.Document.GetElementById("his-tab").GetElementsByTagName("table")
30 If dl.getattribute("classname") Like "tr-odd*" Then
31 For Each tr As object In dl.GetElementsByTagName("tr")
32 Dim tds = tr.GetElementsByTagName("td")
33 If tds.count ＞= 5 AndAlso tds(0).Innertext ＞ "" Then
34 Dim ndr As DataRow = dt2.Find("日期=#" & startDate & "# and 期号=\'" & tds(0).innertext & "\'")
35 If ndr Is Nothing Then ndr = dt2.addnew
36 ndr("日期") = startDate
37 ndr("期号") = tds(0).innertext
38 ndr("开奖号") = tds(1).innertext
39 End If
40 Next
41 End If
42 Next
43 If StartDate ＜ Date.today Then
44 rw("下载") = True
45 End If
46 Next