Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB.NET: Visual basic 2010: automaattisesti päivittyvät osakekurssit

pointer [16.01.2013 13:23:13]

#

Hei,

Innostuin sijoittamaan ja ajattelin tehdä itselleni ohjelman joka päivittää osakekurssin esimerkiksi kauppalehden sivuilta ja laskee arvon muutoksen prosentteina ja euroina jne.

Miten saan ohjelmani hakemaan kauppalehden sivuilta tietyn osakkeen kurssin textboxiini?

Kiitos vastauksista

neau33 [17.01.2013 16:36:38]

#

Moi pointer!

jos kauppalehti ei oo mikään itseisarvo niin tässä simppeli esimerkki...

'Huom! Esimerkki on väännetty SharpDevelop 4.2:lla
'Formilla:
'1 comboboxi (comboBox1),
'10 tekstiboxia (textBox1 - textBox10)
'1 timer (timer1)

Imports System.IO
Imports System.Text
Imports System.Net

Public Partial Class MainForm

	Private MyUrl As String = String.Empty
	Private IsProcessing As Boolean
	Private cboIndex As Integer = 0

	Public Sub New()
		Me.InitializeComponent()
	End Sub

	Sub MainFormLoad(sender As Object, e As EventArgs)

		MyUrl = "http://porssi.arvopaperi.fi/arvopaperi/site/" _
		+ "list.page?magic=(cc (page finshares) (submenu all) (tab quote))"

		Dim hlpstr() As String
		hlpstr = Split(GetContent(MyUrl),"class=" + Chr(34) + "listlink" + Chr(34)+ ">")

		comboBox1.Items.Add("Valitse osake")
		comboBox1.Items.Add("")

		For i As Integer = 1 To hlpstr.GetUpperBound(0) - 1
			Dim osake() As String
			osake = Split(hlpstr(i),"</a>")
			comboBox1.Items.Add(osake(0))
			Erase osake
		Next

		comboBox1.SelectedIndex = 0

		timer1.Interval = 900000
		timer1.Enabled = True
		timer1.Stop

	End Sub

	Function GetContent(ByVal URL As String) As String

		Dim request As HttpWebRequest = CType(WebRequest.Create(URL), HttpWebRequest)
		Dim response As HttpWebResponse = CType(request.GetResponse(), System.Net.HttpWebResponse)
		Return New StreamReader(response.GetResponseStream(),Encoding.Default).ReadToEnd()
		response.Close()

	End Function

	Sub GetData()

		IsProcessing = True

		Dim hlpstr() As String
		hlpstr = Split(GetContent(MyUrl),"class=" + Chr(34) + "fcol" + Chr(34)+ ">")
		Dim tiedot As String = String.Empty

		For i As Integer = 1 To hlpstr.GetUpperBound(0)
			If hlpstr(i).IndexOf(">" + comboBox1.SelectedItem.ToString + "<") > -1 Then
				tiedot =  hlpstr(i): Exit For
			End If
		Next

		Erase hlpstr

		If tiedot <> String.Empty Then

			Dim IndexCase As Integer = 0
			Dim hlp2str() As String

			If tiedot.IndexOf("class=" + Chr(34) + "negativevalue" + Chr(34)) > -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "positivevalue" + Chr(34)) = -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "nullvalue" + Chr(34)) = -1 Then
				hlpstr = Split(tiedot,"class=" + Chr(34) + "negativevalue" + Chr(34)+ ">")
			ElseIf tiedot.IndexOf("class=" + Chr(34) + "positivevalue" + Chr(34)) > -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "negativevalue" + Chr(34)) = -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "nullvalue" + Chr(34)) = -1 Then
				hlpstr = Split(tiedot,"class=" + Chr(34) + "positivevalue" + Chr(34)+ ">")
			ElseIf tiedot.IndexOf("class=" + Chr(34) + "nullvalue" + Chr(34)) > -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "negativevalue" + Chr(34)) = -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "positivevalue" + Chr(34)) = -1 Then
				hlpstr = Split(tiedot,"class=" + Chr(34) + "nullvalue" + Chr(34)+ ">")
			ElseIf tiedot.IndexOf("class=" + Chr(34) + "negativevalue" + Chr(34)) > -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "positivevalue" + Chr(34)) > -1 Then
				hlpstr = Split(tiedot,"class=" + Chr(34) + "negativevalue" + Chr(34)+ ">")
				hlp2str =  Split(tiedot,"class=" + Chr(34) + "positivevalue" + Chr(34)+ ">")
				IndexCase = 1
			ElseIf tiedot.IndexOf("class=" + Chr(34) + "negativevalue" + Chr(34)) > -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "nullvalue" + Chr(34)) > -1 Then
				hlpstr = Split(tiedot,"class=" + Chr(34) + "negativevalue" + Chr(34)+ ">")
				hlp2str =  Split(tiedot,"class=" + Chr(34) + "nullvalue" + Chr(34)+ ">")
				IndexCase = 1
			ElseIf tiedot.IndexOf("class=" + Chr(34) + "positivevalue" + Chr(34)) > -1 _
			And tiedot.IndexOf("class=" + Chr(34) + "nullvalue" + Chr(34)) > -1 Then
				hlpstr =  Split(tiedot,"class=" + Chr(34) + "positivevalue" + Chr(34)+ ">")
				hlp2str = Split(tiedot,"class=" + Chr(34) + "nullvalue" + Chr(34)+ ">")
				IndexCase = 1
			End If

			On Error GoTo ErrorHandler

			Select Case IndexCase
				Case 0
					For i As Integer = 1 To hlpstr.GetUpperBound(0)
						Me.Controls("textBox" + CStr(i)).Text = Split(hlpstr(i),"<")(0)
					Next
				Case 1
					If Split(hlpstr(1),"<")(0).IndexOf("%") > - 1 Then
						Me.Controls("textBox1" ).Text = Split(hlpstr(1),"<")(0)
						Me.Controls("textBox2").Text = Split(hlp2str(1),"<")(0)
					Else
						Me.Controls("textBox1" ).Text = Split(hlp2str(1),"<")(0)
						Me.Controls("textBox2").Text = Split(hlpstr(1),"<")(0)
					End If

			End Select

			Erase hlpstr: Erase hlp2str

			hlpstr = Split(Replace(tiedot, _
			Environment.NewLine.ToCharArray, "".ToCharArray), _
			"class=" + Chr(34) + "ra" + Chr(34) + ">")

			For i As Integer = 2 To 9
				Me.Controls("textBox" + CStr(i + 1) ).Text = _
				Trim(Split(hlpstr(i),"</")(0))
			Next

			Erase hlpstr

		End If

		IsProcessing = False
		Exit Sub

	ErrorHandler:
		Err.Clear
		On Error GoTo 0
		IsProcessing = False
		comboBox1.SelectedIndex = 0
		MsgBox("Virhe sivun tietotakenteessa")

	End Sub

	Sub ComboBox1SelectedIndexChanged(sender As Object, e As EventArgs)

		If IsProcessing Then
			comboBox1.SelectedIndex = cboIndex
			Exit Sub
		End If

		If comboBox1.SelectedIndex = 1 Then
			comboBox1.SelectedIndex = 0
			cboIndex = 0
		End If

		If 	comboBox1.SelectedIndex > 1 Then
			Try
				timer1.Stop
			Catch ex As Exception
			End Try
			cboIndex = comboBox1.SelectedIndex
			ClearBoxes
			GetData
			timer1.Start
		Else
			Try
				timer1.Stop
			Catch ex As Exception
			End Try
			ClearBoxes
		End If

	End Sub

	Sub ClearBoxes

		For Each ctl As Control In Me.Controls
			If TypeOf(ctl) Is TextBox Then
				ctl.Text = String.Empty
			End If
		Next

	End Sub

	Sub Timer1Tick(sender As Object, e As EventArgs)
		GetData
	End Sub

	Sub MainFormFormClosing(sender As Object, e As FormClosingEventArgs)

		Try
			timer1.Stop
		Catch ex As Exception
		End Try

		timer1.Enabled = False

	End Sub

