VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form frmExtract 
   Caption         =   "Share Market Data Extraction"
   ClientHeight    =   8115
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6525
   LinkTopic       =   "Form1"
   MinButton       =   0   'False
   ScaleHeight     =   8115
   ScaleWidth      =   6525
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   60000
      Left            =   2640
      Top             =   3840
   End
   Begin VB.TextBox txtpass 
      Height          =   375
      Left            =   3360
      TabIndex        =   2
      Top             =   840
      Width           =   2175
   End
   Begin VB.TextBox txtusername 
      Height          =   375
      Left            =   3360
      TabIndex        =   1
      Top             =   360
      Width           =   2175
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "Start"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   4
      Top             =   1440
      Width           =   2775
   End
   Begin VB.CommandButton cmdStop 
      Caption         =   "Stop"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3360
      TabIndex        =   3
      Top             =   1440
      Width           =   2655
   End
   Begin SHDocVwCtl.WebBrowser wb 
      Height          =   8895
      Left            =   120
      TabIndex        =   0
      Top             =   2040
      Width           =   15015
      ExtentX         =   26485
      ExtentY         =   15690
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
   Begin VB.Shape Shape1 
      BorderWidth     =   2
      Height          =   1935
      Left            =   120
      Top             =   120
      Width           =   6375
   End
   Begin VB.Line Line1 
      BorderWidth     =   2
      X1              =   120
      X2              =   6480
      Y1              =   1320
      Y2              =   1320
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Username"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1200
      TabIndex        =   6
      Top             =   480
      Width           =   960
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Password"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1200
      TabIndex        =   5
      Top             =   960
      Width           =   915
   End
End
Attribute VB_Name = "frmExtract"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim HTMLELEMENT As MSHTML.HTMLHtmlElement
Dim HTMLELEMENT1 As MSHTML.HTMLHtmlElement

Dim xDoc As MSHTML.HTMLDocument
Dim xUsername As HTMLInputElement
Dim xPassword As HTMLInputElement
Dim xForm As HTMLFormElement
Dim xSelect As HTMLSelectElement
Dim xButton As HTMLButtonElement

Dim Active As Boolean
Dim conn As New ADODB.Connection
Dim rsList As New ADODB.Recordset
Dim rsCode As New ADODB.Recordset

Dim mydate, mytime, quantity, value, conditions, price
Dim uname, pass, page
Dim mm

Private Sub cmdStart_Click()
mm = 0


On Error Resume Next
uname = txtusername.Text
pass = txtpass.Text
If (uname = "" Or pass = "") Then
    MsgBox "Username or Password is blank"
    GoTo myend
End If



wb.Navigate ("https://www.sharetrading.netwealth.com.au/do/public/home")
Me.Caption = "Accessing the Share Market.........."


'Timer1.Enabled = True


Do
       DoEvents
        
 Loop Until wb.ReadyState = READYSTATE_COMPLETE
        

Set xDoc = wb.Document
Set xForm = xDoc.All.Item("login")
Set xUsername = xDoc.All.Item("j_username")
Set xPassword = xDoc.All.Item("j_password")


xUsername.value = uname
xPassword.value = pass
xForm.submit

Me.Caption = "Validating Username and Password......."


Do
        DoEvents

    Loop Until wb.ReadyState = READYSTATE_COMPLETE
        
MsgBox "VERIFICATION DONE"
        

wb.Navigate ("https://www.sharetrading.netwealth.com.au/do/secure/watchListEquities")

'time pass code

Do
        DoEvents

    Loop Until wb.ReadyState = READYSTATE_COMPLETE
        



frmNew.Show

Set xDoc = wb.Document
Set xForm = xDoc.All.Item("WatchListForm")
Set xSelect = xDoc.All.Item("watchListID")
xSelect.value = "124074"
xForm.submit



