关于vb:只能下载部分网页怎么办

53次阅读

共计 4872 个字符，预计需要花费 13 分钟才能阅读完成。

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[url]https://book.douban.com/douli…[/url]
[url]https://movie.douban.com/doul…[/url]
[url]https://www.douban.com/doulis…[/url]
[url]https://m.douban.com/doulist/…[/url]
[url]https://book.douban.com/douli…[/url]
[url]https://movie.douban.com/doul…[/url]
[url]https://www.douban.com/doulis…[/url]
[url]https://m.douban.com/doulist/…[/url]
[url]https://book.douban.com/douli…[/url]
[url]https://movie.douban.com/doul…[/url]
[url]https://www.douban.com/doulis…[/url]
[url]https://m.douban.com/doulist/…[/url]
[url]https://book.douban.com/douli…[/url]
[url]https://movie.douban.com/doul…[/url]
[url]https://www.douban.com/doulis…[/url]
[url]https://m.douban.com/doulist/…[/url]
[url]https://book.douban.com/douli…[/url]
[url]https://movie.douban.com/doul…[/url]
[url]https://www.douban.com/doulis…[/url]
[url]https://m.douban.com/doulist/…[/url]
[url]https://book.douban.com/douli…[/url]
[url]https://movie.douban.com/doul…[/url]
[url]https://www.douban.com/doulis…[/url]
[url]https://m.douban.com/doulist/…[/url]
[url]https://book.douban.com/douli…[/url]
[url]https://movie.douban.com/doul…[/url]
[url]https://www.douban.com/doulis…[/url]
[url]https://m.douban.com/doulist/…[/url]
[url]https://book.douban.com/douli…[/url]
[url]https://movie.douban.com/doul…[/url]

正文完
vb
发表至： vb
2021-02-18
 0
关于vb:还有一种就是-Set-EXCEL工作簿-EXCEL进程Workbooksadd-创建一个新的工作簿
关于vb:et-blockobj-ThisDrawingModelSpaceInsertBlock
关于vb:下载的文件与FTP的原文件不一致win7正常win10不正常
关于vb:新手求助VB程序问题53号错误