Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0777: Arrays aus Strings variabler Länge serialisieren

VB 5/6-Tipp 0777: Arrays aus Strings variabler Länge serialisieren

 von Henrik Ilgen

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory)

Download: Download des Beispielprojektes [5.08 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'---------- Anfang Projektdatei Serialization.vbp  ----------
'------- Anfang Formular "frmMain" alias frmMain.frm  -------
' Steuerelement: Schaltfläche "cmdExecuteTest"
' Steuerelement: Rahmensteuerelement "fraTestResults"
' Steuerelement: Schaltfläche "cmdDeleteResults" auf fraTestResults
' Steuerelement: Textfeld "txtTestResults" auf fraTestResults
' Steuerelement: Rahmensteuerelement "fraTestdata"
' Steuerelement: Schaltfläche "cmdDeleteString" auf fraTestdata
' Steuerelement: Schaltfläche "cmdClearStrings" auf fraTestdata
' Steuerelement: Schaltfläche "cmdAddString" auf fraTestdata
' Steuerelement: Listen-Steuerelement "lstStrings" auf fraTestdata
' Steuerelement: Rahmensteuerelement "fraTests"
' Steuerelement: Optionsfeld-Steuerelement "optTest" (Index von 1 bis 3) auf fraTests
Option Explicit

Private Sub cmdAddString_Click()
   Dim tmp As String
   
   tmp = InputBox("Bitte geben sie den neuen String ein:", "Dateneingabe")
   If tmp <> "" Then Call lstStrings.AddItem(tmp)
End Sub

Private Sub cmdClearStrings_Click()
   Call lstStrings.Clear
End Sub

Private Sub cmdDeleteResults_Click()
   txtTestResults.Text = ""
End Sub

Private Sub cmdDeleteString_Click()
   If lstStrings.ListIndex <> -1 Then Call lstStrings.RemoveItem(lstStrings.ListIndex)
End Sub

Private Sub cmdExecuteTest_Click()
   Dim tmp() As String
   Dim n As Long
   
   If optTest(1).Value Then
      Call modSerialize.WinsockTest
   ElseIf optTest(2).Value Then
      Call modSerialize.WinsockTest2
   Else
      If lstStrings.ListCount > 0 Then
         ReDim tmp(lstStrings.ListCount - 1)
      End If
      
      For n = 0 To lstStrings.ListCount - 1
         tmp(n) = lstStrings.List(n)
      Next n
      
      Call modSerialize.WinsockTest3(tmp)
   End If
End Sub

Private Sub optTest_Click(Index As Integer)
   fraTestdata.Enabled = optTest(3).Value
End Sub

Public Sub Log(expr As String)
   ' Zur Anzeige werden NullChars durch Leerzeichen ersetzt
   txtTestResults.Text = txtTestResults.Text & Replace(expr, vbNullChar, Space(1)) & vbCrLf
   txtTestResults.SelStart = Len(txtTestResults.Text)
End Sub
'-------- Ende Formular "frmMain" alias frmMain.frm  --------
'---- Anfang Modul "modSerialize" alias modSerialize.bas ----
Option Explicit

' Dieses Modul ist in der Lage, String-Arrays zu einzelnen Strings zu serialisieren, die dann
' beispielsweise über Winsock verschickt werden können.
' Zu diesem Zweck verfügt jeder String über einen Deskriptor mit drei Angaben:
'  - Die Länge des gesamten Strings (abzüglich 4 Byte)
'  - Die untere Arraygrenze
'  - Die obere Arraygrenze
' Anschließend werden die einzelnen Elemente geschrieben, wobei jedes über einen 4 Byte langen
' Deskriptor verfügt, der die Länge des Elementes angibt.

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal ByteLen As Long)

' Empfangsfenster. Hier werden alle eingehenden Daten zuerst gesammelt, bevor sie verwertet werden.
Private window As String

