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

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 Ssortingng, 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(someArrayOfSsortingngs)) 

 ? ArrayExists(UDTArrPtr(someArrayOfUDTs)) 

Votre code semble faire la même chose (le test de SAFEARRAY ** étant NULL), mais d’une manière que je considérerais comme un bogue de compilateur 🙂

Je viens de penser à celui-ci. Assez simple, aucun appel API requirejs. 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 un défaut lié au comportement de la fonction Split (en fait je l’appellerais une faille dans la fonction Split). Prenons cet exemple:

 Dim arr() As Ssortingng arr = Split(vbNullSsortingng, ",") 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 true, mais une tentative d’access à arr (0) provoquerait une erreur d’indice hors plage.

Voici ce que j’ai fait avec. Ceci est similaire à la réponse de GSerg, mais utilise la fonction API CopyMemory 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 XP uniquement, et cela fonctionne, donc je ne suis pas concerné.

Oui, je sais que cette fonction acceptera tout ce que vous lui jetterez, 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 

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 sa réponse que (Not someArray) renverra parfois 0, il faut donc utiliser ((Not someArray) = -1).

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

If (Not someArray) = -1 Alors

Sur certaines machines, il retournera un zéro sur les autres avec un grand nombre négatif.

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 hors limites si vous tentez 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 qu’elle comporte une gestion des erreurs. Si une variable autre qu’un 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 

Ceci est une modification de la réponse du corbeau. Sans utiliser les API.

 Public Function IsArrayInitalized(ByRef arr() As Ssortingng) 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 ie 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. ie array not initialized End Function 

Celui-ci devrait également fonctionner en cas de fonction split. La limitation est que vous devez définir le type de tableau (chaîne dans cet exemple).

 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 ssortingngArrayNotDimmed() As Ssortingng Dim ssortingngArrayDimmed(1) As Ssortingng 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 "ssortingngArrayNotDimmed " & ArrayInitialized(ArrPtr(ssortingngArrayNotDimmed)) Debug.Print "ssortingngArrayDimmed " & ArrayInitialized(ArrPtr(ssortingngArrayDimmed)) 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 

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

Sur la base de toutes les informations que je lis dans cet article existant, cela fonctionne le mieux pour moi quand il s’agit d’un tableau typé qui démarre comme non initialisé.

Il maintient le code de test compatible avec l’utilisation d’UBOUND et ne nécessite pas l’utilisation de la gestion des erreurs pour les tests.

Il est dépendant de tableaux basés sur zéro (ce qui est le cas dans la plupart des développements).

Ne pas utiliser “Effacer” pour effacer le tableau. utiliser une alternative listée ci-dessous.

 Dim data() as ssortingng ' creates the untestable holder. data = Split(vbNullSsortingng, ",") ' 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(vbNullSsortingng, ",") ' MUST use this to clear the array again. 

La manière la plus simple de gérer cela est de vous assurer que le tableau est initialisé avant de devoir rechercher le Ubound. J’avais besoin d’un tableau déclaré dans la zone (générale) du code de formulaire. c’est à dire

 Dim arySomeArray() As sometype 

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

 Private Sub Form_Load() ReDim arySomeArray(1) As sometype 'insure that the array is initialized End Sub 

Cela permettra de redéfinir le tableau à tout moment dans le programme. Lorsque vous découvrez quelle taille doit avoir le tableau, redimensionnez-le.

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

Mon seul problème avec les appels d’API passe du système d’exploitation 32 bits au système d’exploitation 64 bits.
Cela fonctionne avec des objects, des cordes, 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 

 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 

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’object VBArray() de JScript (fonctionne avec des tableaux de type variant, simple ou multidimensionnel):

 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 + 100ms d’initialisation, étant compilé avec VB 6.0.9782, donc le tableau de 10M prend environ 4.1 secondes. La même fonctionnalité pourrait être implémentée via ScriptControl ActiveX.

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

1. Le tableau est initialisé (ce n’est pas un pointeur nul)
2. Le tableau est initialisé et possède au moins un élément

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

 Public Function IsInitialised(arr() As Ssortingng) 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 

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 véritable problème est de savoir comment récupérer le UBound d’un tableau qui n’est pas initialisé.

Voici ma solution (au problème réel, 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 quasortingème lorsque l’ Arr n’est pas ReDim -ed (l’object de cette question):

• UBound(Arr) fonctionne, alors appeler UBound2(Arr) ajoute un peu de temps mais ne nuit pas beaucoup
• UBound(Arr) échoue dans la fonction qui définit Arr , mais réussit dans UBound2()
• UBound(Arr) échoue à la fois dans la fonction qui définit Arr et dans UBound2() , donc la gestion des erreurs fait le travail
• Après Dim Arr() As Whatever avant, avant ReDim Arr(X)

Si le tableau est un tableau de chaînes, vous pouvez utiliser la méthode Join () comme test:

 Private Sub Test() Dim ArrayToTest() As Ssortingng MsgBox SsortingngArrayCheck(ArrayToTest) ' returns "false" ReDim ArrayToTest(1 To 10) MsgBox SsortingngArrayCheck(ArrayToTest) ' returns "true" ReDim ArrayToTest(0 To 0) MsgBox SsortingngArrayCheck(ArrayToTest) ' returns "false" End Sub Function SsortingngArrayCheck(o As Variant) As Boolean Dim x As Ssortingng x = Join(o) SsortingngArrayCheck = (Len(x) <> 0) End Function 

Cela a fonctionné pour moi, n’importe quel bug?

 If IsEmpty(a) Then Exit Function End If 

MSDN

 Dim someArray() as Integer If someArray Is Nothing Then Debug.print "this array is not initialised" End If