VALEUR ET VARIATION DU CAC40 EN TEMPS RÉÈL.

Option Explicit
'--------------
Private Const sUrl = "http://bourse.tf1.fr/cours_indices.phtml?symbole=1rPCAC"

Private Sub Update()
    Dim lngOpen             As Long
    Dim lngOpenUrl          As Long
    Dim lngRetVal           As Long
    Dim lngBytes            As Long
    Dim blnDown             As Boolean
    Dim sBuffer             As String * 2048
    Dim sResult             As String
    Dim intDebut            As Integer
    
    lngOpen = InternetOpen(scUserAgent, _
              INTERNET_OPEN_TYPE_PRECONFIG, _
              vbNullString, vbNullString, 0)
    
    If lngOpen = 0 Then
        MsgBox "il y a un problème avec votre connection internet"
        Exit Sub
    End If
    ' ----
    lngOpenUrl = InternetOpenUrl(lngOpen, sUrl, _
                vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
    
    If lngOpenUrl = 0 Then
        MsgBox "le site internet de tf1 n'est pas disponible"
        Exit Sub
    End If
    ' ----
    blnDown = True
    While blnDown
        sBuffer = vbNullString
        lngRetVal = InternetReadFile(lngOpenUrl, _
                    sBuffer, Len(sBuffer), lngBytes)
       If lngRetVal = 0 Then
            MsgBox "problème de lecture de la page": Exit Sub
            Exit Sub
        End If
        sResult = sResult & Left$(sBuffer, lngBytes)
        If Not CBool(lngBytes) Then blnDown = False
        DoEvents
    Wend
    ' ----
    'Open App.Path & "\fichier.bin" For Output As #1
    'Print #1, sResult
    'Close #1
    
    intDebut = InStr(sResult, "<!-- TABLEAU COURS-->")
    
    lblValeur.Caption = Replace(Mid(sResult, intDebut + 160, 7), ">", "")
    lblVariation.Caption = Mid(sResult, intDebut + 253, 6)
End Sub

Private Sub Check1_Click()
    
    If Check1.Value = vbChecked Then
        MakeTopMost Me.hwnd
    Else
        MakeNormal Me.hwnd
    End If
    
End Sub

Private Sub Form_Load()
    Update
    MakeTopMost Me.hwnd
End Sub

Private Sub tm_Timer()
    Update
End Sub

Télécharger le zip