[RESOLVED] Um, why is this crashing?

[DigiRev]

This crashes VB when I run it. This is the line that I have found to be the problem.

vbexStreamHandler.cls
ProcessStream()

objStream.Value = Stream()

I'm attaching the project.

I placed a breakpoint in the Property Let Value() procedure in the vbexByteArray class, and it doesn't even get that far.

[westconn1]

this is the line where error occurs

Public Sub ProcessStream(ByVal Index As Long, ByRef Stream() As Byte)
    
    Dim objStream As vbexByteArray, lonPos As Long
    Dim bytParams() As Byte, lonParams As Long
    Dim lonHeaderLength As Long, bytHeader() As Byte
    
    'Header information
    Dim sinVersion As Single, sinHeader As Single
    Dim lonParamCount As Long, varTypes() As VbVarType
    Dim lonLengths() As Long, bolEncrypted As Boolean
    Dim lonDataLength As Long
    
    Set objStream = New vbexByteArray
    
     objStream.Value = Stream()
    
    'Version        Header      Parameters      Types       Lengths     Encrypted?      Data
    '4 bytes        4 bytes     4 bytes         4*Params    4*Params    2 bytes

but you know that already

[Merri]

While I fail to figure out the actual cause of the crash, I can see that you could simply use a non-class byte array solution instead.

These should get you started:

Option Explicit

Private Declare Function ArrayPtr Lib "msvbvm60" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByRef Value As Long)
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Public Sub AppendBytes(ByRef ByteArray() As Byte, ParamArray Data())
    Dim blnInit As Boolean, bytData() As Byte
    Dim lngA As Long, lngB As Long, lngBound As Long, lngHeader(5) As Long, lngPtr As Long
    blnInit = Not Not ByteArray
    Debug.Assert App.hInstance
    If blnInit Then
        lngHeader(0) = 1
        lngHeader(1) = 1
        PutMem4 ArrayPtr(bytData), VarPtr(lngHeader(0))
        For lngA = 0 To UBound(Data)
            lngBound = UBound(ByteArray)
            Select Case VarType(Data(lngA))
                Case vbByte
                    ReDim Preserve ByteArray(lngBound + 1)
                    ByteArray(lngBound + 1) = Data(lngA)
                Case vbBoolean, vbInteger
                    ReDim Preserve ByteArray(lngBound + 2)
                    ByteArray(lngBound + 1) = Data(lngA) And &HFF
                    ByteArray(lngBound + 2) = (Data(lngA) And &HFF00&) \ &H100&
                Case vbLong
                    Dim lngData As Long
                    lngData = Data(lngA)
                    lngHeader(3) = VarPtr(lngData)
                    lngHeader(4) = 4
                    ReDim Preserve ByteArray(lngBound + 4)
                    ByteArray(lngBound + 1) = bytData(0)
                    ByteArray(lngBound + 2) = bytData(1)
                    ByteArray(lngBound + 3) = bytData(2)
                    ByteArray(lngBound + 4) = bytData(3)
                Case vbSingle
                    Dim sngData As Single
                    sngData = Data(lngA)
                    lngHeader(3) = VarPtr(sngData)
                    lngHeader(4) = 4
                    ReDim Preserve ByteArray(lngBound + 4)
                    ByteArray(lngBound + 1) = bytData(0)
                    ByteArray(lngBound + 2) = bytData(1)
                    ByteArray(lngBound + 3) = bytData(2)
                    ByteArray(lngBound + 4) = bytData(3)
                Case vbCurrency
                    Dim curData As Currency
                    curData = Data(lngA)
                    lngHeader(3) = VarPtr(curData)
                    lngHeader(4) = 8
                    ReDim Preserve ByteArray(lngBound + 8)
                    ByteArray(lngBound + 1) = bytData(0)
                    ByteArray(lngBound + 2) = bytData(1)
                    ByteArray(lngBound + 3) = bytData(2)
                    ByteArray(lngBound + 4) = bytData(3)
                    ByteArray(lngBound + 5) = bytData(4)
                    ByteArray(lngBound + 6) = bytData(5)
                    ByteArray(lngBound + 7) = bytData(6)
                    ByteArray(lngBound + 8) = bytData(7)
                Case vbDate, vbDouble
                    Dim dblData As Double
                    dblData = Data(lngA)
                    lngHeader(3) = VarPtr(dblData)
                    lngHeader(4) = 8
                    ReDim Preserve ByteArray(lngBound + 8)
                    ByteArray(lngBound + 1) = bytData(0)
                    ByteArray(lngBound + 2) = bytData(1)
                    ByteArray(lngBound + 3) = bytData(2)
                    ByteArray(lngBound + 4) = bytData(3)
                    ByteArray(lngBound + 5) = bytData(4)
                    ByteArray(lngBound + 6) = bytData(5)
                    ByteArray(lngBound + 7) = bytData(6)
                    ByteArray(lngBound + 8) = bytData(7)
                Case vbByte Or vbArray
                    lngHeader(4) = UBound(Data(lngA)) - LBound(Data(lngA)) + 1
                    If lngHeader(4) Then
                        GetMem4 VarPtr(Data(lngA)) + 8, lngPtr
                        GetMem4 lngPtr, lngPtr
                        GetMem4 lngPtr + 12, lngHeader(3)
                        ReDim Preserve ByteArray(lngBound + lngHeader(4))
                        For lngB = 0 To lngHeader(4) - 1
                            ByteArray(lngBound + lngB + 1) = bytData(lngB)
                        Next lngB
                    End If
                Case vbBoolean Or vbArray, vbInteger Or vbArray
                    lngHeader(4) = (UBound(Data(lngA)) - LBound(Data(lngA)) + 1) * 2
                    If lngHeader(4) Then
                        GetMem4 VarPtr(Data(lngA)) + 8, lngPtr
                        GetMem4 lngPtr, lngPtr
                        GetMem4 lngPtr + 12, lngHeader(3)
                        ReDim Preserve ByteArray(lngBound + lngHeader(4))
                        For lngB = 0 To lngHeader(4) - 1
                            ByteArray(lngBound + lngB + 1) = bytData(lngB)
                        Next lngB
                    End If
                Case vbLong Or vbArray, vbSingle Or vbArray
                    lngHeader(4) = (UBound(Data(lngA)) - LBound(Data(lngA)) + 1) * 4
                    If lngHeader(4) Then
                        GetMem4 VarPtr(Data(lngA)) + 8, lngPtr
                        GetMem4 lngPtr, lngPtr
                        GetMem4 lngPtr + 12, lngHeader(3)
                        ReDim Preserve ByteArray(lngBound + lngHeader(4))
                        For lngB = 0 To lngHeader(4) - 1
                            ByteArray(lngBound + lngB + 1) = bytData(lngB)
                        Next lngB
                    End If
                Case vbCurrency Or vbArray, vbDate Or vbArray, vbDouble Or vbArray
                    lngHeader(4) = (UBound(Data(lngA)) - LBound(Data(lngA)) + 1) * 8
                    If lngHeader(4) Then
                        GetMem4 VarPtr(Data(lngA)) + 8, lngPtr
                        GetMem4 lngPtr, lngPtr
                        GetMem4 lngPtr + 12, lngHeader(3)
                        ReDim Preserve ByteArray(lngBound + lngHeader(4))
                        For lngB = 0 To lngHeader(4) - 1
                            ByteArray(lngBound + lngB + 1) = bytData(lngB)
                        Next lngB
                    End If
                Case vbString
                    lngHeader(4) = LenB(Data(lngA))
                    If lngHeader(4) Then
                        lngHeader(3) = StrPtr(Data(lngA))
                        ReDim Preserve ByteArray(lngBound + lngHeader(4))
                        For lngB = 0 To lngHeader(4) - 1
                            ByteArray(lngBound + lngB + 1) = bytData(lngB)
                        Next lngB
                    End If
            End Select
        Next lngA
        PutMem4 ArrayPtr(bytData), 0
    End If
End Sub

