Comment puis-je déterminer si un tableau est initialisé dans VB6?
passer un tableau Non dimensionné à la fonction Ubound de la VB6 va causer une erreur, donc je veux vérifier si elle a été dimensionnée avant de tenter de vérifier sa limite supérieure. Comment dois-je faire?
20 réponses
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
Utilisation:
? ArrayExists(ArrPtr(someArray))
? ArrayExists(StrArrPtr(someArrayOfStrings))
? ArrayExists(UDTArrPtr(someArrayOfUDTs))
votre code semble faire la même chose (testing for SAFEARRAY** étant NULL), mais d'une manière que je considérerais comme un bug de compilateur:)
je viens de penser à celui-ci. Assez Simple, pas besoin D'appels API. Pas de problèmes avec elle?
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 un défaut dans la fonction Split). Prenez cet exemple:
Dim arr() As String
arr = Split(vbNullString, ",")
Debug.Print UBound(arr)
Quelle est la valeur D'Ubound(arr) à ce point? C'est -1! Donc, passer ce tableau à cette fonction Isarrayinitialisée renvoie true, mais tenter d'accéder à des arr(0) provoquerait un indice en dehors de la plage d'erreur.
voilà ce que j'ai suivi. 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, que Microsoft met en garde contre , mais il s'agit d'une application XP SEULEMENT, et cela fonctionne, donc je ne suis pas concerné.
Oui, je sais que cette fonction acceptera Tout ce que vous jetez - y, mais je vais laisser l'erreur de vérification 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
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 d'essai de ce genre.
Si (Non someArray) = -1, Alors
sur certaines machines il retournera un zéro sur d'autres un grand nombre négatif.
dans VB6 il y a une fonction appelée" IsArray", mais elle ne vérifie pas si le tableau a été initialisé. Vous recevrez L'erreur 9-Subscript hors de portée 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 a une gestion des erreurs. Si une variable non-array est cochée, vous recevrez L'erreur 13 - Type Mismatch.
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
c'est une modification de réponse de raven . Sans utiliser D'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 doit aussi fonctionner en cas de fonction fractionnée. 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
Utilisation:
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
quand vous initialisez le tableau mettez un entier ou booléen avec un drapeau = 1. et d'interroger ce drapeau quand vous en avez besoin.
basé sur toutes les informations que j'ai lu dans ce post existant cela fonctionne le mieux pour moi quand traitant avec un tableau dactylographié qui commence comme uninitialized.
il maintient le code de test compatible avec L'utilisation D'UBOUND et il ne nécessite pas l'utilisation de la gestion des erreurs pour le test.
il dépend des tableaux à base zéro (ce qui est le cas dans la plupart des développements).
ne doit pas utiliser" Erase " pour effacer le tableau. utiliser alternative énumérés 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.
La meilleure façon de gérer cela est de s'assurer que le tableau est initialisé à l'avant, avant, vous devez vérifier pour la Ubound. J'ai eu besoin d'un tableau qui a été déclaré dans la zone (générale) du code de forme. c'est à dire
Dim arySomeArray() As sometype
puis dans la routine de chargement de la forme je redim 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 à n'importe quel point plus tard dans le programme. Lorsque vous découvrez la taille du tableau doit être redim.
ReDim arySomeArray(i) As sometype 'i is the size needed to hold the new data
mon seul problème avec les appels API est de passer des OS 32 bits aux OS 64 bits.
Cela fonctionne avec des objets, 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 en utilisant l'objet 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 + 100 initialisation msec, étant compilé avec VB 6.0.9782, donc le tableau D'éléments 10M prend environ 4.1 sec. La même fonctionnalité pourrait être implémentée via ScriptControl
ActiveX.
il y a deux scénarios légèrement différents à tester:
- le tableau est initialisé (ce n'est pas un pointeur nul)
- le tableau est initialisé et comporte au moins un élément
le cas 2 est requis pour les cas comme Split(vbNullString, ",")
qui renvoie un tableau String
avec LBound=0
et UBound=-1
.
Voici l'exemple le plus simple 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
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 est de savoir comment obtenir le UBound
d'un tableau qui n'est pas 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é quand Arr
est créé par un externe dll COM et le quatrième quand le Arr
n'est pas ReDim
- ed (le sujet de cette question):
-
UBound(Arr)
œuvres", afin de l'appelantUBound2(Arr)
, ajoute un peu de surcharge, mais n'a pas fait beaucoup de mal -
UBound(Arr)
échoue dans la fonction qui définitArr
, mais succède à l'intérieur deUBound2()
-
UBound(Arr)
échoue à la fois dans la fonction qui définitArr
et dansUBound2()
, donc l'erreur la manipulation fait le travail - après
Dim Arr() As Whatever
, avantReDim Arr(X)
je vois beaucoup de suggestions en ligne sur comment dire si un tableau a été initialisé . Voici une fonction qui va prendre n'importe quel tableau, vérifier ce qu'est l'ubound de ce tableau, rediriger le tableau vers ubound +1 (avec ou sans PRESERVER) et ensuite retourner ce qu'est l'ubound actuel du tableau, sans erreurs.
Function ifuncRedimUbound(ByRef byrefArr, Optional bPreserve As Boolean) On Error GoTo err: 1: Dim upp%: upp% = (UBound(byrefArr) + 1) errContinue: If bPreserve Then ReDim Preserve byrefArr(upp%) Else ReDim byrefArr(upp%) End If ifuncRedimUbound = upp% Exit Function err: If err.Number = 0 Then Resume Next If err.Number = 9 Then ' subscript out of range (array has not been initialized yet) If Erl = 1 Then upp% = 0 GoTo errContinue: End If Else ErrHandler.ReportError "modArray", ifuncRedimUbound, "1", err.Number, err.Description End If End Function
si le tableau est un tableau de chaînes de caractères, vous pouvez utiliser la méthode Join() comme un test:
Private Sub Test()
Dim ArrayToTest() As String
MsgBox StringArrayCheck(ArrayToTest) ' returns "false"
ReDim ArrayToTest(1 To 10)
MsgBox StringArrayCheck(ArrayToTest) ' returns "true"
ReDim ArrayToTest(0 To 0)
MsgBox StringArrayCheck(ArrayToTest) ' returns "false"
End Sub
Function StringArrayCheck(o As Variant) As Boolean
Dim x As String
x = Join(o)
StringArrayCheck = (Len(x) <> 0)
End Function
Dim someArray() as Integer
If someArray Is Nothing Then
Debug.print "this array is not initialised"
End If