End Class

neau33 [17.01.2013 23:12:56]

#

Heippa taas!

tässä vielä Excel/VBA-versiona...

Nimeä Taul1 nimellä: Kurssit
iske samaiseen tauluun 1 ActiveX comboboxi (ComboBox1)
ja luo vielä comboboxille ComboBox1_Change tapahtuma

'Taul1(Kurssit)
Private Sub ComboBox1_Change()

    If IsProcessing Then
        ComboBox1.SelectedIndex = cboIndex
        Exit Sub
    End If

    If ComboBox1.ListIndex = 1 Then
        ComboBox1.ListIndex = 0
        cboIndex = 0
    End If

    If ComboBox1.ListIndex > 1 Then
        StopTimer
        cboIndex = ComboBox1.ListIndex
        GetData
        StartTimer
    Else
        StopTimer
        ClearData
    End If

End Sub
'Module1
Private Declare Function InternetGetConnectedState Lib _
"wininet.dll" (ByRef lpSFlags As Long, ByVal dwReserved As Long) As Long

Public cboIndex As Integer
Public RunWhen As Double
Public Const cRunIntervalSeconds = 900
Public Const cRunWhat = "RunAtInterval"

Private MyUrl As String
Private IsProcessing As Boolean

Public Type InternetConnection
   Connected As Boolean
