Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

How to extract and display real time data from websites

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin How to extract and display real time data from websites

    ' How to extract and display real time data from websites
    '
    ' Some websites contain real time information, which may be
    ' extracted at regular intervals. You may use the information
    ' obtained in your own programs.
    '
    ' This program shows how this can be done using financial
    ' data as an example. In the present version new data are obtained
    ' every 15 seconds. The program is most illustrative during market
    ' hours, when the data are changing frequently.
    '
    ' You should be aware that not all websites displaying real time
    ' data are suitable. You may have to look around and do some
    ' testing to find those websites, that can be used.
    '
    ' Best regards,
    '
    ' Erik Christensen
    '
    ' websites: http://ecstep.com/ --- http://sudoku-instructions.com/ --- http://know-facts.com/
    Code:
    ' How to extract and display real time data from websites
    '
    ' Some websites contain real time information, which may be
    ' extracted at regular intervals. You may use the information
    ' obtained in your own programs.
    '
    ' This program shows how this can be done using financial
    ' data as an example. In the present version new data are obtained
    ' every 15 seconds. The program is most illustrative during market
    ' hours, when the data are changing frequently.
    '
    ' You should be aware that not all websites displaying real time
    ' data are suitable. You may have to look around and do some
    ' testing to find those websites, that can be used.
    '
    ' Best regards,
    '
    ' Erik Christensen
    '
    ' websites: ecstep.com - sudoku-instructions.com - know-facts.com
    
    #COMPILE EXE
    #DIM ALL
    
    #INCLUDE ONCE "WIN32API.INC"
    #INCLUDE ONCE "COMMCTRL.INC"
    
    %IDC_TEXTBOX1 =     2010
    %IDC_TIMER1 =       2011
    %IDC_BUTTON1_EXIT = 2012
    %IDC_GRAPHIC1     = 2013
    
    GLOBAL g_sWebGetStatus AS STRING ' global status string
    
    FUNCTION g_WebGet( _   ' This fine function gets the source code of a webpage
        BYVAL sLocalURL AS STRING, _
        BYVAL sLocalUsername AS STRING, _
        BYVAL sLocalPassword AS STRING, _
        BYREF sLocalResponse AS STRING) AS LONG
    
    ' Provided by Jim Dunn Apr 8th, 2010, 04:23 PM in this thread:
    ' http://www.powerbasic.com/support/pbforums/showthread.php?t=43291
    '
    ' The code has been slightly modified to run on PBwin10 as described here:
    ' http://www.powerbasic.com/support/pbforums/showthread.php?t=48110
    
        LOCAL goXMLHTTP AS DISPATCH
    
        ON ERROR RESUME NEXT
    
        IF UCASE$(sLocalURL) = "CLOSE" THEN
            SET goXMLHTTP = NOTHING
            FUNCTION = 0
            EXIT FUNCTION
        END IF
    
        IF ISNOTHING(goXMLHTTP) THEN
           ' SET goXMLHTTP = NEW DISPATCH IN "Msxml2.xmlhttp.3.0"   works only with PBwin9
            goXMLHTTP = NEWCOM "Msxml2.xmlhttp.3.0"               ' works with PBwin10
            IF ISNOTHING(goXMLHTTP) THEN
                g_sWebGetStatus = "ERROR: goXMLHTTP create failed"
                FUNCTION = 1003
                EXIT FUNCTION
            END IF
        END IF
    
        LOCAL v1, v2, v3, v4, v5 AS VARIANT
        LOCAL wTxt AS WSTRING
    
        v1 = "GET"
        v2 = sLocalURL
        v3 = 0
        v4 = sLocalUsername
        v5 = sLocalPassword
    
        OBJECT CALL goXMLHTTP.open(v1, v2, v3, v4, v5)
        IF OBJRESULT OR ERR THEN
            g_sWebGetStatus = "ERROR: goXMLHTTP.open failed"
            FUNCTION = 1004
            EXIT FUNCTION
        END IF
    
        v1 = ""
        OBJECT CALL goXMLHTTP.send(v1)
        IF OBJRESULT OR ERR THEN
            g_sWebGetStatus = "ERROR: goXMLHTTP.send failed"
            FUNCTION = 1005
            EXIT FUNCTION
        END IF
    
        OBJECT GET goXMLHTTP.status TO v1
        IF OBJRESULT OR ERR THEN
            g_sWebGetStatus = "ERROR: goXMLHTTP.status failed"
            FUNCTION = 1006
            EXIT FUNCTION
        END IF
    
        OBJECT GET goXMLHTTP.ResponseText TO wTxt
        IF wTxt = "" THEN
            g_sWebGetStatus = "ERROR: goXMLHTTP.ResponseText failed"
            FUNCTION = 1007
            EXIT FUNCTION
        END IF
    
        g_sWebGetStatus = "SUCCESS"
        sLocalResponse = wTxt
    
        goXMLHTTP = NOTHING
        v1 = EMPTY
        v2 = EMPTY
        v3 = EMPTY
        v4 = EMPTY
        v5 = EMPTY
    
        FUNCTION = 0
    
    END FUNCTION
    
    FUNCTION ExtractSingleValue(BYREF s AS STRING, BYVAL LeftLimit AS STRING, BYVAL RightLimit AS STRING) AS STRING
        LOCAL i, k, le AS LONG
        i = INSTR(s, LeftLimit) : le = LEN(LeftLimit) : k = INSTR(i+le, s, RightLimit)
        FUNCTION = MID$(s, i+le, k-i-le)
    END FUNCTION
    
    SUB ExtractData(BYREF Last AS STRING, BYREF Change AS STRING, BYREF ChangePct AS STRING)
        LOCAL sURL, s AS STRING
        LOCAL LeftLimit, RightLimit AS STRING
    
        sURL = "http://www.investing.com/indices/us-spx-500-futures"  ' URL of webpage to extract data from
    
        IF g_WebGet(sURL, "", "", s) = 0 THEN ' get the html source code of the webpage
    
            '*********** This is the relevant part of the html source code of the above webpage: *************
            '
            '            <span class="arial_26 inlineblock pid-8839-last" id="last_last" dir="ltr">1,919.95</span>
            '                        <span class="arial_20 redFont   pid-8839-pc" dir="ltr">-26.05</span>
            '            <span dir="rtl">&nbsp;&nbsp;</span>
            '            <span class="arial_20 redFont  pid-8839-pcp parentheses" dir="ltr">-1.34%</span>
            '
            '*************************************************************************************************
    
            LeftLimit = "id=""last_last"" dir=""ltr"">"           ' remember to duplicate any " within the string
            RightLimit = "</span>"
            Last = ExtractSingleValue(s, LeftLimit, RightLimit)
    
            LeftLimit = "pid-8839-pc"" dir=""ltr"">"              ' remember to duplicate any " within the string
            RightLimit = "</span>"
            Change = ExtractSingleValue(s, LeftLimit, RightLimit)
    
            LeftLimit = "pid-8839-pcp parentheses"" dir=""ltr"">" ' remember to duplicate any " within the string
            RightLimit = "</span>"
            ChangePct = ExtractSingleValue(s, LeftLimit, RightLimit)
    
        END IF
    
    END SUB
    
    SUB Graph1(BYVAL hDlg AS LONG, BYVAL GraphID AS LONG, BYVAL yMove AS SINGLE)
        ' this sub is based on version 3 of my program in this thread:
        ' https://powerbasic.com/support/pbforums/showthread.php?t=58042
        STATIC WidthVar, HeightVar, Xstep AS LONG
        STATIC StationaryXpos, CurrentScreenYpos AS SINGLE
        STATIC yPrevMove AS SINGLE
        STATIC prevYpos AS SINGLE
        STATIC xRightSpace AS LONG
        STATIC yNewTop, yOldTop AS SINGLE
        STATIC YposUpLimit, YposDownLimit AS SINGLE
        STATIC Ystep AS SINGLE
        STATIC first AS LONG
        STATIC LineColor AS LONG
        GRAPHIC ATTACH hDlg, GraphID
        IF first = 0 THEN
            GRAPHIC GET SIZE TO WidthVar, HeightVar
            Xstep = 10                                          ' number of pixels moving to the left per time inteval
            GRAPHIC WIDTH 3
            xRightSpace = 15                                    ' blank space on right side of curves in pixels - can be changed
            StationaryXpos = WidthVar - xRightSpace
            CurrentScreenYpos = HeightVar * 0.5                 ' start y position in the middle of the plot
            prevYpos =  CurrentScreenYpos
            YposDownLimit = HeightVar - 10   ' upper and lower limit for latest Y-position on the screen - can be changed
            YposUpLimit = HeightVar * 0.5
            LineColor = %WHITE
            first = 1
        ELSE
            LineColor = %RED
            YposUpLimit = 10
        END IF
        yMove = -1.0 * yMove ' this CORRECTION OF SIGN is made to make HIGHER Y-values move UPWARDS - for the plot to reflect real life
    
        IF yMove > yPrevMove THEN                                                        ' Y is increasing (i.e  moving DOWN !!)
    
            Ystep = yMove - yPrevMove
    
            IF CurrentScreenYpos + Ystep <= YposDownLimit THEN                           ' The Y screen position can move DOWN - and no scrolling is necessary
                yOldTop = 0 : yNewTop = 0
                CurrentScreenYpos = CurrentScreenYpos + Ystep
    
            ELSE                                                                         ' Some scrolling UP is also needed
    
                yOldTop = CurrentScreenYpos + Ystep - YposDownLimit : yNewTop = 0        ' used in GRAPHIC COPY to move previously produced part of plot UP
                CurrentScreenYpos = YposDownLimit
            END IF
    
        ELSEIF yMove < yPrevMove THEN                                                    ' Y is decreasing (i.e. moving UP !!)
    
            Ystep = yPrevMove - yMove
    
            IF CurrentScreenYpos - Ystep >= YposUpLimit THEN                             ' The Y screen position can move UP - and no scrolling is necessary
                CurrentScreenYpos = CurrentScreenYpos - Ystep
                yOldTop = 0 : yNewTop = 0
    
            ELSE                                                                         ' Some scrolling DOWN is also needed
    
                yNewTop = YposUpLimit + Ystep - CurrentScreenYpos : yOldTop = 0          ' used in GRAPHIC COPY to move previously produced part of plot DOWN
                CurrentScreenYpos = YposUpLimit
            END IF
    
        ELSE
            yOldTop = 0 : yNewTop = 0                                                    ' no upward or downward movement of plot should be made
        END IF
    
        yPrevMove = yMove                                                                ' update to new value
    
                                   ' upper left corner          lower right corner                     new position of upper left corner
        GRAPHIC COPY hDlg, GraphID, (Xstep + 1, yOldTop + 1) - (WidthVar - xRightSpace, HeightVar) TO (1, yNewTop + 1)
    
        GRAPHIC BOX (WidthVar - xRightSpace - Xstep + 2, 1) - (WidthVar - xRightSpace + 1, HeightVar), , %WHITE, %WHITE ' erase previous latest line piece
    
        IF yOldTop > 0 THEN                                                                              ' upward movement: clear lowest part of plot
            GRAPHIC BOX (1, HeightVar - yOldTop - 3) - (WidthVar-Xstep, HeightVar), , %WHITE, %WHITE
            prevYpos = prevYpos - yOldTop                                                                ' move the previous y position to draw latest part of line correctly
    
            GRAPHIC LINE (StationaryXpos - Xstep, prevYpos) - (StationaryXpos, CurrentScreenYpos), LineColor ' draw new latest part of line
    
        ELSEIF yNewTop > 0 THEN                                                                          ' downward movement: clear uppermost part of plot
            GRAPHIC BOX (1, 1) - (WidthVar-Xstep, yNewTop + 1), , %WHITE, %WHITE
            prevYpos = prevYpos + yNewTop                                                                ' move the previous y position to draw latest part of line correctly
    
            GRAPHIC LINE (StationaryXpos - Xstep, prevYpos) - (StationaryXpos, CurrentScreenYpos), LineColor  ' draw new latest part of line
    
        ELSE                                                                                             ' no vertical movement of plot - only latest Y position is moving up or down
            GRAPHIC LINE (StationaryXpos - Xstep, prevYpos) - (StationaryXpos, CurrentScreenYpos), LineColor  ' draw new latest part of line
    
        END IF
    
        prevYpos = CurrentScreenYpos                                                                     ' update the previous y position
    
    END SUB
    
    CALLBACK FUNCTION ShowDIALOG1Proc()
        STATIC hTimer AS LONG, TimerDelay AS LONG
        STATIC Last, Change, ChangePct, t AS STRING
        STATIC yMove AS SINGLE
        LOCAL LineCount, FirstVisLine AS LONG
    
        SELECT CASE AS LONG CB.MSG
            CASE %WM_INITDIALOG
                TimerDelay = 1000 * 15 ' 15 seconds - this can be changed according to need
                CALL ExtractData(Last, Change, ChangePct)
                t = TIME$ + "    S&P 500 Futures:    " + "Last: " + Last + "    Change: " + Change + "    = " + ChangePct
                CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX1, t
                Last = REMOVE$(Last, ",") : yMove = VAL(Last) * 25
                CALL Graph1(CB.HNDL, %IDC_GRAPHIC1, yMove)
                hTimer = SetTimer(CB.HNDL, BYVAL %IDC_TIMER1, BYVAL TimerDelay, BYVAL %NULL)
    
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CB.WPARAM THEN
                    ' Save control focus
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    ' Restore control focus
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
    
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE AS LONG CB.CTL
                    CASE %IDC_BUTTON1_EXIT : KillTimer CB.HNDL, %IDC_TIMER1 : DIALOG END CB.HNDL
    
                END SELECT
    
            CASE %WM_TIMER
                SELECT CASE AS LONG CB.WPARAM
                    CASE %IDC_TIMER1
                        hTimer = SetTimer(CB.HNDL, BYVAL %IDC_TIMER1, BYVAL TimerDelay, BYVAL %NULL)
                        CALL ExtractData(Last, Change, ChangePct)
                        t = t + $CRLF + TIME$ + "    S&P 500 Futures:    " + "Last: " + Last + "    Change: " + Change + "    = " + ChangePct
                        CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX1, t
                        CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_GETLINECOUNT, 0, 0 TO LineCount
                        CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_GETFIRSTVISIBLELINE, 0, 0 TO FirstVisLine
                        ' scroll down to last line
                        CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_LINESCROLL, 0, LineCount-FirstVisLine-10
                        Last = REMOVE$(Last, ",") : yMove = VAL(Last) * 25
                        CALL Graph1(CB.HNDL, %IDC_GRAPHIC1, yMove)
    
                END SELECT
    
        END SELECT
    
    END FUNCTION
    
    FUNCTION PBMAIN () AS LONG
        LOCAL hDlg  AS DWORD
        LOCAL lRslt AS LONG
        DIALOG NEW PIXELS, 0, "Extract And Display Real Time Data From A Webpage - Example", , , 600, 380, _
            %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR _
            %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
            %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
            %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
            %WS_EX_RIGHTSCROLLBAR, TO hDlg
    
        CONTROL ADD TEXTBOX,  hDlg, %IDC_TEXTBOX1, "", 10, 10, 580, 160, %WS_CHILD _
            OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR %WS_VSCROLL OR _
            %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL, %WS_EX_CLIENTEDGE OR _
            %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
    
        CONTROL ADD BUTTON,   hDlg, %IDC_BUTTON1_EXIT, "E&xit", 500, 350, 90, 20
    
        CONTROL ADD GRAPHIC,  hDlg, %IDC_GRAPHIC1, "", 10, 180, 580, 160, _
            %WS_CHILD OR %WS_VISIBLE, %WS_EX_CLIENTEDGE
        GRAPHIC ATTACH hDlg, %IDC_GRAPHIC1
        GRAPHIC COLOR -1, %WHITE
        GRAPHIC CLEAR
    
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
        FUNCTION = lRslt
    END FUNCTION
    Attached Files
    Last edited by Erik Christensen; 8 Sep 2015, 04:17 PM.
Working...
X