web-dev-qa-db-fra.com

Comment déterminer si un tableau est initialisé dans VB6?

Le passage d'un tableau non dimensionné à la fonction Ubound du VB6 provoquera une erreur. Je souhaite donc vérifier s'il a été dimensionné avant d'essayer de vérifier sa limite supérieure. Comment puis-je faire cela?

arraysvb6
49
raven

Voici ce que je suis allé avec. Ceci est similaire à answer de GSerg, mais utilise la fonction API CopyMemory la mieux documentée et est entièrement autonome (vous pouvez simplement passer le tableau plutôt que ArrPtr (tableau) à cette fonction). Il utilise la fonction VarPtr, contre laquelle Microsoft met en garde , mais il s’agit d’une application réservée à XP, et cela fonctionne, donc je ne suis pas concerné.

Oui, je sais que cette fonction acceptera tout ce que vous lui lancez, mais je laisserai la vérification des erreurs comme un exercice pour le lecteur.

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Public Function ArrayIsInitialized(arr) As Boolean

  Dim memVal As Long

  CopyMemory memVal, ByVal VarPtr(arr) + 8, ByVal 4 'get pointer to array
  CopyMemory memVal, ByVal memVal, ByVal 4  'see if it points to an address...  
  ArrayIsInitialized = (memVal <> 0)        '...if it does, array is intialized

End Function
13
raven

J'utilise ceci:

Public Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long

Public Function StrArrPtr(arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long
  GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr)
End Function

Public Function UDTArrPtr(ByRef arr As Variant) As Long
  If VarType(arr) Or vbArray Then
    GetMem4 VarPtr(arr) + 8, VarPtr(UDTArrPtr)
  Else
    Err.Raise 5, , "Variant must contain array of user defined type"
  End If
End Function


Public Function ArrayExists(ByVal ppArray As Long) As Long
  GetMem4 ppArray, VarPtr(ArrayExists)
End Function

Usage:

? ArrayExists(ArrPtr(someArray))

? ArrayExists(StrArrPtr(someArrayOfStrings))

? ArrayExists(UDTArrPtr(someArrayOfUDTs))

Votre code semble faire la même chose (tester SAFEARRAY ** étant NULL), mais d'une manière que je considérerais comme un bogue du compilateur :)

22
GSerg

Je viens de penser à celui-ci. Assez simple, aucun appel d'API requis. Des problèmes avec ça?

Public Function IsArrayInitialized(arr) As Boolean

  Dim rv As Long

  On Error Resume Next

  rv = UBound(arr)
  IsArrayInitialized = (Err.Number = 0)

End Function

Edit : J'ai découvert une faille liée au comportement de la fonction Split (en fait, je l'appellerais une faille dans la fonction Split). Prenons cet exemple:

Dim arr() As String

arr = Split(vbNullString, ",")
Debug.Print UBound(arr)

Quelle est la valeur de Ubound (arr) à ce stade? C'est -1! Ainsi, le passage de ce tableau à cette fonction IsArrayInitialized renverrait la valeur true, mais la tentative d'accès à arr (0) provoquerait une erreur d'erreur en dehors de l'intervalle.

16
raven

J'ai trouvé ça:

Dim someArray() As Integer

If ((Not someArray) = -1) Then
  Debug.Print "this array is NOT initialized"
End If

Edit: RS Conley a souligné dans son answer que (pas un tableau) retournera parfois 0, vous devez donc utiliser ((pas un tableau) = -1).

12
raven

GSerg et Raven sont des méthodes non documentées, mais comme Visual BASIC 6 n'est plus en développement, ce n'est pas un problème. Cependant, l'exemple de Raven ne fonctionne pas sur toutes les machines. Vous devez tester comme ça.

Si (pas un tableau) = -1 alors

Sur certaines machines, il retournera un zéro sur d'autres, un nombre négatif important.

8
RS Conley

Dans VB6, il existe une fonction appelée "IsArray", mais elle ne vérifie pas si le tableau a été initialisé. Vous recevrez l'erreur 9 - Indice en dehors des limites si vous essayez d'utiliser UBound sur un tableau non initialisé. Ma méthode est très similaire à celle de S J, sauf qu'elle fonctionne avec tous les types de variables et gère les erreurs. Si une variable non-tableau est cochée, vous recevrez l'erreur 13 - Incompatibilité de type.

Private Function IsArray(vTemp As Variant) As Boolean
    On Error GoTo ProcError
    Dim lTmp As Long

    lTmp = UBound(vTemp) ' Error would occur here

    IsArray = True: Exit Function
ProcError:
    'If error is something other than "Subscript
    'out of range", then display the error
    If Not Err.Number = 9 Then Err.Raise (Err.Number)
End Function
5
iCodeInVB6

Ceci est une modification de answer de corbeau. Sans utiliser les API.

