Using Createfile Readfile and Writefile

for dynamic GFA Basic ListBoxes

This example demonstrates directly loading a file to a GFA Basic 32

ListBox object with Readfile and Writefile. It will then add a text line

to the ListBox, then close and re-dimension the file memory buffer and

create a new file. It will then write the expanded Listbox contents to

the new buffer in memory and Save the buffer content to the new file.

Finally, it will load the new file back into the Listbox.

This example uses the Microsoft recommended method for allocating

virtual 32 bit memory in Windows. It is virtual because the memory

locations exist only in operating system code and are not the same

as the locations in the actual physical RAM , so that the application

will think that it has a linear addressing memory, that is not chunked

up into segments like 16 bit windows.

The allocated memory buffer is properly released and redimensioned

as required, so there is no buildup of unreleased memory or “leakage”

while the application is in use or after the application has closed.

The zip file contains the listbox testLB.txt file for the example.

Click here to download ListBox_ReadfileWritefileDirect.zip

By Allan Shura 2009

'use CreateFile first before Readfile and Writefile

'for direct reading and writing and redimensioning of

'text items from file

'for GFA Basic 32 listboxes

Global dwFileSize As Double

Global dwError As Double 'error code variable

Global lpBuffer As Long

@DefineW32Constants

LoadForm frm1

Ocx ListBox lb1 = "", 0, 0, 420, 260

lb1.ScrollBars = 3

lb1.Sorted = False

Global MemoryBuffer$

MemoryBuffer$ = "W32MemBuff"

@InitArr

Global FileName As String

FileName = App.Path + "\testLB.txt"

@GB_ReadFile_TextToListbox_W32MemBufCreate(FileName)

'change the filename and add to the listbox text

'and also create a new file

FileName = App.Path + "\testhello.txt"

@GB_WriteFile_TextFromListbox_W32MemBufCreate(FileName)

'see the expanded listbox from the new file

@GB_ReadFile_TextToListbox_W32MemBufCreate(FileName)

@AppCloseArr 'release all buffer memory

Do : Sleep : Until Me Is Nothing

End

Function GB_ReadFile_TextToListbox_W32MemBufCreate(FileName As String)

'CreateFile Parameters

Dim lpFileName As Long 'pointer to name of the file

Dim dwDesiredAccess As Double 'access (GENERIC_READ or GENERIC_WRITE) mode or 0 query attributes

Dim dwShareMode As Double 'share mode (FILE_SHARE_READ FILE_SHARE_WRITE)

Dim lpSecurityAttributes As Long 'pointer to security attributes

Dim dwCreationDistribution As Double 'CREATE_NEW Creates a new file. Fails if exists.

Dim dwFlagsAndAttributes As Double 'file attributes

'ReadFile Parameters

Dim hFile As Handle

Dim nNumberOfBytesToRead As Double

Dim lpNumberOfBytesRead As Long

Dim lpOverlapped As Long

'SetFilePointer Parameters

Dim lDistanceToMove As Long 'number of bytes to move file pointer

Dim lpDistanceToMoveHigh As Long 'address of high-order word of distance to move

Dim dwMoveMethod As Double 'how to move

lDistanceToMove = Null

lpDistanceToMoveHigh = Null

dwMoveMethod = 3

Dim ret As Double 'return variable

'Initialize file handle and error variable.

hFile = -1

dwError = 0

'Open for for read

hFile = CreateFile(FileName, GENERIC_READ Or GENERIC_WRITE , FILE_SHARE_READ Or FILE_SHARE_WRITE, Null, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)

'If we couldn't open the file, get the last error.

If hFile = -1 Then

dwError = Err.LastDllError 'point to Win 32 system error code

Else 'Existing was sucessfully opened

MsgBox "OK the file was opened."

'useing lpFileSizeHigh=Null=max size=_maxInt=&HFFFFFFFF

dwFileSize = GetFileSize(hFile, Null) 'simular to LOF(#)

If dwFileSize = _maxInt '_maxInt special GB32 Variable

MsgBox "File Too large."

Exit Func

EndIf

If dwFileSize = 0

MsgBox "A zero Byte file was opened."

Exit Func

EndIf

Try

arrszW32MemBuff% = dwFileSize

MemoryBuffer$ = "W32MemBuff"

@ReDimArr 'redimension with memory released

Catch

MsgBox "Error W32 Memory Buffer"

EndCatch

lpBuffer = sadrW32MemBuff%

nNumberOfBytesToRead = dwFileSize

lpNumberOfBytesRead = lpBuffer - 4

'oddly enough

'the pointer is moved back to account for the

' 4 bytes of array discriptor

lpOverlapped = Null 'the read is limited to _maxInt

'here we can end the 32k selector memory model

'(chunking) by implementing ReadFile

ret = SetFilePointer(hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod)

Try

ret = ReadFile(hFile, lpBuffer, nNumberOfBytesToRead, lpNumberOfBytesRead, lpOverlapped) // address of structure for data

'***ListBox Reading Text lines only***

Local n%, m%, a$

lb1.Clear

For n% = 0 To dwFileSize

a$ = ""

Repeat

a$ = a$ + Chr(Peek(lpBuffer + n%))

Inc n%

Until (Peek(lpBuffer + n%) = 13) _

And (Peek(lpBuffer + n% + 1) = 10) _

Or n% = dwFileSize

Inc n%

If n% < dwFileSize - 1

lb1.AddItem a$

EndIf

Next n%

MsgBox Str(ret) + " = Readfile Success"

Catch

If dwError <> 0

dwError = Err.LastDllError

MsgBox "Read of file failed: " + Str(dwError)

EndIf

EndCatch

~CloseHandle(hFile)

DoEvents

End If

If dwError <> 0

@FileIOErrorMsg

EndIf

End Function

Function GB_WriteFile_TextFromListbox_W32MemBufCreate(FileName As String)

'CreateFile Parameters

Dim lpFileName As Long 'pointer to name of the file

Dim dwDesiredAccess As Double 'access (GENERIC_READ or GENERIC_WRITE) mode or 0 query attributes

Dim dwShareMode As Double 'share mode (FILE_SHARE_READ FILE_SHARE_WRITE)

Dim lpSecurityAttributes As Long 'pointer to security attributes

Dim dwCreationDistribution As Double 'CREATE_NEW Creates a new file. Fails if exists.

Dim dwFlagsAndAttributes As Double 'file attributes

'WriteFile Parameters

Dim hfwrite As Handle

Dim nNumberOfBytesToWrite As Double

Dim lpNumberOfBytesWritten As Double

Dim lpOverlapped As Long

'SetFilePointer Parameters

Dim lDistanceToMove As Long 'number of bytes to move file pointer

Dim lpDistanceToMoveHigh As Long 'address of high-order word of distance to move

Dim dwMoveMethod As Double 'how to move

lDistanceToMove = Null

lpDistanceToMoveHigh = Null

dwMoveMethod = 3

Dim ret As Double 'return variable

'Initialize file handle and error variable.

hfwrite = 0

dwError = 0

'***IMPORTANT CHANGE Constant

'CREATE_ALWAYS

'***************************

'Open for for Writing

hfwrite = CreateFile(FileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, Null, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

'If we couldn't open the file, get the last error.

If hfwrite = 0 Then

dwError = Err.LastDllError //point to Win 32 system error code

Else 'Existing was sucessfully opened

MsgBox "OK the file was opened."

If dwFileSize = _maxInt ' _maxInt special GB32 Variable

MsgBox "File Too large."

Exit Func

EndIf

If dwFileSize = 0

MsgBox "A zero Byte file was opened."

Exit Func

EndIf

'**redimension buffer before writing

lb1.AddItem "Hello World"

'Count the buffer size

Local a$

Local n%, ListBoxTextBytes%

For n% = 0 To lb1.ListCount - 1

ListBoxTextBytes% = ListBoxTextBytes% + Len(Str(lb1.List(n%))) + 2 'add the 2 text eol chars

Next n%

'add 4 discriptor bytes

ListBoxTextBytes% = ListBoxTextBytes% + 4

Try

arrszW32MemBuff% = ListBoxTextBytes%

MemoryBuffer$ = "W32MemBuff"

@ReDimArr

Catch

MsgBox "Error W32 Memory Buffer"

EndCatch

W32MemBuff_ofs% = sadrW32MemBuff%

For n% = 0 To lb1.ListCount - 1

a$ = Str(lb1.List(n%))

MemCpy(V:a$, W32MemBuff_ofs%, Len(a$))

W32MemBuff_ofs% = W32MemBuff_ofs% + Len(a$)

Poke W32MemBuff_ofs%, 13

Inc W32MemBuff_ofs%

Poke W32MemBuff_ofs%, 10

Inc W32MemBuff_ofs%

Next n%

lpBuffer = sadrW32MemBuff%

nNumberOfBytesToWrite = ListBoxTextBytes%

lpNumberOfBytesWritten = 0

lpOverlapped = Null 'the Written is limited to _maxInt

'here we can end the 32k selector memory model

'(chunking) by implementing WriteFile

ret = SetFilePointer(hfwrite, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod)

'**** return **** 0 = True ***

Try

~WriteFile(hfwrite, lpBuffer, nNumberOfBytesToWrite, lpNumberOfBytesWritten, 0) // address of structure for data

Catch

EndCatch

dwError = Err.LastDllError

If dwError <> 0

MsgBox "Write of file failed: " + Str(dwError)

@FileIOErrorMsg

Else

MsgBox " = Writefile Success"

EndIf

~CloseHandle(hfwrite)

DoEvents

EndIf

If dwError <> 0

@FileIOErrorMsg

EndIf

End Function

Procedure FileIOErrorMsg

If dwError = 2 'ERROR_FILE_NOT_FOUND

MsgBox "ERROR_FILE_NOT_FOUND"

Else If dwError = 3 'ERROR_PATH_NOT_FOUND

MsgBox "ERROR_PATH_NOT_FOUND"

Else If dwError = 4 'ERROR_TOO_MANY_OPEN_FILES

MsgBox "ERROR_TOO_MANY_OPEN_FILES"

Else If dwError = 5 'ERROR_ACCESS_DENIED

MsgBox "ERROR_ACCESS_DENIED"

Else If dwError = 6 'ERROR_INVALID_HANDLE

MsgBox "ERROR_INVALID_HANDLE"

Else If dwError = 32 'ERROR_SHARING_VIOLATION

MsgBox "ERROR_SHARING_VIOLATION"

Else If dwError = 33 'ERROR_LOCK_VIOLATION

MsgBox "ERROR_LOCK_VIOLATION"

Else If dwError = 110 'ERROR_OPEN_FAILED

MsgBox "ERROR_OPEN_FAILED"

Else If dwError = 111 'ERROR_BUFFER_OVERFLOW

MsgBox "ERROR_BUFFER_OVERFLOW"

Else If dwError = 112 'ERROR_DISK_FULL

MsgBox "ERROR_DISK_FULL"

Else

' MsgBox "Unspecified error on opening file: " + Str(dwError)

EndIf

Return

Procedure DefineW32Constants

Global Const MOVEFILE_REPLACE_EXISTING = &H100

'check reference

Global Const FILE_ATTRIBUTE_NORMAL = &H000

Global Const FILE_ATTRIBUTE_READONLY = &H001

Global Const FILE_ATTRIBUTE_HIDDEN = &H002

Global Const FILE_ATTRIBUTE_SYSYEM = &H004

Global Const FILE_ATTRIBUTE_DIRECTORY = &H010

Global Const FILE_ATTRIBUTE_ARCHIVE = &H020

'check reference

Global Const FILE_ATTRIBUTE_TEMPORARY = &H100

Global Const FILE_BEGIN = 0

Global Const FILE_SHARE_READ = &H1

Global Const FILE_SHARE_WRITE = &H2

Global Const CREATE_NEW = 1

Global Const CREATE_ALWAYS = 2 'Creates a new file. Overwrites the file if it exists.

Global Const OPEN_EXISTING = 3

Global Const GENERIC_READ = &H80000000

Global Const GENERIC_WRITE = &H40000000

Return

Procedure InitArr

If MemoryBuffer$ = "W32MemBuff"

Global hmemW32MemBuff As Handle

Global badW32MemBuff%

Global sadrW32MemBuff%

Global arrszW32MemBuff%, arrdimW32MemBuff%

Global W32MemBuff_index%, W32MemBuff_ofs%

Global FlagFirstCreateArr_W32MemBuff| = 0

Global FlagArrActive_W32MemBuff| = 0

EndIf

Return

Procedure CreateArr

If MemoryBuffer$ = "W32MemBuff"

badW32MemBuff% = -1

hmemW32MemBuff = GlobalAlloc(0, arrszW32MemBuff%)'GMEM_FIXED is 0

sadrW32MemBuff% = GlobalLock(hmemW32MemBuff) //casting return value

badW32MemBuff% = IsBadReadPtr(sadrW32MemBuff%, arrszW32MemBuff%) // address of memory block

FlagArrActive_W32MemBuff| = 1 'flag for program and end release

If badW32MemBuff% = -1

MsgBox "Bad Pointer W32MemBuff"

Else 'flush buffer

MemZero sadrW32MemBuff%, arrszW32MemBuff%

EndIf

Return

Procedure ReleaseArr

If MemoryBuffer$ = "W32MemBuff"

MemZero sadrW32MemBuff%, arrszW32MemBuff% 'flush

~GlobalUnlock(hmemW32MemBuff)

hmemW32MemBuff = GlobalFree(hmemW32MemBuff)

FlagArrActive_W32MemBuff| = 0

EndIf

Return

Procedure ReDimArr

If MemoryBuffer$ = "W32MemBuff"

If FlagFirstCreateArr_W32MemBuff| = 0

@CreateArr

FlagFirstCreateArr_W32MemBuff| = 1

Else

If FlagArrActive_W32MemBuff| = 1

@ReleaseArr

EndIf

@CreateArr

EndIf

Return

Procedure AppCloseArr

If FlagArrActive_W32MemBuff| = 1

MemoryBuffer$ = "W32MemBuff"

@ReleaseArr

EndIf

Return