Valeur et variation du cac40 en temps réèl.

Description

C'est un petit utilitaire qui permet de suivre en casi temps réèl la valeur du cac 40 ainsi que la variation sur la journée. Le programme utilise des api pour la connection internet et pas le control ms.

Source / Exemple :


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

Conclusion :


j'ai volontairement laissé les trois lignes qui écrivent dans le fichier.bin
mais il vaut mieux les enlever pour compiler le prg.

@ vous lire, VIC

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.