Me.Caption = "Getting Data.........."
Do
        DoEvents

    Loop Until wb.ReadyState = READYSTATE_COMPLETE
        

k = 1000000
pp = 100

up:

Dim ma

For ma = 0 To k

If (pp > 10000) Then

GoTo am

End If

Next ma

am:




Do
        DoEvents

Loop Until wb.ReadyState = 4

Set xDoc = wb.Document
Set HTMLELEMENT1 = wb.Document.All.Item(2)
STR1 = HTMLELEMENT1.innerHTML



strt1 = InStr(1, STR1, "Code</th>", vbTextCompare) + 4
If (strt1 = 4) Then
    k = 1000000
    GoTo up
End If
While (strt1 <> 4)
    strt1 = InStr(strt1, STR1, "row")
    If (strt1 = 0) Then
        GoTo myend
    End If
    
    'Code
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    code = Mid(STR1, strt1, nd1 - strt1)
    a = InStr(code, "<")
    While (a <> 0)
        b = InStr(a, code, ">") + 1
        code = Trim(Replace(code, Mid(code, a, b - a), ""))
        a = InStr(code, "<")
    Wend
    a = " Create Table " & code & "(Code char(40),Last char(40),Move char(40),PercentageMove char(40),Buyer char(40),Seller char(40),Open char(40),High char(40),Low char(40),IndactivePrice char(40),Volume char(40),Value char(40),LastTrade char(40)primary key)"
    conn.Execute (a)

    
    'Last
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    mylast = Mid(STR1, strt1, nd1 - strt1)
    
    'Image move
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    
    'Move
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    mymove = Mid(STR1, strt1, nd1 - strt1)
    a = InStr(mymove, "<")
    While (a <> 0)
        b = InStr(a, mymove, ">") + 1
        mymove = Trim(Replace(mymove, Mid(mymove, a, b - a), ""))
        a = InStr(mymove, "<")
    Wend
    
    '% Move
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    pmove = Mid(STR1, strt1, nd1 - strt1)
    a = InStr(pmove, "<")
    While (a <> 0)
        b = InStr(a, pmove, ">") + 1
        pmove = Trim(Replace(pmove, Mid(pmove, a, b - a), ""))
        a = InStr(pmove, "<")
    Wend
    
    
    'Buyer
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    buyer = Mid(STR1, strt1, nd1 - strt1)
    
    'Seller
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    seller = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Open
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    myopen = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'High
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    high = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Low
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    low = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Iprice
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    iprice = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Volume
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    volume = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Value
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    value = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'ltrade
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    ltrade = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    
'conn.open
    
    rsList.open "select * from " & code, conn, adOpenDynamic, adLockOptimistic
    With rsList
        .AddNew
        .Fields(0) = code
        .Fields(1) = mylast
        .Fields(2) = mymove
        .Fields(3) = pmove
        .Fields(4) = buyer
        .Fields(5) = seller
        .Fields(6) = myopen
        .Fields(7) = high
        .Fields(8) = low
        .Fields(9) = iprice
        .Fields(10) = volume
        .Fields(11) = value
        .Fields(12) = ltrade
        
        .Update
    
    End With
    
    rsList.Close
Wend


myend:
    cmdStop.Enabled = True
    Timer1.Enabled = True
End Sub

Private Sub cmdStop_Click()
End
End Sub

Private Sub Form_Load()
Active = True
conn.CursorLocation = adUseClient
conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" & "SERVER=localhost;" & "DATABASE=STOCKDATAASX;" & "UID=root;" & "PWD=huck13;"
conn.open
'On Error Resume Next
'a = "create database STOCKDATAASX"
'conn.Execute (a)


End Sub






Private Sub Timer1_Timer()
On Error Resume Next
Set xDoc = wb.Document
Set xButton = xDoc.getElementById("refreshSubmit")
xButton.Click
'wb.Navigate ("https://www.sharetrading.netwealth.com.au/do/secure/watchListEquities")
'wb.Refresh
'time pass code

