Using Createfile, Readfile, and Writefile In Gfa Basic
In this example we load an rich text file directly into a Gfa Basic 32
rtf object. It demonstrates the usage of the Microsoft orthodox method
for file loading and saving in 32 bit Windows.
I have some issues with this, these are some of the most complex
API for the most used tasks, and they do not work at all unless every
parameter is just right. This is probably why many programming languages
put these functions in a wrapper.
In this example I use a GFA Basic Array as a buffer. However there
have been rare instances of memory not being fully released in applications
that are Gfa Basic Array intensive toward erasing and re-dimensioning of the
same array as of this writing. I hypothesize that this may have happened as a
result of parts of the compiler used by the developer were also intending
compatibility with 16 bit UNIX and 16 bit Windows, while Microsoft was at
the same time adding a layer or rung to isolate the hardware into acting as
a linear 32 bit memory model.
I will move on to the 32 bit Windows memory model and GFA Basic in the
next example.
The zip file includes an .rtf for the example.
Click here to download Rtf_ReadfileWritefileDirect.zip
'By Allan Shura 2009
'neotreksoftware.com
'Note: for the procedures to succeed in this example the
'destination file must exist and be of the same byte size
Global Const MOVEFILE_REPLACE_EXISTING = &H100
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
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 OPEN_EXISTING = 3
Global Const GENERIC_READ = &H80000000
Global Const GENERIC_WRITE = &H40000000
'hardcode a rich edit box
Form frm1 = "GFA Basic 32 Rtf", 10, 10, 450, 260
Ocx RichEdit rtf1 = "", 0, 0, 400, 200
rtf1.ScrollBars = 3
Global Fbuff|()
Global dwFileSize As Int32
Global dwFileSizeNew As Double
Global lpBuffer As Long
Global dwError As Double
Global FileName As String
FileName = App.Path + "\test.rtf"
@GB_ReadFileExistMemBufCreate_MaxInt(FileName)
MsgBox "Writefile..."
@GB_WriteFileExistMemBufExist_MaxInt(FileName)
End
Function GB_ReadFileExistMemBufCreate_MaxInt(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.
'CREATE_ALWAYS 'Creates a new file. Overwrites the file if it exists.
'OPEN_EXISTING 'Opens the file. Fails if the file does not exist.
'OPEN_ALWAYS 'Opens the file, if it exists. Defaults to CREATE_NEW if the file does not exist.
'TRUNCATE_EXISTING 'Opens the file and reduces contents to zero bytes
Dim dwFlagsAndAttributes As Double 'file attributes
'Any combination of the following attributes is acceptable
'except all other file attributes override FILE_ATTRIBUTE_NORMAL.
'FILE_ATTRIBUTE_ARCHIVE The file should be archived. Applications use this attribute to mark files for backup or removal.
'FILE_ATTRIBUTE_COMPRESSED The file or directory is compressed. For a file, this means that all of the data in the file is compressed. For a directory, this means that compression is the default for newly created files and subdirectories.
'FILE_ATTRIBUTE_HIDDEN The file is hidden. It is not to be included in an ordinary directory listing.
'FILE_ATTRIBUTE_NORMAL The file has no other attributes set. This attribute is valid only if used alone.
'FILE_ATTRIBUTE_OFFLINE The data of the file is not immediately available. Indicates that the file data has been physically moved to offline storage.
'FILE_ATTRIBUTE_READONLY The file is read only. Applications can read the file but cannot write to it or delete it.
'FILE_ATTRIBUTE_SYSTEM The file is part of or is used exclusively by the operating system.
'FILE_ATTRIBUTE_TEMPORARY The file is being used for temporary storage. File systems attempt to keep all of the data in memory for quicker access rather than flushing the data back to mass storage. A temporary file should be deleted by the application as soon as it is no longer needed.
'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 dwfileSize As Double
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)
'hFile = lOpen(FileName, GENERIC_READ)
'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
@FileIOErrors
Exit Func
Else 'Existing was sucessfully opened
MsgBox "OK the file was opened."
'useing lpFileSizeHigh=Null=max size=_maxInt=&HFFFFFFFF
dwfileSize = GetFileSize(hFile, Null) //simlitude to LOF(#)
'MsgBox FileName & " " & Str(dwfileSize) & " Bytes"
If dwfileSize = _maxInt //The _maxInt special GB32 Variable
MsgBox "File Too large."
Exit Func
EndIf
If dwfileSize = 0
MsgBox "A zero Byte file was opened."
Exit Func
EndIf
nNumberOfBytesToRead = dwfileSize
'*******************************************
'In this example we use a GB byte array
'but we cannot do this until the filesize is known
Erase Fbuff|()
Global Fbuff|(dwfileSize)
lpBuffer = V:Fbuff|(0)
lpNumberOfBytesRead = lpBuffer - 4
'oddly enough where a gb array is used
'the pointer is moved back to account for the
'4 bytes of array discriptor!!
'********************************************
lpOverlapped = Null 'the read is limited to _maxInt
'here we do not the 32k selector memory model
'by implementing ReadFile
ret = SetFilePointer(hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod)
'MsgBox nNumberOfBytesToRead
Try
ret = ReadFile(hFile, lpBuffer, nNumberOfBytesToRead, lpNumberOfBytesRead, lpOverlapped) // address of structure for data
Local a$ = Space$(dwfileSize)
MemCpy(lpBuffer, V:a$, dwfileSize)
'***rtf test***
rtf1.TextRTF = a$
'of course we have our limits here, a 32 k string
'but we could always access our buffer by chr()
'or chunking.
'Recommend: rtf1.SaveFile instead of WriteFile
'as a$ does not include the size of rtf formatting
'tags and the filesize is larger
'****
Catch
If dwError <> 0
dwError = Err.LastDllError
@FileIOErrors
MsgBox "Read of file failed: " + Str(dwError)
EndIf
EndCatch
~CloseHandle(hFile)
DoEvents
End If
If dwError = 0
MsgBox " = Readfile Success"
EndIf
End Function
Function GB_WriteFileExistMemBufExist_MaxInt(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 Long
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 dwfileSize As Double
Dim ret As Double 'return variable
'Initialize file handle and error variable.
hfwrite = -1
dwError = 0
'Open for Writing
hfwrite = CreateFile(FileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, Null, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
'hfwrite = lOpen(FileName, FILE_SHARE_WRITE)
'note if the file was previously opened using GENERIC_READ
'you cannot write to the using WriteFile using GENERIC_WRITE
'in the same program instance! You will get a system error code
'number 5 ACCESS_DENIED !
'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
If dwError <> 0
@FileIOErrors
EndIf
Exit Func
Else 'Existing was sucessfully opened
MsgBox "OK the file was opened."
'useing lpFileSizeHigh=Null=max size=_maxInt=&HFFFFFFFF
'Use the same size as the old file or reccommend: rtf1.SaveFile
dwfileSize = GetFileSize(hfwrite, Null) 'simlular to LOF(#)
If dwfileSize = _maxInt 'The _maxInt special GB32 Variable
MsgBox "File Too large."
Exit Func
EndIf
If dwfileSize = 0
MsgBox "A zero Byte file was opened."
Exit Func
EndIf
'**not to erase buffer before writing
'the pointer is moved back to account for the
'4 bytes of array discriptor!!
lpOverlapped = Null 'the Written is limited to _maxInt
'here we do not use the 32k selector memory model
ret = SetFilePointer(hfwrite, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod)
nNumberOfBytesToWrite = dwfileSize
lpNumberOfBytesWritten = 0
'**** return **** 0 = True ***
Try
~WriteFile(hfwrite, lpBuffer, nNumberOfBytesToWrite, lpNumberOfBytesWritten, 0) // address of structure for data
Catch
dwError = Err.LastDllError
If dwError <> 0
@FileIOErrors
EndIf
EndCatch
~CloseHandle(hfwrite)
DoEvents
EndIf
If dwError = 0
MsgBox " = Writefile Success!"
EndIf
End Function
Procedure FileIOErrors
'
'we can add to these or Construct a full set
'using standard array as in the pollwing example number 3
'
'Instead of Windows or GB32 interrupts, system exceptions
'are handled from within our own GB 32 programs.
'
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