daheads blog²

Hier eine kleine Klasse, die VCard-Dateien erstellen kann.
Wie man die Klasse aufruft, zeige ich am Ende dieses Eintrags.

Klasse VCard.vb:

Public Class VCard
 
  Private _VCardData As List(Of String)
  Public Property VCardData() As List(Of String)
    Get
      If _VCardData Is Nothing Then
        _VCardData = New List(Of String)
      End If
      Return _VCardData
    End Get
    Set(ByVal value As List(Of String))
      _VCardData = value
    End Set
  End Property
 
  Public InternalName As String
 
  Public VORNAME As String
  Public NACHNAME As String
  Public STRASSE As String
  Public ORT As String
  Public PLZ As String
  Public LAND As String
  Public TELEFONNUMMER As String
  Public TELEFAXNUMMER As String
  Public MOBILNUMMER As String
  Public MAILADRESSE As String
 
  Public Sub New(ByVal aInternalName As String)
 
    Me.InternalName = aInternalName
 
    Me.VCardData.Add("BEGIN:VCARD")
    Me.VCardData.Add("VERSION:2.1")
    Me.VCardData.Add("FN:%VORNAME% %NACHNAME%")
    Me.VCardData.Add("N:%NACHNAME%;%VORNAME%")
    Me.VCardData.Add("ADR;HOME:;;%STRASSE%;%ORT%;;%PLZ%;%LAND%")
    Me.VCardData.Add("TEL;HOME;VOICE:%TELEFONNUMMER%")
    Me.VCardData.Add("TEL;CELL:%MOBILNUMMER%")
    Me.VCardData.Add("TEL;HOME;FAX:%TELEFAXNUMMER%")
    Me.VCardData.Add("EMAIL;WORK;PREF;INTERNET:%MAILADRESSE%")
    Me.VCardData.Add("END:VCARD")
 
  End Sub
 
  ''' <summary>
  ''' Anhand der Felder werden sämtliche Informationen in VCardData durch die jeweiligen Feldwerte ersetzt
  ''' </summary>
  ''' <remarks></remarks>
  Public Sub Fill()
 
    Dim fis As System.Reflection.FieldInfo() = Me.GetType().GetFields()
 
    Dim strReplace As String = String.Empty
    Dim strSearch As String = String.Empty
 
    ' Durch jede Zeile
    For i As Integer = 0 To Me.VCardData.Count - 1
 
      ' Zeile merken
      Dim line As String = Me.VCardData(i)
      If Not line.Contains("%") Then GoTo NextLine
 
      ' Durch alle Felder
      For Each fi As System.Reflection.FieldInfo In fis
 
        strSearch = "%" & fi.Name.ToUpper & "%"
        strReplace = fi.GetValue(Me)
 
        ' Debug.Print("Replacing: " & line & " with: " & strSearch & " - " & strReplace)

        line = Replace(line, strSearch, strReplace)
 
      Next
 
      Me.VCardData(i) = line
 
NextLine:
    Next
 
  End Sub
 
  Public Sub ExportToPath(ByVal aDirectory As String)
 
    ' Mich mit Daten füllen
    Me.Fill()
 
    ' Text für VCard Datei generieren
    Dim strVCardData As String = String.Empty
    For Each line As String In Me.VCardData
      If strVCardData = String.Empty Then
        strVCardData = line
      Else
        strVCardData += vbNewLine & line
      End If
 
    Next
 
    ' Datei schreiben
    My.Computer.FileSystem.WriteAllText(aDirectory & "\" & Me.InternalName & ".vcf", strVCardData, False, System.Text.Encoding.ASCII)
 
  End Sub
 
End Class

Klasse VCardList.vb:

Public Class VCardList
 
  Inherits List(Of VCard)
 
End Class

Aufruf:

Public Class SCVCardCreator
 
  Public Sub New()
  End Sub
 
  Private Function GetList() As VCardList
 
    Dim Result As New VCardList
 
    Using con As New SqlClient.SqlConnection(My.Settings.SQLConnectionString)
 
      Try
        con.Open()
      Catch ex As Exception
        Return Nothing
      End Try
 
      Dim strSQL As String = "Select * From Datenquelle"
 
      Using cmd As New SqlClient.SqlCommand(strSQL, con)
 
        Using dr As SqlClient.SqlDataReader = cmd.ExecuteReader
 
          Do While dr.Read
 
            Try
 
              Dim vcard As New VCard(dr.Item("MAB_NACHNAME"))
              With vcard
 
                Try
                  .VORNAME = dr.Item("MAB_VORNAME")
                Catch ex As Exception
                End Try
 
                Try
                  .NACHNAME = dr.Item("MAB_NACHNAME")
                Catch ex As Exception
                End Try
 
             End With
 
              Result.Add(vcard)
 
            Catch ex As Exception
 
            End Try
 
          Loop
 
        End Using
 
      End Using
 
      con.Close()
    End Using
 
    Return Result
 
  End Function
 
  Public Sub ExportToPath(ByVal aDirectory As String)
 
    Dim lst As VCardList = Me.GetList
 
    For Each vcard As VCard In lst
      vcard.ExportToPath(aDirectory)
    Next
 
  End Sub
 
End Class