web-dev-qa-db-ja.com

VB6で配列が初期化されているかどうかを確認するにはどうすればよいですか？

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

arraysvb6
52
raven

これが私が行ったものです。これはGSergの answer に似ていますが、より適切に文書化されたCopyMemory API関数を使用し、完全に自己完結型です（この関数にArrPtr（array）ではなく配列を渡すことができます）。それは、Microsoft 警告 であるVarPtr関数を使用しますが、これはXP専用のアプリであり、動作するので、私は心配していません。

はい、私はこの関数があなたが投げたものを受け入れることを知っていますが、読者のための練習としてエラーチェックを残します。

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
14
raven

注：コードは更新されています。元のバージョンは 改訂履歴 で見つけることができますそれを見つける）。更新されたコードは、文書化されていないGetMem4関数および 正しく処理する すべてのタイプの配列。

VBAユーザーへの注意：このコードは、x64更新を一度も取得していないVB6向けです。 VBAにこのコードを使用する場合は、VBAバージョンの https://stackoverflow.com/a/32539884/1168 を参照してください。 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であることをテストします）が、私はコンパイラのバグを考慮する方法で:)

24
GSerg

私はこれを考えました。シンプルで、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）にアクセスしようとすると、範囲外の添え字エラーが発生します。

17
raven

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

Dim someArray() As Integer

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

Edit：RS Conleyが answer で指摘したように、（not someArray）は時々0を返すので、使用する必要があります（ （not someArray）= -1）。

13
raven

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

If（not someArray）= -1 Then

いくつかのマシンでは、他のいくつかの大きな負の数でゼロを返します。

8
RS Conley

VB6には「IsArray」という関数がありますが、配列が初期化されているかどうかはチェックしません。初期化されていない配列でUBoundを使用しようとすると、エラー9-添え字が範囲外になります。私の方法は、すべての変数タイプで機能し、エラー処理があることを除いて、S Jに非常に似ています。非配列変数がチェックされている場合、エラー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
5
iCodeInVB6

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

これは、スプリット機能の場合にも機能するはずです。制限は、配列のタイプ（この例では文字列）を定義する必要があることです。

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

使用法：

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

この既存の投稿で読んだすべての情報に基づいて、これは初期化されていないものとして開始される型付き配列を扱う場合に最適です。

UBOUNDの使用とテストコードの一貫性を保ち、テストのためにエラー処理を使用する必要はありません。

それはIS Zero Based Arraysに依存しています（ほとんどの開発の場合）。

「消去」を使用して配列をクリアしないでください。以下にリストされている代替手段を使用してください。

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

配列として宣言された変数については、SafeArrayGetDim APIを呼び出すことにより、配列が初期化されているかどうかを簡単に確認できます。配列が初期化されている場合、戻り値はゼロ以外になります。それ以外の場合、関数はゼロを返します。

配列を含むバリアントではこの関数を使用できないことに注意してください。これを行うと、コンパイルエラー（タイプの不一致）が発生します。

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

これを処理する最も簡単な方法は、Uboundを確認する必要がある前に、配列が事前に初期化されていることを確認することです。フォームコードの（全般）領域で宣言された配列が必要でした。つまり.

Dim arySomeArray() As sometype

次に、フォームのロードルーチンで配列を再整理します。

Private Sub Form_Load()

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

End Sub

これにより、プログラムの任意の時点で配列を再定義できます。配列をどれだけ大きくする必要があるかがわかると、それを再整理します。

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

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

1
jorge

質問のタイトルは配列が初期化されているかどうかを確認する方法を尋ねますが、質問を読んだ後、実際の問題は初期化されていない配列のUBoundを取得する方法です。

ここに私の解決策があります（タイトルではなく、実際の問題に対する）：

_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
_

この関数は、次の4つのシナリオで機能します。最初の3つは、Arrが外部dll COMによって作成されたときに見つけたもので、4つ目はArrがReDim- ed（この質問の主題）：

  • UBound(Arr)は機能するため、UBound2(Arr)を呼び出すとオーバーヘッドが少し増えますが、それほど害はありません
  • UBound(Arr)は、Arrを定義する関数では失敗しますが、UBound2()内では成功します
  • UBound(Arr)は、Arrを定義する関数とUBound2()の両方で失敗するため、エラー処理がジョブを実行します。
  • Dim Arr() As Whateverの後、ReDim Arr(X)の前
0
stenci

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

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

ケース2は、Split(vbNullString, ",")のような、_LBound=0_および_UBound=-1_のString配列を返す場合に必要です。各テストで生成できる最も簡単なコードスニペットの例を次に示します。

_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

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
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

Ubound()関数で問題を解決し、JScriptのVBArray()オブジェクトを使用して合計要素数を取得することで配列が空かどうかを確認できます（単一または多次元のバリアント型の配列で動作します）：

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

私にとっては、VB 6.0.9782でコンパイルされているため、各要素に約0.4 mksec + 100ミリ秒の初期化が必要です。したがって、10M要素の配列には約4.1秒かかります。 ScriptControl ActiveX。

0
omegastripes