Public Function IsArrayInitalized(ByRef arr() As String) As Boolean
'Return True if array is initalized
On Error GoTo errHandler 'Raise error if directory doesnot exist

  Dim temp As Long
  temp = UBound(arr)

  'Reach this point only if arr is initalized i.e. no error occured
  If temp > -1 Then IsArrayInitalized = True 'UBound is greater then -1

Exit Function
errHandler:
  'if an error occurs, this function returns False. i.e. array not initialized
End Function

Celui-ci devrait également fonctionner en cas de division de la fonction . La limite est que vous auriez besoin de définir le type de tableau (chaîne dans cet exemple).

3
SJ00
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long

Private Type SafeArray
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
End Type

Private Function ArrayInitialized(ByVal arrayPointer As Long) As Boolean
    Dim pSafeArray As Long

    CopyMemory pSafeArray, ByVal arrayPointer, 4

    Dim tArrayDescriptor As SafeArray

    If pSafeArray Then
        CopyMemory tArrayDescriptor, ByVal pSafeArray, LenB(tArrayDescriptor)

        If tArrayDescriptor.cDims > 0 Then ArrayInitialized = True
    End If

End Function

Usage:

Private Type tUDT
    t As Long
End Type

Private Sub Form_Load()
    Dim longArrayNotDimmed() As Long
    Dim longArrayDimmed(1) As Long

    Dim stringArrayNotDimmed() As String
    Dim stringArrayDimmed(1) As String

    Dim udtArrayNotDimmed() As tUDT
    Dim udtArrayDimmed(1) As tUDT

    Dim objArrayNotDimmed() As Collection
    Dim objArrayDimmed(1) As Collection


    Debug.Print "longArrayNotDimmed " & ArrayInitialized(ArrPtr(longArrayNotDimmed))
    Debug.Print "longArrayDimmed " & ArrayInitialized(ArrPtr(longArrayDimmed))

    Debug.Print "stringArrayNotDimmed " & ArrayInitialized(ArrPtr(stringArrayNotDimmed))
    Debug.Print "stringArrayDimmed " & ArrayInitialized(ArrPtr(stringArrayDimmed))

    Debug.Print "udtArrayNotDimmed " & ArrayInitialized(ArrPtr(udtArrayNotDimmed))
    Debug.Print "udtArrayDimmed " & ArrayInitialized(ArrPtr(udtArrayDimmed))

    Debug.Print "objArrayNotDimmed " & ArrayInitialized(ArrPtr(objArrayNotDimmed))
    Debug.Print "objArrayDimmed " & ArrayInitialized(ArrPtr(objArrayDimmed))

    Unload Me
End Sub
2
Frodo

Basé sur toutes les informations que j'ai lues dans ce post existant, cela fonctionne le mieux pour moi lorsqu'il s'agit d'un tableau typé qui commence comme non initialisé. 

Il maintient le code de test cohérent avec l'utilisation de UBOUND et n'exige pas l'utilisation du traitement des erreurs pour les tests.

Il IS dépend des tableaux à base zéro (ce qui est le cas dans la plupart des développements).

Ne pas utiliser "Erase" pour effacer le tableau. utilisez l’alternative indiquée ci-dessous.

Dim data() as string ' creates the untestable holder.
data = Split(vbNullString, ",") ' causes array to return ubound(data) = -1
If Ubound(data)=-1 then ' has no contents
    ' do something
End If
redim preserve data(Ubound(data)+1) ' works to increase array size regardless of it being empty or not.

data = Split(vbNullString, ",") ' MUST use this to clear the array again.
1
DarrenMB

Pour toute variable déclarée en tant que tableau, vous pouvez facilement vérifier si le tableau est initialisé en appelant l'API SafeArrayGetDim. Si le tableau est initialisé, la valeur de retour sera différente de zéro, sinon la fonction renvoie zéro.

Notez que vous ne pouvez pas utiliser cette fonction avec des variantes contenant des tableaux. Cela provoquerait une erreur de compilation (incompatibilité de type).

Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (psa() As Any) As Long

Public Sub Main()
    Dim MyArray() As String

    Debug.Print SafeArrayGetDim(MyArray)    ' zero

    ReDim MyArray(64)
    Debug.Print SafeArrayGetDim(MyArray)    ' non-zero

    Erase MyArray
    Debug.Print SafeArrayGetDim(MyArray)    ' zero

    ReDim MyArray(31, 15, 63)
    Debug.Print SafeArrayGetDim(MyArray)    ' non-zero

    Erase MyArray
    Debug.Print SafeArrayGetDim(MyArray)    ' zero

    ReDim MyArray(127)
    Debug.Print SafeArrayGetDim(MyArray)    ' non-zero

    Dim vArray As Variant
    vArray = MyArray
    ' If you uncomment the next line, the program won't compile or run.
    'Debug.Print SafeArrayGetDim(vArray)     ' <- Type mismatch
End Sub
1
Scruff

Le moyen le plus simple de gérer ceci est de s'assurer que le tableau est initialisé avant que vous deviez vérifier le Ubound. J'avais besoin d'un tableau déclaré dans la zone (Général) du code de formulaire .