End Type

Public Function Internet() As InternetConnection
   Dim cType As Long
   Internet.Connected = InternetGetConnectedState(cType, 0&)
End Function

Sub Auto_Open()

    If Internet.Connected Then


        Sheets("Kurssit").ComboBox1.AddItem "Valitse osake"
        Sheets("Kurssit").ComboBox1.AddItem ""

        MyUrl = "http://porssi.arvopaperi.fi/arvopaperi/site/" _
        + "list.page?magic=(cc (page finshares) (submenu all) (tab quote))"

        Dim hlpstr() As String
        hlpstr = Split(GetContent(MyUrl), "class=" + Chr(34) + "listlink" + Chr(34) + ">")

        For i = 1 To UBound(hlpstr) - 1
            Dim osake() As String
            osake = Split(hlpstr(i), "</a>")
            Sheets("Kurssit").ComboBox1.AddItem osake(0)
            Erase osake
        Next i

        Erase hlpstr
    Else
        ClearData
        Sheets("Kurssit").Range("A2").Value = "EI Internet yhteyttä!"
    End If

End Sub

Sub GetData()

    ClearData

    If Not Internet.Connected Then
        Sheets("Kurssit").Range("A2").Value = "EI Internet yhteyttä!"
        Exit Sub
    End If

    IsProcessing = True

    Dim hlpstr() As String
    hlpstr = Split(GetContent(MyUrl), "class=" + Chr(34) + "fcol" + Chr(34) + ">")
    Dim tiedot As String

    For i = 1 To UBound(hlpstr) '- 1
        If InStr(hlpstr(i), ">" + Sheets("Kurssit").ComboBox1.List( _
        Sheets("Kurssit").ComboBox1.ListIndex) + "<") > 0 Then
            tiedot = hlpstr(i): Exit For
        End If
    Next

    Erase hlpstr

    If tiedot <> "" Then

        Dim hlp2Str() As String
        Dim IndexCase As Integer

        If InStr(tiedot, "class=" + Chr(34) + "negativevalue" + Chr(34)) > 0 _
        And InStr(tiedot, "class=" + Chr(34) + "positivevalue" + Chr(34)) = 0 _
        And InStr(tiedot, "class=" + Chr(34) + "nullvalue" + Chr(34)) = 0 Then
            hlpstr = Split(tiedot, "class=" + Chr(34) + "negativevalue" + Chr(34) + ">")
        ElseIf InStr(tiedot, "class=" + Chr(34) + "positivevalue" + Chr(34)) > 0 _
        And InStr(tiedot, "class=" + Chr(34) + "negativevalue" + Chr(34)) = 0 _
        And InStr(tiedot, "class=" + Chr(34) + "nullvalue" + Chr(34)) = 0 Then
            hlpstr = Split(tiedot, "class=" + Chr(34) + "positivevalue" + Chr(34) + ">")
        ElseIf InStr(tiedot, "class=" + Chr(34) + "nullvalue" + Chr(34)) > 0 _
        And InStr(tiedot, "class=" + Chr(34) + "negativevalue" + Chr(34)) = 0 _
        And InStr(tiedot, "class=" + Chr(34) + "positivevalue" + Chr(34)) = 0 Then
            hlpstr = Split(tiedot, "class=" + Chr(34) + "nullvalue" + Chr(34) + ">")
        End If

        If InStr(tiedot, "class=" + Chr(34) + "negativevalue" + Chr(34)) > 0 _
        And InStr(tiedot, "class=" + Chr(34) + "positivevalue" + Chr(34)) > 0 Then
            hlpstr = Split(tiedot, "class=" + Chr(34) + "negativevalue" + Chr(34) + ">")
            hlp2Str = Split(tiedot, "class=" + Chr(34) + "positivevalue" + Chr(34) + ">")
            IndexCase = 1
        ElseIf InStr(tiedot, "class=" + Chr(34) + "negativevalue" + Chr(34)) > 0 _
        And InStr(tiedot, "class=" + Chr(34) + "nullvalue" + Chr(34)) > 0 Then
            hlpstr = Split(tiedot, "class=" + Chr(34) + "negativevalue" + Chr(34) + ">")
            hlp2Str = Split(tiedot, "class=" + Chr(34) + "nullvalue" + Chr(34) + ">")
            IndexCase = 1
        ElseIf InStr(tiedot, "class=" + Chr(34) + "positivevalue" + Chr(34)) > 0 _
        And InStr(tiedot, "class=" + Chr(34) + "nullvalue" + Chr(34)) > 0 Then
            hlpstr = Split(tiedot, "class=" + Chr(34) + "positivevalue" + Chr(34) + ">")
            hlp2Str = Split(tiedot, "class=" + Chr(34) + "nullvalue" + Chr(34) + ">")
            IndexCase = 1
        End If

        On Error GoTo ErrorHandler

        Select Case IndexCase
            Case 0
                For i = 1 To UBound(hlpstr)
                    Cells(2, i).Value = Split(hlpstr(i), "<")(0)
                Next
            Case 1
                If InStr(Split(hlpstr(1), "<")(0), "%") > 0 Then
                    Cells(2, 1).Value = Split(hlpstr(1), "<")(0)
                    Cells(2, 2).Value = Split(hlp2Str(1), "<")(0)
                Else
                    Cells(2, 1).Value = Split(hlp2Str(1), "<")(0)
                    Cells(2, 2).Value = Split(hlpstr(1), "<")(0)
                End If
        End Select

        Erase hlpstr, hlp2Str

        hlpstr = Split(Replace(tiedot, Chr(13) + Chr(10), _
        ""), "class=" + Chr(34) + "ra" + Chr(34) + ">")

        For i = 2 To 9
            Cells(2, i + 1).Value = Trim(Split(hlpstr(i), "</")(0))
        Next

        Erase hlpstr

        End If

        IsProcessing = False
        Exit Sub

ErrorHandler:
        Err.Clear
        On Error GoTo 0
        IsProcessing = False
        ClearData
        Sheets("Kurssit").ComboBox1.ListIndex = 0
        MsgBox "Virhe sivun tietorakenteessa"

End Sub

Function GetContent(ByVal URL As String) As String

    Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    oHTTP.Open "GET", URL, False
    oHTTP.send
    GetContent = oHTTP.ResponseText
    Set oHTTP = Nothing

End Function

Sub ClearData()

    For i = 1 To 11
        Sheets("Kurssit").Cells(2, i).Value = ""
    Next

End Sub

Sub RunAtInterval()

   GetData
   StartTimer

End Sub

Public Sub StartTimer()

   RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
   Application.OnTime EarliestTime:=RunWhen, _
   Procedure:=cRunWhat, Schedule:=True

End Sub

Sub StopTimer()

   On Error Resume Next
   Application.OnTime RunWhen, "RunAtInterval", Schedule:=False

End Sub

Sub Auto_Close()

    StopTimer

End Sub

halutessaan täältä voi impata Excel 2007 demon.

pointer [18.01.2013 08:11:30]

#

Kiitos vastauksista Nea!

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta