Kontakt
DSVGO
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 SubBeim 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
© Jost Schwider, 28.08.2000-28.08.2000 - http://vb-tec.de/arrmove.htm