Dim arySomeArray() As sometype

Puis, dans la routine de chargement de formulaire, je redimine le tableau:

Private Sub Form_Load()

ReDim arySomeArray(1) As sometype 'insure that the array is initialized

End Sub

Cela permettra au tableau d'être redéfini à tout moment ultérieurement dans le programme . Lorsque vous saurez quelle taille le tableau doit avoir, il doit simplement être redim.

ReDim arySomeArray(i) As sometype 'i is the size needed to hold the new data
1
Kip Densley

Lorsque vous initialisez le tableau, définissez un entier ou un booléen avec un indicateur = 1. et interrogez-le lorsque vous en avez besoin.

1
jorge

Le titre de la question demande comment déterminer si un tableau est initialisé, mais après avoir lu la question, il semble que le vrai problème consiste à obtenir la valeur UBound d'un tableau non initialisé. 

Voici ma solution (au problème actuel, pas au titre):

Function UBound2(Arr) As Integer
  On Error Resume Next
  UBound2 = UBound(Arr)
  If Err.Number = 9 Then UBound2 = -1
  On Error GoTo 0
End Function

Cette fonction fonctionne dans les quatre scénarios suivants, les trois premiers que j'ai trouvés lorsque Arr est créé par un COM externe dll et le quatrième lorsque Arr n'est pas ReDim- (l'objet de cette question):

  • UBound(Arr) fonctionne, appeler UBound2(Arr) ajoute un peu de frais généraux, mais ne fait pas mal
  • UBound(Arr) échoue dans la fonction qui définit Arr, mais réussit à l'intérieur de UBound2()
  • UBound(Arr) échoue à la fois dans la fonction qui définit Arr et dans UBound2(), la gestion des erreurs effectue donc le travail
  • Après Dim Arr() As Whatever, avant ReDim Arr(X)
0
stenci

Il existe deux scénarios légèrement différents à tester:

  1. Le tableau est initialisé (en réalité ce n'est pas un pointeur nul)
  2. Le tableau est initialisé et a au moins un élément

Le cas 2 est requis pour des cas tels que Split(vbNullString, ",") qui renvoie un tableau String avec LBound=0 et UBound=-1. Voici les exemples de fragments de code les plus simples que je puisse produire pour chaque test:

Public Function IsInitialised(arr() As String) As Boolean
  On Error Resume Next
  IsInitialised = UBound(arr) <> 0.5
End Function

Public Function IsInitialisedAndHasElements(arr() As String) As Boolean
  On Error Resume Next
  IsInitialisedAndHasElements = UBound(arr) >= LBound(arr)
End Function
0
Bucket123

Mon seul problème avec les appels d'API est de passer de systèmes d'exploitation 32 bits à 64 bits.
Cela fonctionne avec des objets, des chaînes, etc ... 

Public Function ArrayIsInitialized(ByRef arr As Variant) As Boolean
    On Error Resume Next
    ArrayIsInitialized = False
    If UBound(arr) >= 0 Then If Err.Number = 0 Then ArrayIsInitialized = True
End Function
0
Tim.F
If ChkArray(MyArray)=True then
   ....
End If

Public Function ChkArray(ByRef b) As Boolean
    On Error goto 1
    If UBound(b) > 0 Then ChkArray = True
End Function
0
Senchiu Peter

Vous pouvez résoudre le problème avec la fonction Ubound(), vérifiez si le tableau est vide en récupérant le nombre total d'éléments à l'aide de l'objet VBArray() de JScript (fonctionne avec les tableaux de type variant, simples ou multidimensionnels):

Sub Test()

    Dim a() As Variant
    Dim b As Variant
    Dim c As Long

    ' Uninitialized array of variant
    ' MsgBox UBound(a) ' gives 'Subscript out of range' error
    MsgBox GetElementsCount(a) ' 0

    ' Variant containing an empty array
    b = Array()
    MsgBox GetElementsCount(b) ' 0

    ' Any other types, eg Long or not Variant type arrays
    MsgBox GetElementsCount(c) ' -1

End Sub

Function GetElementsCount(aSample) As Long

    Static oHtmlfile As Object ' instantiate once

    If oHtmlfile Is Nothing Then
        Set oHtmlfile = CreateObject("htmlfile")
        oHtmlfile.parentWindow.execScript ("function arrlength(arr) {try {return (new VBArray(arr)).toArray().length} catch(e) {return -1}}"), "jscript"
    End If
    GetElementsCount = oHtmlfile.parentWindow.arrlength(aSample)

End Function

Pour moi, il faut environ 0,4 mksec pour chaque élément + 100 ms d'initialisation, compilé avec VB 6.0.9782, de sorte que le tableau de 10 millions d'éléments prend environ 4,1 s. La même fonctionnalité pourrait être implémentée via ScriptControl ActiveX.

0
omegastripes