● ファイルを指定サイズで作成または切り捨てる ●

ファイルをサイズ指定で作成したり、切り捨てたりするコードを思いつきで書いてみた。大き過ぎるファイルの挙動は試してないので不明。API関数 SetFilePointer と SetEndOfFile 頼みの処理である。なおファイル作成時、その内容はすべてNULL文字で埋められる。

Private Declare Function CreateFile 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

Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByRef lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long

Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const CREATE_ALWAYS As Long = 2
Private Const OPEN_EXISTING As Long = 3
Private Const GENERIC_WRITE As Long = &H40000000

Private Const FILE_BEGIN = 0
Private Const FILE_END = 2
Private Const INVALID_HANDLE_VALUE As Long = (-1)

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能:ファイルを作成する
' 引  数:(i)FileName … ファイル名
'         (i)FileSize … 作成するファイルサイズ(デフォルト:0)
' 返り値:正常…True  異常…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function CreateFileWithSize(ByVal FileName As String, _
                                   Optional ByVal FileSize As Long = 0) As Boolean
    Dim hFile As Long
    Dim FuncRet As Long

    'ファイルを作成
    hFile = CreateFile(FileName, GENERIC_WRITE, 0, 0, CREATE_ALWAYS, 0, 0)
    If hFile = INVALID_HANDLE_VALUE Then Exit Function

    'ファイルサイズが指定されている場合
    If FileSize > 0 Then

        'ファイルポインタを移動
        FuncRet = SetFilePointer(hFile, FileSize, ByVal 0&, FILE_BEGIN)
        If FuncRet = 0 Then GoTo FunctionExit

        'ファイルの終端を設定する
        FuncRet = SetEndOfFile(hFile)
        If FuncRet = 0 Then GoTo FunctionExit
    End If

    '正常終了
    CreateFileWithSize = True

FunctionExit:
    'ファイルハンドルを閉じる
    If hFile Then Call CloseHandle(hFile)
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能:ファイルを特定位置で切り捨てる
' 引  数:(i)FileName … ファイル名
'         (i)TruncPos … 切り捨て位置(バイト)
'         (i)IsFromTop… True :TruncPos以降を切り捨てる
'                        False:後尾からTruncPos以降を切り捨てる
' 返り値:正常…True  異常…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function TruncateFile(ByVal FileName As String, ByVal TruncPos As Long, _
                             Optional ByVal IsFromTop As Boolean = True) As Boolean
    Dim hFile As Long
    Dim FuncRet As Long

    'ファイルを開く
    hFile = CreateFile(FileName, GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)
    If hFile = INVALID_HANDLE_VALUE Then Exit Function

    '前から切り捨て
    If IsFromTop Then
        FuncRet = SetFilePointer(hFile, TruncPos, ByVal 0&, FILE_BEGIN)
    '後ろから切り捨て
    Else
        FuncRet = SetFilePointer(hFile, TruncPos * (-1), ByVal 0&, FILE_END)
    End If
    If FuncRet = 0 Then GoTo FunctionExit

    'ファイルの終端を設定する
    FuncRet = SetEndOfFile(hFile)
    If FuncRet = 0 Then GoTo FunctionExit

    正常終了
    TruncateFile = True

FunctionExit:
    'ファイルハンドルを閉じる
    If hFile Then Call CloseHandle(hFile)
End Function

戻る