Private Sub WinsockReceiveData(ByVal data As String)
   ' Diese Prozedur simuliert den Empfang der Daten per Winsock.
   Dim n As Long                 ' Schleifenzähler für die Auswertung
   Dim msg() As String           ' Die aktuelle Nachricht
   
   ' Empfangene Daten an das Empfangsfenster anhängen
   window = window & data
   
   ' Solange das Empfangsfenster mindestens eine komplette Nachricht enthält:
   ' (Dies kann leicht überprüft werden, da die ersten 4 Byte jeder Nachricht ihre Länge angeben;
   '  Diese Länge steht immer am Anfang des Empfangsfensters)
   Do While Len(window) - 4 >= StringToNumber(Left$(window, 4))
      ' Die Nachricht auslesen, den überstehenden "Rest" wieder in das Empfangsfenster geben
      msg = StringToStringArray(window, window)
      
      ' Die Nachricht irgendwie verwerten
      Call frmMain.Log("Es wurde eine Nachricht empfangen:")
      
      For n = LBound(msg) To UBound(msg)
         Call frmMain.Log(" " & CStr(n) & ": " & msg(n))
      Next n
      
      Call frmMain.Log("Ende der Nachricht")
   Loop
End Sub

Private Sub WinsockSendData(ByVal data As String)
   ' Diese Prozedur simuliert die Aufsplittung der Daten in kleinere Pakete, so wie es bei Winsock passieren würde.
   ' Die zu sendenen Daten werden dabei in 128 Byte große Pakete aufgeteilt und jedes Paket wird einzeln
   ' an die ReceiveData-Prozedur weitergeleitet.
   '
   ' In einem tatsächlichen Programm muss man sich diese Mühe natürlich nicht machen ;)
   Dim start As Long: start = 1
   
   Do While start < Len(data)
      If Len(data) - start > 128 Then
         Call WinsockReceiveData(Mid$(data, start, 128))
         start = start + 128
      Else
         Call WinsockReceiveData(Mid$(data, start, Len(data) - start + 1))
         start = Len(data)
      End If
   Loop
End Sub

Public Sub WinsockTest()
   ' Eine Testprozedur, die zeigt, dass die Daten korrekt ausgegeben werden.
   Dim tmp() As String           ' Temporäres String-Array
   Dim data As String            ' Zu sendende Daten
   
   tmp = Split("abc,def,ghi,jkl,mno,pqr,stu,vwx,yz", ",")
   data = StringArrayToString(tmp)
   tmp = Split("abcd,efgh,ijkl,mnop,qrst,uvwx,yz", ",")
   data = data & StringArrayToString(tmp)
   tmp = Split("1,2,3,4,5,6,7,8,9,0", ",")
   data = data & StringArrayToString(tmp)
   
   Call frmMain.Log("Testdaten: ")
   Call frmMain.Log(data)
   Call frmMain.Log("(Länge: " & CStr(Len(data)) & "byte)")
   
   Call WinsockSendData(data)
End Sub

Public Sub WinsockTest2()
   ' Eine Testprozedur, die zufällig erstellte Strings sendet.
   Dim tmp(1 To 100) As String
   Dim data As String
   Dim n As Long
   Dim x As Long
   Dim length As Long
   
   For n = 1 To 100
      length = Rnd() * 100
      
      tmp(n) = Space(length)
      For x = 1 To length
         Mid$(tmp(n), x, 1) = Chr$(Rnd() * 255)
      Next x
   Next n
   
   data = StringArrayToString(tmp)
   
   Call frmMain.Log("Testdaten: ")
   Call frmMain.Log(data)
   Call frmMain.Log("(Länge: " & CStr(Len(data)) & "byte)")
   
   Call WinsockSendData(data)
End Sub

Public Sub WinsockTest3(expr() As String)
   ' Eine Testprozedur, die Benutzerdefinierte Daten benutzt.
   Dim data As String
   
   data = StringArrayToString(expr)
   
   Call frmMain.Log("Testdaten: ")
   Call frmMain.Log(data)
   Call frmMain.Log("(Länge: " & CStr(Len(data)) & "byte)")
   
   Call WinsockSendData(data)
End Sub

