devxlogo

SetFileSize – Trim or extend a file’s size

SetFileSize – Trim or extend a file’s size

Option ExplicitPrivate Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal _    lpFileName As String, ByVal dwDesiredAccess As Long, _    ByVal dwShareMode As Long, lpSecurityAttributes As Any, _    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _    ByVal hTemplateFile As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _    LongPrivate Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, _    ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, _    ByVal dwMoveMethod As Long) As LongPrivate Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As _    LongPrivate Const FILE_BEGIN = 0Private Const OPEN_EXISTING = 3Private Const INVALID_HANDLE_VALUE = -1Private Const GENERIC_WRITE = &H40000000' Extend or trim a file to a given length.' If the file is extended, the added bytes are undefinedPublic Sub SetFileSize(ByVal FileName As String, ByVal newSize As Long)    Dim fileHandle As Long        ' open the file, get the handle    fileHandle = CreateFile(FileName, GENERIC_WRITE, 0&, ByVal 0&, _        OPEN_EXISTING, 0&, 0&)        ' raise error if not found    If fileHandle = INVALID_HANDLE_VALUE Then        Err.Raise 53     ' This is "file not found"    End If        ' move the file pointer to new position, raise error if fails    If SetFilePointer(fileHandle, newSize, 0&, FILE_BEGIN) = -1 Then        CloseHandle fileHandle        Err.Raise 5     ' this is "illegal function call"    End If        ' attempt to set the end of file, raise error    If SetEndOfFile(fileHandle) = 0 Then        CloseHandle fileHandle        Err.Raise 5     ' this is "illegal function call"    End If        ' close the file and exit    CloseHandle fileHandleEnd Sub

devx-admin

Share the Post: