次元のない配列をVB6のUbound関数に渡すとエラーが発生するため、上限を確認する前に、次元が設定されているかどうかを確認します。どうすればいいですか?
これが私が行ったものです。これは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
注:コードは更新されています。元のバージョンは 改訂履歴 で見つけることができますそれを見つける)。更新されたコードは、文書化されていない
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であることをテストします)が、私はコンパイラのバグを考慮する方法で:)
私はこれを考えました。シンプルで、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)にアクセスしようとすると、範囲外の添え字エラーが発生します。
私はこれを見つけました:
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)。
GSergとRavenの両方の方法は文書化されていないハッキングですが、Visual BASIC 6は開発されていないため問題ではありません。ただし、Ravenの例はすべてのマシンで機能するわけではありません。このようにテストする必要があります。
If(not someArray)= -1 Then
いくつかのマシンでは、他のいくつかの大きな負の数でゼロを返します。
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
これは、レイヴンの 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
これは、スプリット機能の場合にも機能するはずです。制限は、配列のタイプ(この例では文字列)を定義する必要があることです。
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
この既存の投稿で読んだすべての情報に基づいて、これは初期化されていないものとして開始される型付き配列を扱う場合に最適です。
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.
配列として宣言された変数については、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
これを処理する最も簡単な方法は、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の整数またはブール値を設定し、必要に応じてこのフラグを照会します。
質問のタイトルは配列が初期化されているかどうかを確認する方法を尋ねますが、質問を読んだ後、実際の問題は初期化されていない配列の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)
の前テストする2つのわずかに異なるシナリオがあります。
ケース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
_
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
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
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。