SZ001965
代碼.txt 里只有上面一行
'sdata里所下的資料不完整， 錯誤是sdata只下載了網頁的部分內容
怎么樣才能下載完整的網頁???????????????????????????
以下是我的VB6代碼
Option Explicit
Private Sub Command1_Click()
Rem ===========================================================================================
' Open "error.txt" For Output As #10
' Print #10, sdata
' Close #10
' nflag = nflag + 0
Dim nflag As Long
Dim nlable As Long '數字 601009
Dim tlable As String
Dim clable As String
Dim wlable As String
Dim plable As String 'SH SZ+601009+TAB
Dim mlable As String '字串601009
Dim slable As String '字串601009
Dim stlable As String '原一行股票代碼SH601009
Dim sdata As String '網頁源代碼
Dim sofdata As String '最終輸出檔案
sofdata = "gahxqj.txt" '下載存放檔案名
Dim siflable As String '讀入代碼檔案
'siflable = "E:\巨潮文本與二進制\A股代碼索引表.txt"
siflable = "代碼.txt"
Open siflable For Input As #1
Open sofdata For Output As #2
Rem ===========================================================================================
Dim qjsmsg As String 'ga提示
qjsmsg = "全景股東數下載:" '下載內容提示
Dim qjylsof As String
Dim qjnlsof As String
qjylsof = "qjylable.txt"
qjnlsof = "qjnlable.txt"
Dim qjs1 As String
Dim qjs2 As String
Dim qjs0 As String
qjs1 = "http://data.p5w.net/stock/gdrs.php?code=" '網址頭
qjs2 = "" '網址尾
Dim qjsbeg As String
Dim qjsend As String
qjsbeg = "</thead>" '物體頭
'qjsbeg = "option"
qjsend = "var hqServer" '物體尾
Dim qjsbj0 As String
Dim qjsbj1 As String
Dim qjsbj2 As String
qjsbj0 = "<td class=""c"">" '資料頭
qjsbj1 = "</td>" '資料尾
Open qjylsof For Output As #7 '7
Open qjnlsof For Output As #8 '8
Rem ===========================================================================================
Do Until EOF(1)
sdata = ""
Line Input #1, stlable
slable = Right(stlable, 6)
mlable = Right(stlable, 6)
nlable = CLng(mlable)
If (InStr(stlable, "SH") > 0 And nlable >= 600000 And nlable <= 688999) Or (InStr(stlable, "SZ") > 0 And ((nlable >= 1 And nlable <= 999) Or (nlable >= 2001 And nlable <= 2999) Or (nlable >= 300001 And nlable <= 300999) Or (nlable = 1696 Or nlable = 1872 Or nlable = 1896 Or nlable = 1914 Or nlable = 1965 Or nlable = 1979))) Then
If (nlable >= 600000 And nlable <= 688999) Then
qjs0 = qjs1 & "sh" & slable
Else
qjs0 = qjs1 & "sz" & slable
End If
Me.Label1.Caption = qjsmsg & slable
sdata = Inet1.OpenURL(qjs0)
'Dim b() As Byte
'Inet1.Cancel
'Inet1.Protocol = icHTTP
'Inet1.URL = "" '這步不要省略
'Inet1.URL = qjs0
'b() = Inet1.OpenURL(, icByteArray)
'sdata = StrConv(b, vbUnicode) '即為所獲得網頁源代碼
If InStr(1, sdata, qjsbeg, vbTextCompare) >= 1 Then
'sdata里所下的資料不完整，所以找不到qjsbeg 錯誤是sdata只下載了網頁的部分內容
nflag = InStr(1, sdata, qjsbeg, vbTextCompare)
If nflag > 2 Then
sdata = Right(sdata, Len(sdata) - nflag + 2)
nflag = InStr(1, sdata, qjsend, vbTextCompare)
sdata = Left(sdata, nflag - 1)
End If
Rem 開始
plable = ""
If (CLng(slable) >= 600000 And CLng(slable) <= 688999) Then
plable = "SH" + slable + Chr(9)
Else
plable = "SZ" + slable + Chr(9)
End If
nflag = InStr(1, sdata, qjsbj0, vbTextCompare)
While nflag > 0
tlable = plable
sdata = Right(sdata, Len(sdata) - nflag - Len(qjsbj0) + 1) '截找的字符
tlable = tlable + Left(sdata, 4)
tlable = tlable + Mid(sdata, 6, 2)
tlable = tlable + Mid(sdata, 9, 2) + Chr(9)
nflag = InStr(1, sdata, qjsbj0, vbTextCompare)
sdata = Right(sdata, Len(sdata) - nflag - Len(qjsbj0) + 1)
nflag = InStr(1, sdata, qjsbj1, vbTextCompare)
wlable = Left(sdata, nflag - 1)
wlable = Replace(wlable, ",", "")
tlable = tlable + wlable + Chr(9)
nflag = InStr(1, sdata, qjsbj0, vbTextCompare)
sdata = Right(sdata, Len(sdata) - nflag - Len(qjsbj0) + 1)
nflag = InStr(1, sdata, qjsbj0, vbTextCompare)
sdata = Right(sdata, Len(sdata) - nflag - Len(qjsbj0) + 1)
nflag = InStr(1, sdata, qjsbj1, vbTextCompare)
wlable = Left(sdata, nflag - 1)
wlable = Replace(wlable, ",", "")
tlable = tlable + wlable
Rem sdata = Right(sdata, Len(sdata) - nflag - Len(qjsbj0) + 1)
Print #2, tlable
' nflag = InStr(1, sdata, qjsbj0, vbTextCompare)
' sdata = Right(sdata, Len(sdata) - nflag - Len(qjsbj0) + 1)
' nflag = InStr(1, sdata, qjsbj0, vbTextCompare)
' sdata = Right(sdata, Len(sdata) - nflag - Len(qjsbj0) + 1)
nflag = InStr(1, sdata, qjsbj0, vbTextCompare)
Wend
Print #7, slable
Else
Print #8, slable + ":沒資料"
End If
Else
Print #8, slable + ":代碼不正規"
End If
Loop
Close #1
Close #2
Rem 找到代碼
Close #7
Rem 沒找代碼
Close #8
MsgBox qjsmsg
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/253219.html
標籤：VB基礎類
上一篇：求教大神 回圈問題