[RESOLVED] Copy Array Bytes by Block to Variant Arrays
I'm trying to read in as fast as possible a binary file and put it into a Variant Array by what I call Blocks (groups). The header for each block is a vbBack.
I read in the Binary File into a Byte Array using procedure: "Bin_ReadAll" This read works but seems slow -- about 17 seconds for 110,000 bytes. (Note: 17 seconds is with routine (not posted)
verifying bytes. Actual time to Load is < 1 second.
I then try and copy the bytes into the Variant Array using the procedure: "SplitBytesToBlocks".
===============================
IGNORE CODE in Post #1, See Post #2 for Rework.
Realized I had not posted the actual Type and the correct dimension for
the dest array in CopyMemory. However, when trying to verify get
error "type mismatch". See end of procedure: "SplitBytesToBlocks".
for verify.
===================================
Code:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Public Function Bin_ReadAll(strPath As String, arrBytes() As Byte)
'Reads Entire File in One Line of Code to a Byte Array (base 1)
'THIS WORKS
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
file_name = strPath
file_length = FileLen(file_name)
fnum = FreeFile
ReDim arrBytes(1 To file_length)
Open file_name For Binary As #fnum
Get #fnum, 1, arrBytes
Close fnum
'=========================
'Dim txt As String
'Dim i As Long
'
' ' Display the results.
' For i = 1 To UBound(arrBytes) ' file_length
' txt = txt & Format$(arrBytes(i)) & vbCrLf
' Next i
End Function
Public Sub SplitBytesToBlocks(arrBytes() As Byte, arrOut() As Variant, Delimiter As Byte)
Dim i As Long
Dim j As Long ''Dimension Counter for arrOut
Dim blnFound As Boolean
Dim byteStart As Long
Dim LenBlock As Long
Dim tmp(29) As Variant
j = -1
For i = LBound(arrBytes) To UBound(arrBytes)
If arrBytes(i) = Delimiter Then
'Skip the 1st byte as a Block
If Not i = LBound(arrBytes) Then
LenBlock = (i - byteStart) + 1
j = j + 1
Call CopyMemory(tmp(j), arrBytes(byteStart), LenB(LenBlock))
End If
'Set Flag
'not needed blnFound = True
byteStart = i
'Turn Off Flag
'not needed blnFound = False
End If
Next
'Copy the Last Block
j = j + 1
LenBlock = (i - byteStart) + 1
Call CopyMemory(tmp(j), arrBytes(byteStart), LenB(LenBlock))
'----------------------------
'Verify tmp has data
'-----------------------------
Dim v As Variant
For i = LBound(tmp) To UBound(tmp)
v = tmp(i)
Next
End Sub
Last edited by vb6forever; Jan 23rd, 2018 at 05:46 PM.
However, when trying to verify get
error "type mismatch". See end of procedure: "SplitBytesToBlocks".
for verify error.
Code:
Private Type tmpInfo
Test() As Variant
End Type
Private tmp() As tmpInfo
'Note that in order to use this, you must also declare the CopyMemoryMethod like this:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Public Function Bin_ReadAll(strPath As String, arrBytes() As Byte)
'Reads Entire File in One Line of Code to a Byte Array (base 1)
'THIS WORKS
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
file_name = strPath
file_length = FileLen(file_name)
fnum = FreeFile
' ReDim arrBytes(1 To file_length)
ReDim arrBytes(1 To file_length)
Open file_name For Binary As #fnum
Get #fnum, 1, arrBytes
Close fnum
'=========================
'Dim txt As String
'Dim i As Long
'
' ' Display the results.
' For i = 1 To UBound(arrBytes) ' file_length
' txt = txt & Format$(arrBytes(i)) & vbCrLf
' Next i
End Function
Public Sub SplitBytesToBlocks(arrBytes() As Byte, arrOut() As Variant, Delimiter As Byte)
Dim i As Long
Dim j As Long ''Dimension Counter for arrOut
Dim blnFound As Boolean
Dim byteStart As Long
Dim LenBlock As Long
' Dim tmp(29) As Variant
j = -1
For i = LBound(arrBytes) To UBound(arrBytes)
If arrBytes(i) = Delimiter Then
'Skip the 1st byte as a Block
If Not i = LBound(arrBytes) Then
LenBlock = (i - byteStart) + 1
j = j + 1
ReDim Preserve tmp(j)
ReDim Preserve tmp(j).Test(LenBlock)
Call CopyMemory(tmp(j).Test(0), arrBytes(byteStart), LenB(LenBlock))
End If
byteStart = i
End If
Next
'Copy the Last Block
j = j + 1
LenBlock = (i - byteStart) + 1
ReDim Preserve tmp(j)
ReDim Preserve tmp(j).Test(LenBlock)
Call CopyMemory(tmp(j).Test(0), arrBytes(byteStart), LenB(LenBlock))
'----------------------------
'Verify tmp has data
'-----------------------------
Dim v As Variant
For i = LBound(tmp) To UBound(tmp)
For j = LBound(tmp(i).Test(j)) To UBound(tmp(i).Test(j)) '<<type mismatch
v = tmp(i).Test(j)
Next
Next
End Sub
Last edited by vb6forever; Jan 23rd, 2018 at 05:48 PM.
Don't you need to leave off the (j) for your LBound and UBound?
I didn't really study things, but that doesn't look right.
EDIT1: Something like this...
Code:
For j = LBound(tmp(i).Test) To UBound(tmp(i).Test)
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Thanks Elroy was just overlooking it. That resolves the "type mismatch"
Looks like I'm getting the correct dimension of tmp(i).Test(j) based on LenBlock copied,
but no data -- just Empty.
Never tried using CopyMemory to in effect cast from Byte to some other data type (here Variant).
Do you know if this is in fact can be done?
Hmmm, I didn't look at that part, but casting into a variant can be tricky. Variants often don't actually contain the data, but rather have a pointer to it. That's always the case with arrays. Therefore, you'll need to do some de-referencing to do that. Also, since it's an array, you may also need to wade through the SafeArray structure.
Just an honest question. Why not just put the array in the variant (simple LET)?
EDIT1: I did start looking at your code a bit, but I'm out of time. I'm sure someone else will come along and study your CopyMemory calls. Good Luck.
Last edited by Elroy; Jan 23rd, 2018 at 08:06 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Just an honest question. Why not just put the array in the variant (simple LET)?
Unless I'm missing something -- most probable -- how are you going to Let various portions (I call blocks)
of the Byte Array to a Variant Array ?
I can see where the entire Array can be LET, but if I do that, I'm in the same box as the byte array.
That is having to Loop the variant array in order to ID (cutout) each Block (group).
Similar to extracting strings from within a string.
It would be interesting if you can copymemory to a variant array
That's what I thought, but never actually seen implementation.
Obviously MS is doing something with their Conversion (CByte, CStr, etc). to get something
similar happen.
use vbscript regular expressions library
Prefer stay away from vbscript implementation.
Read file in chunks
Would then have to search within each chunk for the header (vbback) and then split and join
chunks such that each block out begins with vbback.
===========
Arnoutdb
===========
Can you explain what you want to accomplish?
Read a byte file, split it into blocks (chunks), and save "each block" in a separate variant array.
Each Block Out must have a header delimiter of vbback.
i
Do you want an array of an array of bytes?
Not as final output. Must be variant arrays.
Something like the Split() function on a string?
Yes, but instead of a trailer such as splitting on vbCrLf, need to split on the header of vbback.
Last edited by vb6forever; Jan 24th, 2018 at 05:51 AM.
Private Function CopyFile(QuellFile As String, ZielFile As String) As Boolean
Dim QF As Integer
Dim ZF As Integer
Dim Percent As Double
Dim CopyLen As Double
Dim Copied As Double
Dim AnzByte As Long
Dim Msg As String
Dim s As String
'Block to Copy
AnzByte = 256& * 256&
On Error GoTo Fehler
QF = FreeFile
Msg = "Fehler beim Öffnen QuellFile"
Open QuellFile For Binary As #QF
CopyLen = LOF(QF)
ZF = FreeFile
Msg = "Fehler beim Öffnen ZielFile"
Open ZielFile For Output As #ZF
On Error GoTo 0
Do
If CopyLen = Copied Then
Exit Do
ElseIf (CopyLen - Copied) < AnzByte Then
AnzByte = CopyLen - Copied
End If
s = Space(AnzByte)
Get #QF, Copied + 1, s
Print #ZF, s;
Copied = Copied + AnzByte
Picture1.Visible = True
Percent = (Copied * 100) \ CopyLen
ShowPercent Picture1, Percent
DoEvents
Loop
Close #QF, #ZF
CopyFile = True
Picture1.Visible = False
Exit Function
Fehler:
If ZF > 0 Then
Close #QF
End If
Msg = Msg & vbCrLf & vbCrLf & "Fehler: " & _
Err.Number & vbCrLf & Err.Description
MsgBox Msg, vbCritical, "Fehler Copy"
Err.Clear
End Function
HTH
regards
Chris
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
====
ChisE
====
Thanks for post. Will take a look see, but cursory review looks like just copy one to other not separating by blocks.
=====
Arnoutdv
=======
Why a variant array?
Can you explain what you are going to do with your array of variant arrays?
The receiving procedure requires a Type with various array elements being variant.
FWIW: I'm trouble shooting an email program which receives email using Winsock.
It is failing in the parsing procedure on selected emails.
I've obtained a group of emails (byte array), some of which are failing, and now what to fed them
into the parsing routine to troubleshoot. Consequently, wish to separate those that work
from those that don't to narrow down where parsing error is occurring.
This is being done offline.
If the issue is reading a file of BLOBs each having a BS (&H08) byte as a prefix and placing these into a Variant array as Byte arrays with the BS stripped off... I don't see the issue.
I must have missed something, because it seems like a common enough sort of thing. Chunk the data in, parse for the BLOB data.
Here I have created BLOBs of varying size that begin with a 6 byte Index prefix (ANSI digits with left-zero fill), then an ANSI space, then some varying length ANSI text.
After a reboot to clear the disk cache (and thus get more accurate timing), this program reads the data, parses it, stores the BLOBs without the "header" BS byte in a Variant array. Then the "verify" step grabs and displays the Index prefix of the first and last BLOB loaded.
Code:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Blobs() As Variant
Private Sub Command1_Click()
Const CHUNKSIZE As Long = 100 'ReDim Preserve chunk size.
Dim T0 As Long
Dim Delim As String
Dim F As Integer
Dim BytesLeft As Long
Dim Buffer() As Byte
Dim BufferString As String
Dim PastFirstBlob As Boolean
Dim BufferStringCursor As Long
Dim BlobString As String
Dim DelimPos As Long
Dim Blob() As Byte
Dim BlobsIndex As Long
T0 = GetTickCount()
Delim = ChrB$(vbKeyBack)
ReDim Blobs(CHUNKSIZE - 1)
F = FreeFile(0)
Open "data.dat" For Binary Access Read As #F
BytesLeft = LOF(F)
ReDim Buffer(32767)
Do While BytesLeft > 0
If BytesLeft < UBound(Buffer) + 1 Then ReDim Buffer(BytesLeft - 1)
Get #F, , Buffer
BufferString = Buffer
BytesLeft = BytesLeft - (UBound(Buffer) + 1)
'Base 1 for use with String operations:
If PastFirstBlob Then
BufferStringCursor = 1
Else
PastFirstBlob = True
BufferStringCursor = 2
End If
Do While BufferStringCursor < LenB(BufferString)
DelimPos = InStrB(BufferStringCursor, BufferString, Delim, vbBinaryCompare)
If DelimPos > 0 Then
BlobString = BlobString _
& MidB$(BufferString, _
BufferStringCursor, _
DelimPos - BufferStringCursor)
Blob = BlobString
BlobString = vbNullString
If BlobsIndex > UBound(Blobs) Then
ReDim Preserve Blobs(UBound(Blobs) + CHUNKSIZE)
End If
Blobs(BlobsIndex) = Blob
Erase Blob
BlobsIndex = BlobsIndex + 1
BufferStringCursor = DelimPos + 1
Else
BlobString = BlobString & MidB$(BufferString, BufferStringCursor)
Exit Do
End If
Loop
Loop
Close #F
'Last Blob:
Blob = BlobString
BlobString = vbNullString
If BlobsIndex > UBound(Blobs) Then
ReDim Preserve Blobs(UBound(Blobs) + CHUNKSIZE)
End If
Blobs(BlobsIndex) = Blob
Erase Blob
If (BlobsIndex + 1) Mod CHUNKSIZE <> 0 Then ReDim Preserve Blobs(BlobsIndex)
Label1.Caption = "Blobs(0 To " _
& CStr(BlobsIndex) _
& ") loaded in " _
& Format$(CSng(GetTickCount() - T0) / 1000, "0.0##") _
& " sec"
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
Label3.Caption = StrConv(LeftB$(Blobs(0), 6), vbUnicode)
Label4.Caption = "Blobs(" & CStr(UBound(Blobs)) & ")"
Label5.Caption = StrConv(LeftB$(Blobs(UBound(Blobs)), 6), vbUnicode)
End Sub
Both programs attached.
Seems easy enough, and fast enough for most purposes. What am I missing?
Do you know whether CopyMemory can be used to Type Cast as in post #2 -- or some alternate CopyMemory rework?
I can't really figure out what you were trying to do in post #2.
I thought you said you wanted a Variant array containing Byte arrays, but what you have there is some weirdness with an array of UDTs that contain a Variant array. Why would you want each BLOB to have the overhead of a UDT plus each Byte of each BLOB having the overhead of a Variant? You are throwing away memory like a drunken sailor.
If you can clarify what you are after maybe we can be more helpful. I think I'm lost.
I can't really figure out what you were trying to do in post #2.
Interesting. I thought it was fairly straightforward.
I'm just trying to take a byte array, split it based on a header byte (vbback in this case is the header byte for each grouping),
then move each byte group (chunk, segment or blob depending on ones terminology) into a Structure element, where that element happens to be a Variant array.
Each byte array group WITHIN the byte array varies in length, hence one must locate (id) the header byte at the start of the group when reading in order to know where each group begins.
A structure is being used because each byte group can be further subdivided into two parts.
Right now I'm just trying to solve the splitting of each group, as the splitting of the subgroups will duplicate the group split.
The problem probably is - though your code isn't (I'm also quite confused by it)...
Originally Posted by vb6forever
A structure is being used because each byte group can be further subdivided into two parts.
Right now I'm just trying to solve the splitting of each group, as the splitting of the subgroups will duplicate the group split.
Why not solve everything in one go then ...
(the UDT-def below already addressing your "two parts" with a matching type - no Variant in sight anywhere - and also no CopyMemory):
Code:
Option Explicit
Private Type twoParts
Part1() As Byte
Part2() As Byte
End Type
Private Sub Form_Load()
Dim B() As Byte, List() As twoParts, i As Long
B = StrConv(vbBack & "a1" & vbTab & "b1" & vbBack & "a2" & vbTab & "b2", vbFromUnicode)
For i = 0 To SplitBytes(B, List, vbKeyBack, vbKeyTab) - 1
With List(i)
Debug.Print StrConv(.Part1, vbUnicode), StrConv(.Part2, vbUnicode)
End With
Next
End Sub
Private Function SplitBytes(B() As Byte, List() As twoParts, ByVal BlobDel As Byte, ByVal PartDel As Byte) As Long
Dim i As Long, BlobIdx As Long, PartIdx As Long, PartLen As Long
ReDim Preserve B(0 To UBound(B) + 1): B(UBound(B)) = BlobDel
Do Until B(i) = BlobDel: i = i + 1: Loop
For i = i + 1 To UBound(B)
If B(i) = PartDel Or B(i) = BlobDel Then
ReDim Preserve List(0 To BlobIdx)
If PartIdx = 0 Then List(BlobIdx).Part1 = MidB$(B, i - PartLen + 1, PartLen)
If PartIdx = 1 Then List(BlobIdx).Part2 = MidB$(B, i - PartLen + 1, PartLen)
PartLen = 0
If B(i) = BlobDel Then BlobIdx = BlobIdx + 1: PartIdx = 0 Else PartIdx = PartIdx + 1
Else
PartLen = PartLen + 1 'increment PartLen
End If
Next
SplitBytes = BlobIdx
End Function
In regard to the code.
I have a byte file with over 100,000 bytes.
There are 28 groupings within this file.
# bytes in each group vary.
For example :
<--- Group 1 ---><---Group 2----><---- Group 3---><............. ><-- Group 28 --->
vbBack 01 03 25 vbback 10 35 85 vbback 86 100 18 vbback .................................. EOF
Each grouping starts with a header byte of vbback (the delimiter).
I loop the file one byte at a time, tracking each byte position as it is read -- using the loop counter.
When the delimiter (first byte in each group AKA vbback AKA header byte) is encountered, its
position value is assigned to a variable called byteStart.
The ending byte of each group is then calculated using the formula: LenBlock = (i - byteStart) + 1
After that calculation is when I attempt to use CopyMemory to copy "each" byte group to the Structure variant array.
The loop continues doing the same thing till EOF, using CopyMemory and each groups Start position and the Length (# bytes in each group) in an attempt to copy each byte group to the Structure variant array.
The kicker in this is whether or Not one can use CopyMemory to copy a byte array to a variant array.
No error occurs, but no bytes appear to be copied.
I'm sorry I mentioned the subgroups as this only confused the issue.
BTW, how's your JSON-parsing coming along...
Per post #14 is back burner for now since 1 off.
Last edited by vb6forever; Jan 24th, 2018 at 09:58 PM.
<--- Group 1 ---><---Group 2----><---- Group 3---><............. ><-- Group 28 --->
vbBack 01 03 25 vbback 10 35 85 vbback 86 100 18 vbback .................................. EOF
Each grouping starts with a header byte of vbback (the delimiter).
As said your format - and the "parsing-stuff" are understood and not really the problem.
The problem I have with your code is the data-structures you use for (temp) storage -
and the lines which finally do that weird copying of Blob-Bytes into a Member of an UDT-Array, which itself is a Variant-Array.
In my opinion you need only a Single Variant-Array (if we leave the SubParts out for the moment) -
and no CopyMemory and also no UDT - because the following works, if you'd care to check it out:
(only thing different in the Input-Data is, that my ByteArray B() is zerobased instead of your onebased-fileread-result.
Code:
Private Sub Form_Load()
Dim B() As Byte, List() As Variant, i As Long
B = StrConv(vbBack & "a" & vbBack & "b" & vbBack & "c", vbFromUnicode)
For i = 0 To SplitBytes(B, List, vbKeyBack) - 1
Debug.Print TypeName(List(i)), StrConv(List(i), vbUnicode)
Next
End Sub
Private Function SplitBytes(B() As Byte, List(), ByVal BlobDel As Byte) As Long
Dim i As Long, BlobIdx As Long, BlobLen As Long, Blob() As Byte
ReDim Preserve B(0 To UBound(B) + 1): B(UBound(B)) = BlobDel
Do Until B(i) = BlobDel: i = i + 1: Loop
For i = i + 1 To UBound(B)
If B(i) = BlobDel Then
Blob = MidB$(B, i - BlobLen + 1, BlobLen)
ReDim Preserve List(0 To BlobIdx): List(BlobIdx) = Blob
BlobLen = 0: BlobIdx = BlobIdx + 1
Else
BlobLen = BlobLen + 1
End If
Next
SplitBytes = BlobIdx
End Function
The longer line which does the StrConv in Form_Load actually only constructs an input-array with the following test-content:
[8, 97, 8, 98, 8, 99]
And looping over the List-Result prints out 3 found "Blobs", which are of type ByteArray and contain
the Ascii-Values for a, b, and c respectively (each blob-bytearray consisting of only a single char-value).
Let me thank everyone for posting.
A special thanks to Olaf:
1) I used his code with some small modifications.
Of note was that I wanted to keep the header byte with each block (Blob).
2) I learned something. His approach to add a header byte on the each of the byte array
was something I've never seen and yet worked well.
Code as revised with Notes added.
Code:
Public Function SplitBytes(arrByte() As Byte, List(), ByVal Delimiter As Byte) As Long
Dim i As Long
Dim BlobIdx As Long
Dim BlobLen As Long
Dim Blob() As Byte
'Increase the Size of the Input Array by one byte
ReDim Preserve arrByte(LBound(arrByte) To UBound(arrByte) + 1)
'Assign the Delimiter tp this Last byte
'This is needed so that a delimiter is encountered (like EOF)
'to allow our For/Next to exit
arrByte(UBound(arrByte)) = Delimiter
'My Add for My Mental Clarity.
'Not really needed as System initializes all variables to zero
BlobIdx = 0
BlobLen = 0
'Start at the first byte
i = 1
'Check byte array to get position of 1st delimiter in file
'May Not always be at start of file
Do Until arrByte(i) = Delimiter
i = i + 1
Loop
'Start Looping one byte beyond our delimiter
'and loop to UBound. (note: UBound contains a delimiter)
For i = i + 1 To UBound(arrByte)
If arrByte(i) = Delimiter Then
'Delimiter Encountered so move the Block of bytes
'From the Delimiter to the byte before the delimiter
'to the Blob (temporary) byte array.
Blob = MidB$(arrByte, i - BlobLen - 1, BlobLen)
'Increase the Size of the LIst Array to Hold the Next Block
ReDim Preserve List(0 To BlobIdx)
'Save the Block from Blob (temporary) array to the List array
List(BlobIdx) = Blob
'Reinitalize counters for next Block Read
BlobLen = 0
BlobIdx = BlobIdx + 1
Else
'Track the number of bytes read until
'a delimiter is encountered
BlobLen = BlobLen + 1
End If
Next
SplitBytes = BlobIdx
End Function
[RESOLVED] Copy Array Bytes by Block to Variant Arrays
Reply With Quote
Originally Posted by vb6forever
