Auslesen der aktuellen Währungskurse der ECB (European Central Bank) Die Daten der aktuellen Wechselkurse der Europäischen Zentralbank zum Euro werden aus einer XML-Datei ausgelesen und in einem 2-dimensionalen Array bereit gestellt.
Autor:   Dietrich Herrmann	Bewertung:     [ Jetzt bewerten ]	Views:  20.290
ohne Homepage	System:  Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 6 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 4.5 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Die ECB stellt täglich die aktuellen Wechselkurse zum Euro in einer XML-Datei bereit.
Der Link dazu ist: http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml

Die folgenden zwei Funktionen habe ich geschrieben, um diese Daten in einem 2-dimensionalen Feld bereit zu stellen.

Imports System.Xml

' Internet-Adresse
Public ECPXMLAddress As String = _
    "http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml"

' Auslesen der Wechselkurse der ECB aus XML-File
Public Function getECBCurrencyExchanges(ByVal WebAddress As String) As Array
  Dim xmlReader As XmlTextReader
  Dim outArray(1, 1) As String
  Dim currStr As String = Nothing
  Dim currVstr As String = Nothing
  Dim j As Short
 
  ' Lesen der Daten vom XML-file
  xmlReader = New XmlTextReader(WebAddress)
  With xmlReader
    While .Read()
      If .Name <> "" Then
        ' Prüfen, ob da ein Node gesmes:name ist
        If .Name = "gesmes:name" Then currStr = .ReadString()
 
        For i As Integer = 0 To .AttributeCount - 1
          ' Prüfen, ob da ein Node Cube ist
          If .Name = "Cube" Then
 
            ' Prüfen, ob ein Attribut, dann Wert lesen
            If .AttributeCount = 1 Then
              .MoveToAttribute("time")
              currVstr = DateTime.Parse(.Value).ToShortDateString
            End If
 
            ' Prüfen, ob zwei Attribute, dann Wechselkurs lesen
            If .AttributeCount = 2 Then
              currStr = "" : currVstr = ""
              .MoveToAttribute("currency")
 
              ' Ergänzen der Währungsbezeichnung
              currStr = CurrencyName(.Value)
              .MoveToAttribute("rate")
              currVstr = .Value
            End If
          End If
 
          If i Mod 2 = 0 Then
            If currStr IsNot Nothing Then
              outArray(0, j) = currStr
              outArray(1, j) = currVstr
              j += 1
              ReDim Preserve outArray(1, j)
            End If
          End If
          .MoveToNextAttribute()
        Next i
      End If
    End While
  End With
  ReDim Preserve outArray(1, outArray.Length / 2 - 2)
 
  Return outArray
End Function