Public Function StringArrayToString(expr() As String) As String
   ' Diese Funktion serialisiert ein Stringarray, um es später wieder deserialisieren zu können.
   Dim n As Long                 ' Schleifenzähler
   
   On Error Goto err_SATS
   
   ' Arraygrenzen in den Deskriptor schreiben
   StringArrayToString = NumberToString(LBound(expr)) & NumberToString(UBound(expr))
   
   ' Alle Elemente schreiben
   For n = LBound(expr) To UBound(expr)
      '                                               Längendeskriptor           Element
      StringArrayToString = StringArrayToString & NumberToString(Len(expr(n))) & expr(n)
   Next n
   
   ' Die Gesamtlänge des Strings vor den String an sich schreiben
   StringArrayToString = NumberToString(Len(StringArrayToString)) & StringArrayToString
   
   Exit Function
   
err_SATS:
   ' Im Fehlerfall einen vordefinierten String zurückgeben, der ein Array mit
   ' 1 leeren Eintrag codiert
   StringArrayToString = NumberToString(12) & NumberToString(0) & NumberToString(0) & NumberToString(0)
End Function

Public Function StringToStringArray(ByVal expr As String, Optional ByRef rest As String) As String()
   ' Diese Funktion deserialisiert einen String und gibt ein Stringarray zurück.
   
   Dim n As Long                 ' Schleifenzähler
   Dim start As Long             ' Lesezeiger (zeigt die aktuelle Position in expr an, die ausgewertet wird)
   Dim totalLength As Long       ' Totale Länge des zu lesenden Strings (ohne Längenangabe)
   Dim lb As Long, ub As Long    ' Arraygrenzen
   Dim length As Long            ' Länge des aktuell ausgewerteten Elements
   Dim ret() As String           ' Temporäres Array für die Rückgabe
   
   ' Absolute Länge auslesen (wichtig, um ggf. überstehenden Anteil abzuschneiden und zurückzugeben)
   totalLength = StringToNumber(Mid$(expr, 1, 4))
   ' Arraygrenzen auslesen
   lb = StringToNumber(Mid$(expr, 5, 4))
   ub = StringToNumber(Mid$(expr, 9, 4))
   
   ' Arraygrenzen festlegen
   ReDim ret(lb To ub)
   
   ' Lesezeiger auf den Beginn des Datenbereichs legen
   start = 13
   
   ' Alle Elemente auslesen
   For n = lb To ub
      ' Länge des Elements auslesen
      length = StringToNumber(Mid$(expr, start, 4))
      ' Das Element selbst auslesen
      ret(n) = Mid$(expr, start + 4, length)
      
      ' Lesezeiger weiterschieben
      start = start + 4 + length
   Next n
   
   ' Den überstehenden Rest zurückgeben
   rest = Right$(expr, Len(expr) - 4 - totalLength)
   
   ' Das Array zurückgeben
   StringToStringArray = ret
End Function

Private Function NumberToString(ByVal expr As Long) As String
   Dim BA(3) As Byte             ' Das Bytearray, das die Zahl repräsentiert
   
   ' Den Long in das Bytearray kopieren
   Call CopyMemory(ByVal VarPtr(BA(0)), ByVal VarPtr(expr), 4)
   ' Das Bytearray in einen String konvertieren und zurückgeben
   NumberToString = StrConv(BA, vbUnicode)
End Function

Private Function StringToNumber(ByVal expr As String) As Long
   Dim BA() As Byte              ' Das Bytearray, das die Zahl repräsentiert
   
   ' Wenn ein leerer String übergeben wird, 0 zurückgeben
   If expr = "" Then
      StringToNumber = 0
      Exit Function
   End If

   ' Den String in ein Array aus Bytes konvertieren
   BA = StrConv(expr, vbFromUnicode)
   ' Die Bytes in einen Long kopieren
   Call CopyMemory(ByVal VarPtr(StringToNumber), ByVal VarPtr(BA(0)), 4)
End Function

'----- Ende Modul "modSerialize" alias modSerialize.bas -----
'----------- Ende Projektdatei Serialization.vbp  -----------