Foxtable(狐表)用户栏目专家坐堂 → [求助][求助][求助]网络数据获取占用大量内存,有何解决办法?还是没搞定


  共有3756人关注过本帖树形打印复制链接

主题:[求助][求助][求助]网络数据获取占用大量内存,有何解决办法?还是没搞定

帅哥哟,离线,有人找我吗?
aalons
  11楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:372 积分:2548 威望:0 精华:0 注册:2013/6/6 6:20:00
  发帖心情 Post By:2014/8/3 19:20:00 [只看该作者]

运行一次就变大一次。另外有数据丢失哦

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  12楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/8/3 20:16:00 [只看该作者]

 不是数据丢失,这个是异步执行的,慢一些。

 

 没发觉内存会变多大,你数据很多吗?


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  13楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/8/3 20:48:00 [只看该作者]

 抱歉,测试确实有点问题,如果是内存的事,就改一下这句代码

 

Dim  Tbl As Table = Tables("公告")
Dim  Dom As Object, Str As String, i As Integer,j As Integer
'ObjIE As Object,ObjIE = CreateObject("InternetExplorer.Application")
Dim  web As New System.Windows.Forms.WebBrowser()
Dim webs As New System.Windows.Forms.WebBrowser()
web.ScriptErrorsSuppressed = False
'labpro.Text = "开始加载数据..."
'Barpro.Value = 30
With web
    For i= 0 To 3
        j+=1
        If i = 0 Then
            Str = "http://www.qhei.gov.cn/zbycg/zbgg/default.shtml"
            .Navigate(Str)'网址
        Else
            Str = "http://www.qhei.gov.cn/zbycg/zbgg/default_" & i & ".shtml"
            .Navigate(Str)
           
        End If
        Do Until .ReadyState = 4
            Application.DoEvents
        Loop
        Dom = .Document
       
        Dim elems As object = Dom.GetElementById("table7").GetElementsByTagName("table")
        If  elems IsNot dbnull.value Then
            For Each elem As object In elems
                Dim  tdelems As object =  elem.GetElementsByTagName("td")
                For Each tdelem As object In tdelems
                   
                    webs.ScriptErrorsSuppressed = False
                    Dim href As String
                    If tdelem.Children.count > 1 Then
                        href = tdelem.Children(1).GetAttribute("href")                'CurrentTable.Current("招标网址")
                    End If
                    webs.Navigate(href)
                    Do  Until webs.ReadyState = 4
                        Application.DoEvents
                    Loop
                    Dim Doms As object = Webs.Document
                    Dim Con As object = Doms.GetElementByID("Table7")    '.GetElementsByTagName("Table").getElementsByTagName("TRS_Editor")
                    Dim conhtmls As String = "<div align= 'Center' width = '100%'><style>#table7{width:100%} #Table7 tr td font p{display:none}</style> " & Con.OuterHtml & "</div>"
                    Dim conhtml As String
                    If  ConHtmls.Indexof("一篇") > 0 Then
                        conhtml = conhtmls.Substring(0,conhtmls.IndexOf("一篇"))
                       
                    Else
                        conhtml = Conhtmls
                    End If
                    If tdelem.Innertext > "" AndAlso ConHtml.Indexof("监理") >0 Then
                        Dim R As Row
                        If tdelem.Children.count > 1 Then
                            Dim dr As DataRow = DataTables("公告").Find("[名称] ='"& tdelem.Children(1).innerText.trim() &"'")
                            If  dr Is Nothing Then
                                R = Tbl.Rows.AddNew
                               
                                R("名称") = tdelem.Children(1).innerText.trim()                          'AndAlso tdelem.Children.count > 1  tdelem.Children(1).innerText.trim()
                                R("日期") = tdelem.InnerText.Trim().SubString(tdelem.Innertext.IndexOf("[")-3).Trim(" ","[","]")
                                R("内容") = conhtmls   '"<div align= 'Center' width = '100%'><style>#table7{width:100%} #Table7 tr td font{display:none}</style> " & Con.OuterHtml & "</div>"
                               
                            End If
                        End If
                        'Barpro.Value = Barpro.Value + 1
                    End If
                Next
            Next
           
        Else
            messagebox.show("数据获取失败,请检查网络!","提示")
        End If
    Next
   
   
End With
'ObjIE.Quit
If DataTables("公告").HasChanges Then
    StatusBar.Message1 = "数据获取完成..."
   
    Messagebox.show("数据已更新","提示")
   
    'labpro.Text = "数据已更新"
    'Barpro.Value = 100
    DataTables("公告").Save()
   
    StatusBar.Reset
Else
    'labpro.Text = "数据已最新"
    'Barpro.Value = 100
    Messagebox.show("数据已最新","提示")
End If

'labpro.Text = "数据加载完成..."
'Barpro.Value = 100
DataTables("公告").LoadOrder = "招标日期 Desc"

DataTables("公告").Load()


 回到顶部
总数 13 上一页 1 2