classhtmlgrab.cls

采用vb编写的利用循环神经网络来预测股票走势的源程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassHTMLgrab"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim TableData(100, 1000) As String

Public Name As String
Public URL As String
Public Proxy As String
Public Port As Integer
Public TableIndex As Integer

Public startColumn As Integer
Public endColumn As Integer
Public startRow As Integer
Public endRow As Integer

Public NoOfTables As Integer


Public Sub Save(FileNumber As Integer)
'save as part of a schedule

  Print #FileNumber, Name
  Print #FileNumber, URL
  Print #FileNumber, Proxy
  Print #FileNumber, Port
  Print #FileNumber, TableIndex
  Print #FileNumber, startColumn
  Print #FileNumber, endColumn
  Print #FileNumber, startRow
  Print #FileNumber, endRow
End Sub


Public Sub Load(FileNumber As Integer)
'load as part of a schedule

  Input #FileNumber, Name
  Input #FileNumber, URL
  Input #FileNumber, Proxy
  Input #FileNumber, Port
  Input #FileNumber, TableIndex
  Input #FileNumber, startColumn
  Input #FileNumber, endColumn
  Input #FileNumber, startRow
  Input #FileNumber, endRow
End Sub


Private Sub getHTTPdata(site_text As String, TableIndex As Integer, Column As Integer, startRow As Integer, endRow As Integer)
  Dim inst As classTrainingInstance
  Dim i As Long
  Dim idx As Integer
  Dim Found As Boolean
  Dim TablePos As Long
  Dim RowPos As Long
  Dim ColPos As Long
  Dim DataStartPos As Long
  Dim DataEndPos As Long
  Dim row As Integer
  Dim col As Integer
  Dim r As Integer
  Dim dataStr As String
  Dim isCrap As Boolean
  Dim c As String
  Dim pos As Long
  Dim tbl As Integer
    
  If (site_text <> "") Then
    
    'search for the table
    idx = 0
    Found = True
    TablePos = 0
    While (Found) And (idx < TableIndex)
      TablePos = InStr(TablePos + 1, site_text, "<TABLE")
      If (TablePos > 0) Then
        Found = True
        idx = idx + 1
        Else
        Found = False
      End If
    Wend
    
    If (idx = TableIndex) Then
    
      For r = startRow To endRow
        'search for the row
        row = 0
        Found = True
        RowPos = TablePos
        While (Found) And (row < r)
          pos = InStr(RowPos + 1, site_text, "<TR ")
          If (pos = 0) Then
            RowPos = InStr(RowPos + 1, site_text, "<TR>")
            Else
            RowPos = pos
          End If
          If (RowPos > 0) Then
            Found = True
            row = row + 1
            Else
            Found = False
          End If
        Wend
      
        If (row = r) Then
          'search for the column
          col = 0
          Found = True
          ColPos = RowPos
          While (Found) And (col < Column)
            pos = InStr(ColPos + 1, site_text, "<TD ")
            If (pos = 0) Then
              ColPos = InStr(ColPos + 1, site_text, "<TD>")
              Else
              ColPos = pos
            End If
            If (ColPos > 0) Then
              Found = True
              col = col + 1
              Else
              Found = False
            End If
          Wend
          
          If (col = Column) Then
            'now grab the data!
            DataStartPos = InStr(ColPos, site_text, ">")
            If (DataStartPos > 0) Then
              DataEndPos = InStr(DataStartPos, site_text, "/TD")
              If (DataEndPos > 0) Then
                dataStr = Trim(Mid$(site_text, DataStartPos + 1, DataEndPos - DataStartPos - 2))
                If (dataStr <> "") Then
                
                  'remove any crap
                  TableData(Column, row - startRow) = ""
                  isCrap = False
                  For i = 1 To Len(dataStr)
                    c = Mid$(dataStr, i, 1)
                    If (c = "<") Then
                      isCrap = True
                    End If
                    If (Not isCrap) Then
                      TableData(Column, row - startRow) = TableData(Column, row - startRow) & c
                    End If
                    If (c = ">") And (isCrap) Then
                      isCrap = False
                    End If
                  Next
                  
                End If
              End If
            End If
          End If
          
        End If
      Next
    
    End If
  End If
  
End Sub



Public Function getHTTPTables(site_text As String) As Integer
'retunrs the number of tables on the given web page
  Dim idx As Integer
  Dim Found As Boolean
  Dim TablePos As Long
  
  If (site_text <> "") Then
    
    'search for the table
    idx = 0
    Found = True
    TablePos = 0
    While (Found)
      TablePos = InStr(TablePos + 1, site_text, "<TABLE")
      If (TablePos > 0) Then
        Found = True
        idx = idx + 1
        Else
        Found = False
      End If
    Wend
    
    getHTTPTables = idx
    Else
    getHTTPTables = 0
  End If
End Function



Public Sub SaveDataToFile(filename As String)
  Dim i As Integer
  Dim j As Integer
  Dim FileNumber As Integer

  FileNumber = FreeFile
  Open filename For Output As #FreeFile
  For j = 0 To endColumn - startColumn
    For i = 0 To endRow - startRow - 1
      Print #FileNumber, TableData(j + 1, i) & " , ";
    Next
    Print #FileNumber, " "
  Next
  Close #FileNumber
End Sub






Public Sub Grab(net As Object)
  On Error GoTo Grab_err
  
  Dim i As Integer
  Dim site_text As String

  net.Protocol = icHTTP
  net.RemotePort = Val(Port)
  net.Proxy = Proxy
  
  site_text = net.OpenURL(URL)
  site_text = UCase(site_text)

  NoOfTables = getHTTPTables(site_text)
  For i = startColumn To endColumn
    Call getHTTPdata(site_text, TableIndex, i, startRow, endRow)
  Next
  
Grab_exit:
  Exit Sub
Grab_err:
  If (Err = 35761) Then 'request timed out
    MsgBox "Web page request timed out"
    Resume Grab_exit
  End If
  MsgBox "classHTMLgrab/Grab/" & Err & "/" & Error$(Err)
  Resume Grab_exit
End Sub




Public Sub ShowGrid(grd As Object)
  Dim i As Integer
  Dim j As Integer

  grd.Cols = endColumn - startColumn + 2
  grd.Clear
  For i = 2 To grd.Rows - 1
    grd.RemoveItem (1)
  Next
  grd.row = 0
  
  For i = 0 To endRow - startRow - 1
    Call grd.AddItem("")
    grd.row = i + 1
    For j = 0 To endColumn - startColumn
      grd.col = j
      grd.Text = TableData(j + 1, i)
    Next
  Next

End Sub