VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Mit den folgenden Routinen können Zahlen (hier: Long, andere numerische Datentypen funktionieren analog) und Strings blitzschnell an einer bestimmten Position in einem Array eingefügt bzw. gelöscht werden. Dies geschieht mit der API-Routine RtlMoveMemory, die (fast beliebige) Speicherbereiche kopieren kann:

Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
    ByVal DestPtr As Long, ByVal SourcePtr As Long, _
    ByVal Bytes As Long)

Public Const MaximumLng As Long = 2147483647
Public Const MinimumLng As Long = -MaximumLng - 1

Public Sub ArrayInsertLng( _
    ByRef ArrayLng() As Long, _
    ByVal Index As Long, _
    Optional ByVal MaxIndex As Long = MinimumLng, _
    Optional ByVal Value As Long = 0)
  
  'Ggf. MaxIndex selbst bestimmen:
  If MaxIndex < Index Then MaxIndex = UBound(ArrayLng)
  
  'Einträge verschieben:
  If Index < MaxIndex Then RtlMoveMemory _
      VarPtr(ArrayLng(Index + 1)), VarPtr(ArrayLng(Index)), _
      VarPtr(ArrayLng(MaxIndex)) - VarPtr(ArrayLng(Index))
  
  'Neuen Wert setzen:
  ArrayLng(Index) = Value
End Sub

Public Sub ArrayDeleteLng( _
    ByRef ArrayLng() As Long, _
    ByVal Index As Long, _
    Optional ByVal MaxIndex As Long = MinimumLng, _
    Optional ByVal Value As Long = 0)
  
  'Ggf. MaxIndex selbst bestimmen:
  If MaxIndex < Index Then MaxIndex = UBound(ArrayLng)
  
  'Einträge verschieben:
  If Index < MaxIndex Then RtlMoveMemory _
      VarPtr(ArrayLng(Index)), VarPtr(ArrayLng(Index + 1)), _
      VarPtr(ArrayLng(MaxIndex)) - VarPtr(ArrayLng(Index))
  
  'Neuen Wert setzen:
  ArrayLng(MaxIndex) = Value
End Sub

Beim Datentyp String werden im Array nur die Adressen zu den eigentlichen Nutzdaten gespeichert. Diese dürfen nicht einfach überschrieben werden, da sonst Zeiger in undefinierte Regionen weisen, was letztendlich zu Schutzverletzungen führen würde. Daher muss vor dem Kopiervorgang die zu überschreibende String-Adresse gesichert werden, um sie anschließend an der freigewordenen Position wiederzuverwenden:

Public Sub ArrayInsertStr( _
    ByRef ArrayStr() As String, _
    ByVal Index As Long, _
    Optional ByVal MaxIndex As Long = MinimumLng, _
    Optional ByVal Value As String = vbNullString)
  'Deklaration:
  Dim StringPtr As Long
  
  'Ggf. MaxIndex selbst bestimmen:
  If MaxIndex < Index Then MaxIndex = UBound(ArrayStr)
  
  'Einträge verschieben:
  If Index < MaxIndex Then
    StringPtr = StrPtr(ArrayStr(MaxIndex))
    RtlMoveMemory _
        VarPtr(ArrayStr(Index + 1)), VarPtr(ArrayStr(Index)), _
        VarPtr(ArrayStr(MaxIndex)) - VarPtr(ArrayStr(Index))
    RtlMoveMemory _
        VarPtr(ArrayStr(Index)), VarPtr(StringPtr), _
        Len(StringPtr)
  End If
  
  'Neuen Wert setzen:
  ArrayStr(Index) = Value
End Sub

Public Sub ArrayDeleteStr( _
    ByRef ArrayStr() As String, _
    ByVal Index As Long, _
    Optional ByVal MaxIndex As Long = MinimumLng, _
    Optional ByVal Value As String = vbNullString)
  'Deklaration:
  Dim StringPtr As Long
  
  'Ggf. MaxIndex selbst bestimmen:
  If MaxIndex < Index Then MaxIndex = UBound(ArrayStr)
  
  'Einträge verschieben:
  If Index < MaxIndex Then
    StringPtr = StrPtr(ArrayStr(Index))
    RtlMoveMemory _
        VarPtr(ArrayStr(Index)), VarPtr(ArrayStr(Index + 1)), _
        VarPtr(ArrayStr(MaxIndex)) - VarPtr(ArrayStr(Index))
    RtlMoveMemory _
        VarPtr(ArrayStr(MaxIndex)), VarPtr(StringPtr), _
        Len(StringPtr)
  End If
  
  'Neuen Wert setzen:
  ArrayStr(MaxIndex) = Value
End Sub