Re: Add/remove zero index of array

"Tim Rude" <timrude@xxxxxxxxxxxxxxxxxx> wrote in message news:uooT1NmRIHA.2376@xxxxxxxxxxxxxxxxxxxxxxx

I think I've actually got it sorted out now. I'm using a
trick suggested by RB Smissaert to adjust the LBound
and UBound of my array, and then shifting each record
up or down. It works and it seems very fast.

You don't need to shift any records up or down. If you do it correctly you can create and use your zero based array and when the time comes to save it you can save just elements (1) onwards. The trick is to persuade VB that the array has one less element than it really has, and to also persuade it that the array data starts somewhere else than it really does (persuade VB that element (1) is the start of the data instead of element (0)). If you do it this way you can save the array in a simple "one liner" Put statement. Here's some code which does exactly that. I've placed plenty of comments in the code so that you can see what is going on. This example (because I'm pushed for time at the moment) just saves the array, but you can very easily retrieve the array from disk in the manner you require using a similar technique. Anyway, here's the code. Paste it into a VB Form containing a Command Button:

Mike

Option Explicit
Private Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
cElements As Long
lLbound As Long
End Type
Private Declare Function VarPtrArray _
Lib "msvbvm60.dll" Alias "VarPtr" _
(Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, ByVal Length As Long)
Private Declare Sub BindArray Lib "kernel32" _
Alias "RtlMoveMemory" (PArr() As Any, _
PSrc&, Optional ByVal cb& = 4)
Private Declare Sub ReleaseArray Lib "kernel32" _
Alias "RtlMoveMemory" (PArr() As Any, _
Optional PSrc& = 0, Optional ByVal cb& = 4)
Private Type myUDT
s1 As String * 5
s2 As String * 8
s3 As String * 6
End Type
Dim DB() As myUDT

Private Sub Command1_Click()
ReDim DB(0 To 100)
' Place some test data into array
DB(0).s1 = "This"
DB(0).s2 = "Won't"
DB(0).s3 = "Save"
DB(1).s1 = "Rum"
DB(1).s2 = "Coke"
DB(2).s1 = "Gin"
DB(2).s2 = "Tonic"
' Now save just elements 1 to UBOund(DB) to file:
' (1) create an array of myUDT
Dim arr1() As myUDT
' (2) create a SAFEARRAY structure
Dim sa1 As SAFEARRAY1D
' (3) set number of Dimensions to 1 (1D array)
sa1.cDims = 1
' (4) set byte length of each element to the correct
' value, remembering that in memory each VB character
' occupies two bytes (hence LenB instead of Len)
sa1.cbElements = LenB(DB(0))
' (5) set total number of elements to one less than
' the total number of elements in the array DB()
sa1.cElements = UBound(DB) - LBound(DB)
' (6) set the data pointer to point to the element
' DB(1) instead of element DB (0)
sa1.pvData = VarPtr(DB(1)) ' set data pointer to skip DB(0)
' make VB think that arr1 is our SAFEARRAY structure
BindArray arr1, VarPtr(sa1)
' create an empty file first (to kill the existing file)
Open "c:\temp\1myfile.txt" For Output As 1
Close 1
' now save the arr1() data to disk (Arr1 "thinks" that
' it has one less element that DB() and that its data
' starts at the start of the data for DB(1)
Open "c:\temp\1myfile.txt" For Binary As 1
Put #1, 1, arr1()
Close 1
' tidy up
ReleaseArray arr1
End Sub



.

Loading