Public Property Get MidBytes(ByRef ByteArray() As Byte, ByVal Start As Long, Optional ByVal Length As Long) As Byte()
    Dim blnInit As Boolean, bytMid() As Byte, lngHeader(5) As Long, lngMaxLen As Long
    blnInit = Not Not ByteArray
    Debug.Assert App.hInstance
    If blnInit Then
        lngMaxLen = UBound(ByteArray) - LBound(ByteArray) + 1
        If Length = 0 Then
            Length = lngMaxLen - Start
        ElseIf Length + Start > lngMaxLen Then
            Length = lngMaxLen - Start
        End If
        If Length >= 0 Then
            lngHeader(0) = 1
            lngHeader(1) = 1
            lngHeader(3) = VarPtr(ByteArray(Start))
            lngHeader(4) = Length
            PutMem4 ArrayPtr(bytMid), VarPtr(lngHeader(0))
            MidBytes = bytMid
            PutMem4 ArrayPtr(bytMid), 0
        End If
    End If
End Property

Usage samples:

Private Sub Form_Load()
    Dim bytTest() As Byte, intTest(2) As Integer
    bytTest = "Did you know test"
    intTest(0) = 65
    intTest(1) = 66
    intTest(2) = 67
    AppendBytes bytTest, "ing is great", AscW("!"), &H420041, &H440043, intTest
    Debug.Print MidBytes(bytTest, 26)
End Sub

[Milk]

I've not found the error, but I've found what might be another one...

(vbexByteArray::Append)

            Case vbByte Or vbArray 'Byte array
                bytData = Data(l)
                lonLBData = LBound(bytData)
                lonUBData = UBound(bytData)
                
                lonDataLen = lonUBData - lonLBData + 1 '<--added + 1 
                
'                If lonLBData = 0 Then 
'                    lonDataLen = lonDataLen + 1   <-- no need
'                End If
                
                ReDim Preserve m_Data(1 To lonUB + lonDataLen) As Byte
                CopyMemory m_Data(lonUB + 1), bytData(lonLBData), lonDataLen

Redundant if you go with Merri's suggestion

I'm sure your aware that a mistake with RtlMoveMemory is by far the most likely source of the crash. If some memory has been corrupted a crash does not always happen straight away. I count 11 calls to it before the crash occurs.

[Merri]

No feature updates to the code, but a shorter version of AppendBytes with some comments:

Public Sub AppendBytes(ByRef ByteArray() As Byte, ParamArray Data())
    Dim blnInit As Boolean, bytData() As Byte
    Dim lngA As Long, lngB As Long, lngBound As Long, lngHeader(5) As Long, lngPtr As Long
    Dim lngDataLen As Long, vvtData As VbVarType
    blnInit = Not Not ByteArray
    Debug.Assert App.hInstance
    If Not blnInit Then ByteArray = vbNullString
    lngHeader(0) = 1
    lngHeader(1) = 1
    PutMem4 ArrayPtr(bytData), VarPtr(lngHeader(0))
    For lngA = 0 To UBound(Data)
        lngBound = UBound(ByteArray)
        vvtData = VarType(Data(lngA))
        If vvtData And vbArray Then
            ' is an array: figure out length of data
            Select Case vvtData And Not vbArray
                Case vbByte
                    lngDataLen = 1
                Case vbBoolean, vbInteger
                    lngDataLen = 2
                Case vbLong, vbSingle
                    lngDataLen = 4
                Case vbCurrency, vbDate, vbDouble
                    lngDataLen = 8
                Case Else
                    lngDataLen = 0
            End Select
            ' calculate length of data
            lngHeader(4) = (UBound(Data(lngA)) - LBound(Data(lngA)) + 1) * lngDataLen
            ' if we got data...
            If lngHeader(4) Then
                ' get pointer to array variable from a Variant
                GetMem4 VarPtr(Data(lngA)) + 8, lngPtr
                ' get pointer to safe array header from the array variable
                GetMem4 lngPtr, lngPtr
                ' get pointer to array's data
                GetMem4 lngPtr + 12, lngHeader(3)
                ' reserve memory & copy bytes
                ReDim Preserve ByteArray(lngBound + lngHeader(4))
                For lngB = 0 To lngHeader(4) - 1
                    ByteArray(lngBound + lngB + 1) = bytData(lngB)
                Next lngB
            End If
        Else ' not an array
            Select Case vvtData
                Case vbByte
                    Dim bytData2 As Byte
                    bytData2 = Data(lngA)
                    lngHeader(3) = VarPtr(bytData2)
                    lngHeader(4) = 1
                Case vbBoolean, vbInteger
                    Dim intData As Integer
                    intData = Data(lngA)
                    lngHeader(3) = VarPtr(intData)
                    lngHeader(4) = 2
                Case vbLong
                    Dim lngData As Long
                    lngData = Data(lngA)
                    lngHeader(3) = VarPtr(intData)
                    lngHeader(4) = 4
                Case vbSingle
                    Dim sngData As Single
                    sngData = Data(lngA)
                    lngHeader(3) = VarPtr(sngData)
                    lngHeader(4) = 4
                Case vbCurrency
                    Dim curData As Currency
                    curData = Data(lngA)
                    lngHeader(3) = VarPtr(curData)
                    lngHeader(4) = 8
                Case vbDate, vbDouble
                    Dim dblData As Double
                    dblData = Data(lngA)
                    lngHeader(3) = VarPtr(dblData)
                    lngHeader(4) = 8
                Case vbString
                    lngHeader(4) = LenB(Data(lngA))
                    If lngHeader(4) Then lngHeader(3) = StrPtr(Data(lngA))
                Case Else
                    lngHeader(4) = 0
            End Select
            If lngHeader(4) Then
                ReDim Preserve ByteArray(lngBound + lngHeader(4))
                For lngB = 0 To lngHeader(4) - 1
                    ByteArray(lngBound + lngB + 1) = bytData(lngB)
                Next lngB
            End If
        End If
    Next lngA
    PutMem4 ArrayPtr(bytData), 0
