60

次元のない配列を VB6 の Ubound 関数に渡すとエラーが発生するため、上限を確認する前に次元が設定されているかどうかを確認したいと考えています。どうすればいいですか？

4

22 に答える 22

24

注:コードは更新されました。元のバージョンは改訂履歴で見つけることができます (それを見つけることが有用であるというわけではありません)。GetMem4更新されたコードは、文書化されていない関数に依存せず、すべての型の配列を正しく処理します。

VBA ユーザーへの注意:このコードは、x64 アップデートを取得していない VB6 用です。このコードを VBA に使用する場合は、VBA バージョンについてhttps://stackoverflow.com/a/32539884/11683を参照してください。CopyMemory宣言と関数のみを取得する必要がありpArrPtr、残りは残します。

私はこれを使用します：

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)

Private Const VT_BYREF As Long = &H4000&

' When declared in this way, the passed array is wrapped in a Variant/ByRef. It is not copied.
' Returns *SAFEARRAY, not **SAFEARRAY
Public Function pArrPtr(ByRef arr As Variant) As Long
  'VarType lies to you, hiding important differences. Manual VarType here.
  Dim vt As Integer
  CopyMemory ByVal VarPtr(vt), ByVal VarPtr(arr), Len(vt)

  If (vt And vbArray) <> vbArray Then
    Err.Raise 5, , "Variant must contain an array"
  End If

  'see https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627%28v=vs.85%29.aspx
  If (vt And VT_BYREF) = VT_BYREF Then
    'By-ref variant array. Contains **pparray at offset 8
    CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr)  'pArrPtr = arr->pparray;
    CopyMemory ByVal VarPtr(pArrPtr), ByVal pArrPtr, Len(pArrPtr)          'pArrPtr = *pArrPtr;
  Else
    'Non-by-ref variant array. Contains *parray at offset 8
    CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr)  'pArrPtr = arr->parray;
  End If
End Function

Public Function ArrayExists(ByRef arr As Variant) As Boolean
  ArrayExists = pArrPtr(arr) <> 0
End Function

使用法：

? ArrayExists(someArray)

あなたのコードは同じことをしているようです（SAFEARRAY **がNULLであることをテストしています）が、コンパイラのバグと見なす方法で:)

于 2008-10-08T16:31:58.150 に答える
22

私はちょうどこれについて考えました。シンプルで、API 呼び出しは必要ありません。何か問題はありますか？

Public Function IsArrayInitialized(arr) As Boolean

  Dim rv As Long

  On Error Resume Next

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

End Function

編集：Split関数の動作に関連するこれに関する欠陥を発見しました（実際には、Split関数の欠陥と呼んでいます）。次の例を見てください。

Dim arr() As String

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

この時点での Ubound(arr) の値は? -1です！したがって、この配列を IsArrayInitialized 関数に渡すと true が返されますが、arr(0) にアクセスしようとすると、範囲外の添字エラーが発生します。

于 2008-10-08T21:02:32.847 に答える
14

私はこれを見つけました：

Dim someArray() As Integer

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

編集: RS Conley は、(Not someArray) が 0 を返す場合があるため、((Not someArray) = -1) を使用する必要があることを回答で指摘しました。

于 2008-10-08T15:22:25.750 に答える
9

GSerg と Raven による方法はどちらも文書化されていないハッキングですが、Visual BASIC 6 は開発されていないため、問題にはなりません。ただし、Raven の例はすべてのマシンで機能するわけではありません。このようにテストする必要があります。

If (Not someArray) = -1 Then

一部のマシンでは、他のマシンではゼロが返され、大きな負の数が返されます。

于 2008-10-08T19:16:06.883 に答える
5

VB6には「IsArray」という関数がありますが、配列が初期化されているかどうかはチェックしません。初期化されていない配列でUBoundを使用しようとすると、エラー9-添え字が範囲外になります。私の方法は、すべての変数タイプで機能し、エラー処理があることを除けば、SJの方法と非常によく似ています。非配列変数がチェックされている場合、エラー13-タイプの不一致が発生します。

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
于 2012-09-24T19:31:27.523 に答える
3

これはレイヴンの答えの修正です。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

これは、分割機能の場合にも機能するはずです。制限は、配列のタイプ (この例では文字列) を定義する必要があることです。

于 2012-06-14T15:53:52.317 に答える
2 
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

使用法：

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
于 2015-04-08T17:54:58.717 に答える
1

配列を初期化するときは、整数またはブール値をフラグ = 1 に設定し、必要に応じてこのフラグを照会します。

于 2012-01-21T22:54:23.410 に答える
0

配列が文字列配列の場合、Join() メソッドをテストとして使用できます。

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
于 2008-10-08T16:05:56.923 に答える
0

API 呼び出しに関する私の唯一の問題は、32 ビット OS から 64 ビット OS に移行することです。
これは、オブジェクト、文字列などで機能します...

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
于 2012-08-12T04:14:44.907 に答える
0 
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
于 2016-07-12T15:55:30.757 に答える
0

テストする 2 つのわずかに異なるシナリオがあります。

  1. 配列が初期化されます (事実上、null ポインターではありません)。
  2. 配列は初期化されており、少なくとも 1 つの要素があります

ケース 2 は、とで配列Split(vbNullString, ",")を返す のようなケースに必要です。以下は、テストごとに生成できる最も単純なコード スニペットの例です。StringLBound=0UBound=-1

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
于 2016-09-14T10:08:21.677 に答える
-8 
Dim someArray() as Integer    

If someArray Is Nothing Then
    Debug.print "this array is not initialised"
End If
于 2008-10-08T15:28:38.263 に答える