Do
        DoEvents

    Loop Until wb.ReadyState = READYSTATE_COMPLETE
        
On Error Resume Next




'Set xDoc = wb.Document
'Set xForm = xDoc.All.Item("WatchListForm")
'Set xSelect = xDoc.All.Item("watchListID")
'xSelect.value = "124074"
'xForm.submit



Me.Caption = "Getting Data.........."
Do
        DoEvents

    Loop Until wb.ReadyState = READYSTATE_COMPLETE
        

k = 1000000
pp = 100

up:

Dim ma

For ma = 0 To k

If (pp > 10000) Then

GoTo am

End If

Next ma

am:




Do
        DoEvents

Loop Until wb.ReadyState = 4

Set xDoc = wb.Document
Set HTMLELEMENT1 = wb.Document.All.Item(2)
STR1 = HTMLELEMENT1.innerHTML



strt1 = InStr(1, STR1, "Code</th>", vbTextCompare) + 4
If (strt1 = 4) Then
    k = 1000000
    GoTo up
End If
While (strt1 <> 4)
    strt1 = InStr(strt1, STR1, "row")
    If (strt1 = 0) Then
        GoTo myend
    End If
    
    'Code
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    code = Mid(STR1, strt1, nd1 - strt1)
    a = InStr(code, "<")
    While (a <> 0)
        b = InStr(a, code, ">") + 1
        code = Trim(Replace(code, Mid(code, a, b - a), ""))
        a = InStr(code, "<")
    Wend
    a = " Create Table " & code & "(Code char(40),Last char(40),Move char(40),PercentageMove char(40),Buyer char(40),Seller char(40),Open char(40),High char(40),Low char(40),IndactivePrice char(40),Volume char(40),Value char(40),LastTrade char(40)primary key)"
    conn.Execute (a)

    
    
    'Last
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    mylast = Mid(STR1, strt1, nd1 - strt1)
    
    'Image move
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    
    'Move
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    mymove = Mid(STR1, strt1, nd1 - strt1)
    a = InStr(mymove, "<")
    While (a <> 0)
        b = InStr(a, mymove, ">") + 1
        mymove = Trim(Replace(mymove, Mid(mymove, a, b - a), ""))
        a = InStr(mymove, "<")
    Wend
    
    '% Move
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    pmove = Mid(STR1, strt1, nd1 - strt1)
    a = InStr(pmove, "<")
    While (a <> 0)
        b = InStr(a, pmove, ">") + 1
        pmove = Trim(Replace(pmove, Mid(pmove, a, b - a), ""))
        a = InStr(pmove, "<")
    Wend
    
    
    'Buyer
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    buyer = Mid(STR1, strt1, nd1 - strt1)
    
    'Seller
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    seller = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Open
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    myopen = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'High
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    high = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Low
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    low = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Iprice
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    iprice = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Volume
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    volume = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'Value
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    value = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    'ltrade
    strt1 = InStr(strt1, STR1, "<td", vbTextCompare)
    strt1 = InStr(strt1, STR1, ">") + 1
    nd1 = InStr(strt1, STR1, "</td>", vbTextCompare)
    ltrade = Replace(Mid(STR1, strt1, nd1 - strt1), "&nbsp;", "")
    
    rsList.open "select * from " & code, conn, adOpenDynamic, adLockOptimistic
    With rsList
        .AddNew
        .Fields(0) = code
        .Fields(1) = mylast
        .Fields(2) = mymove
        .Fields(3) = pmove
        .Fields(4) = buyer
        .Fields(5) = seller
        .Fields(6) = myopen
        .Fields(7) = high
        .Fields(8) = low
        .Fields(9) = iprice
        .Fields(10) = volume
        .Fields(11) = value
        .Fields(12) = ltrade
        
        .Update
    
    End With
    rsList.Close
Wend

myend:

End Sub