End Sub

Thought to leave the original for reference.

[Merri]

It is indeed due to use of CopyMemory. I made some comparisons and noticed that the Append function I provide gives quite different results.

Private Sub Form_Load()
    Dim bytTest() As Byte
    bytTest = vbNullString
    AppendBytes bytTest, 10.1, False, StrConv("Test!", vbFromUnicode)
    Debug.Print StrConv(bytTest, vbUnicode)
End Sub

This outputs: 333333$@ Test!

Then I made the following changes in DigiRev's code:

    Set objStream = New vbexStreamHandler
    bytPacket = objStream.BuildDatagram(10.1, False, "Test!")

    Debug.Print StrConv(bytPacket, vbUnicode)

    'objStream.ProcessStream 1, bytPacket

And in BuildDatagram:

'12 bytes (version, header, and no. of parameters)
    objRet.Append m_Version, Header, Parameters(0)
    BuildDatagram = objRet.Value
    Exit Function

And this outputs: š™!ATest!


Tip: you can use a PropertyBag to easily store all kinds of data.

[Milk]

Interesting
RtlMoveMemory (aka CopyMemory) is not the source of the crash. If every instance is removed from the project including the declares the crash still happens at exactly the same spot. There is no other API and no extra references that I can see so it looks like its caused by pure VB

BTW with the adjustment I posted I get this " š™!A
  Test!" which I think is correct it's Sng(0),Sng(10.1),Lng(1),Lng(8),Lng(5),"Test!"

[DigiRev]

Thanks for the suggestions. I think I might try Merri's code. I don't want to use a property bag because I like the way it's setup now. I really wish I knew why it's crashing, though. I might look at it in a debugger and try to figure out what's going on, but I'm not really an expert in that area.

Thanks.

[Merri]

I don't know if it helps, but when you compile the application the memory location that points to the crash changes from 0x00000000 to 0x00133000. It indeed seems like some kind of a bug in VB6 at the moment, but why it happens is harder to tell.

Oh and Milk, my error was that I didn't make sure the variable type was correct. I should have done like this:
AppendBytes bytTest, CSng(10.1), CBool(False), StrConv("Test!", vbFromUnicode)

Which then gives š™!A Test!


I also updated the shorter version of AppendBytes to be even shorter.