Public Function CurrencyName(ByVal shortName As String) As String
  Dim returnText As String = Nothing
  Select Case shortName
    Case "DKK" : returnText = "Dänemark;Danish Krone"
    Case "EUR" : returnText = "EU;Euro"
    Case "USD" : returnText = "USA;US Dollar"
    Case "GBP" : returnText = "Großbritannien;Pound Sterling"
    Case "SEK" : returnText = "Schweden;Swedish Krona"
    Case "NOK" : returnText = "Norwegen;Norwegian Krona"
    Case "CNY" : returnText = "China;Chinese Yuan Renminbi"
    Case "ISK" : returnText = "Island;Icelandic Krona"
    Case "IDR" : returnText = "Indonesien;Indonesian Rupiah"
    Case "CHF" : returnText = "Schweiz;Swiss franc"
    Case "CAD" : returnText = "Kanada;Canadian Dollar"
    Case "JPY" : returnText = "Japan;Japanese Yen"
    Case "RUB" : returnText = "Russland;Russian Rouble"
    Case "HRK" : returnText = "Kroatien;Croatian Kuna"
    Case "MYR" : returnText = "Malaysia;Malaysian Ringgit"
    Case "PHP" : returnText = "Philippinen;Philippine Peso"
    Case "THB" : returnText = "Thailand;Thai Baht"
    Case "AUD" : returnText = "Australien;Australian Dollar"
    Case "NZD" : returnText = "Neuseeland;New Zealand Dollar"
    Case "EEK" : returnText = "Estland;Estonian Kroon"
    Case "LVL" : returnText = "Lettland;Latvian Lats"
    Case "LTL" : returnText = "Litauen;Lithuanian Litas"
    Case "PLN" : returnText = "Polen;Polish Zloty"
    Case "CZK" : returnText = "Tschechien;Czech Koruna"
    Case "HUF" : returnText = "Ungarn;Hungarian Forint"
    Case "HKD" : returnText = "Hongkong;Hong Kong Dollar"
    Case "SGD" : returnText = "Singapur;Singapore Dollar"
    Case "SDR" : returnText = "Spezial;Special Drawing Rights"
    Case "BGN" : returnText = "Bulgarien;Bulgarian Lev"
    Case "CYP" : returnText = "Zypern;Cypriotic Pund"
    Case "MTL" : returnText = "Malta;Maltesic Lira"
    Case "ROL" : returnText = "Rumänien;Romanian Leu"
    Case "SIT" : returnText = "Slowenien;Slovenscy Tolar"
    Case "SKK" : returnText = "Slowakei;Slovakic Koruna"
    Case "TRY" : returnText = "Türkei;Turkish Lira"
    Case "KRW" : returnText = "Südkorea;South Korean Won"
    Case "ZAR" : returnText = "Südafrika;South African Rand"
    Case "BRL" : returnText = "Brasilien;Brasilian Real"
    Case "IDR" : returnText = "Indonesien;Indonesian Rupiah"
    Case "INR" : returnText = "Indien;Indian Rupee"
    Case "MXN" : returnText = "Mexiko;Mexican Peso"
  End Select
  If returnText IsNot Nothing Then returnText += ";" + shortName
  Return returnText
End Function

Beim Verwenden des Feldes muss man nur beachten, dass das Element (0,0) den Namen der Bank und das Element (1,0) das aktuelle Datum enthalten.

Viel Erfolg beim Bauen eines Währungsrechners!

Erweierung von Snoopy (24.09.09)
Noch eleganter lässt sich das Ganze unter VB2008 mit einer LINQ-Abfrage realisieren. Der komplette Code ist hierzu in einer eigenen Klasse ausgelagert:

Imports System.Globalization
 
' ECB Struktur
Public Structure ECBType
  Public ECBCurrency As String
  Public ECBRate As String
  Public DisplayName As String
End Structure
 
Public Class ECBExchanges
  Public Function getECBCurrencyExchanges(ByVal WebAddress As String) _
    As List(Of ECBType)
 
    Try
      Dim xr As XElement = XElement.Load(WebAddress)
      Dim xn As XNamespace = xr.Attribute("xmlns").Value
 
      Dim xECBs = From ECB In xr.Descendants(xn + "Cube") _
        Where ECB.Attribute("currency") IsNot Nothing _
        AndAlso ECB.Attribute("rate") IsNot Nothing _
        Select New ECBType With { _
          .ECBCurrency = ECB.Attribute("currency").Value, _
          .ECBRate = ECB.Attribute("rate").Value, _
          .DisplayName = CurrencyName(.ECBCurrency)}
 
      Return xECBs.ToList
    Catch ex As Exception
      Throw ex
    End Try
  End Function
 
  Private Function CurrencyName(ByVal isoCode As String) As String
    Dim cultures As CultureInfo() = CultureInfo.GetCultures( _
      CultureTypes.SpecificCultures)
 
    For Each ci As CultureInfo In cultures
      Dim ri As New RegionInfo(ci.LCID)
      If ri.ISOCurrencySymbol = isoCode Then
        Return ci.DisplayName
      End If
    Next 
    Return String.Empty
 End Function
End Class

Nachfolgender Aufruf gibt dann eine List(Of ECBType) zurück:

Private MyECB As New ECBExchanges
 
Dim ECBList As List(Of ECBType) = MyECB.getECBCurrencyExchanges( _
  "http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml")