Option Explicit
Public Declare Function ReadFileNO Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Public Declare Function CreateFileNS Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function WriteFileNO Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Public Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const CREATE_ALWAYS = 2
Public Const CREATE_NEW = 1
Public Const OPEN_ALWAYS = 4
Public Const OPEN_EXISTING = 3
Public Const TRUNCATE_EXISTING = 5
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Public Const FILE_FLAG_NO_BUFFERING = &H20000000
Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
Public Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Public Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Public Const FILE_FLAG_WRITE_THROUGH = &H80000000
Public Function ReadFileAPI(File As String) As String
Dim filesizelow As Long
Dim filesizehigh As Long
Dim longbuffer As Long
Dim stringbuffer As String
Dim numread As Long
Dim hFile As Long
Dim retval As Long
On Error Resume Next
hFile = CreateFileNS(File, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0)
'get an handle for the file
If hFile = -1 Then
'there is an error! maybe the file doesn't exist
ReadFileAPI = "-1"
Exit Function
End If
filesizelow = GetFileSize(hFile, filesizehigh)
'get the size of the file
stringbuffer = Space(filesizelow)
'file a string with spaces
retval = ReadFileNO(hFile, ByVal stringbuffer, filesizelow, numread, 0)
'get the whole data of the file
If numread = 1 Then
'if numread is 1 then everything is ok!
ReadFileAPI = stringbuffer
Else
ReadFileAPI = -1
End If
retval = CloseHandle(hFile)
'important: close filehandle!
End Function
Public Function FileCleanWrite(FilePath As String, Data As String) As Long
'Saves files without adding extra bytes to the front or end of the file
Dim hFile As Long
Dim lBytesWritten As Long
Dim sTemp As String
'This API does not fail gracefully, so be careful
On Error GoTo Erro:
If Len(FilePath) = 0 Then
MsgBox "No Path Given"
Exit Function
Else
sTemp = Left$(FilePath, InStrRev(FilePath, "\"))
If Len(Dir(sTemp, vbDirectory)) = 0 Then
MsgBox "Directory does not exist"
Exit Function
ElseIf Len(Dir(FilePath)) = 0 Then
'It's a new file, create a 'seed' file
FileSaveString FilePath, ""
End If
End If
hFile = CreateFileNS(FilePath, GENERIC_WRITE, FILE_SHARE_READ, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_ARCHIVE, 0)
'get an handle for the file
If hFile = -1 Then
'there is still an error!
FileCleanWrite = "-1"
CloseHandle hFile
Exit Function
End If
'write the data
WriteFileNO hFile, ByVal Data, Len(Data), lBytesWritten, 0
'returns the number of written bytes
FileCleanWrite = lBytesWritten
'important: close filehandle!
Erro:
CloseHandle hFile
End Function