発掘 ファイルのタイムスタンプの取得・設定

#注意事項
本編は
http://jeanne.wankuma.com/tips/file/09-settimestamp.html
を発掘したものである。
Visual Basic 向けとなっているが当時のものであり、VBA7ではPtrsafeが必要と思われる。


#ファイルのタイムスタンプの取得・設定

Visual Basicからファイルのタイムスタンプの取得・変更の方法は、いろんなところで取り上げられWindows APIを使った例としては割とポピュラーですが、その中でも私なりに重要だと思うノウハウを...。

##ＡＰＩの宣言

```visualbasic
Option Explicit

Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = (-1)

Private Type tagWIN32_FIND_DATA
    dwFileAttributes    As Long
    ftCreationTime      As Currency
    ftLastAccessTime    As Currency
    ftLastWriteTime     As Currency
    nFileSizeHigh       As Long
    nFileSizeLow        As Long
    dwReserved0         As Long
    dwReserved1         As Long
    cFileName           As String * MAX_PATH
    cAlternateFileName  As String * 14
End Type

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
                                (ByVal lpFileName As String, _
                                 lpFindFileData As tagWIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" _
                                (ByVal hFindFile As Long) As Long

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

Private Declare Function LocalFileTimeToFileTime Lib "kernel32" _
                                (lpLocalFileTime As Currency, _
                                 lpFileTime As Currency) As Long

Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
                                (lpFileTime As Currency, _
                                 lpLocalFileTime As Currency) As Long

Private Const conDayZeroBios        As Double = 109205#
Private Const conMillisecondPerDay  As Double = 10000000# * 60# * 60# * 24# / 10000#

Private Declare Function SetFileTime Lib "kernel32" _
                                (ByVal hFile As Long, _
                                 lpCreationTime As Currency, _
                                 lpLastAccessTime As Currency, _
                                 lpLastWriteTime As Currency) As Long

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 Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3

Private Type tagOSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type

Private Const VER_PLATFORM_WIN32_NT = 2

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
                                (lpVersionInformation As tagOSVERSIONINFO) As Long
```
##ファイルのタイムスタンプの取得
' ファイルのタイムスタンプを得る。
'
Public Sub GetFileTimeStamp(strFileName As String, _
                            dteCreateTime As Date, _
                            dteWriteTime As Date, _
                            dteAccessTime As Date)
    Dim lngFindFileHandle As Long
    Dim lngResult       As Long
    Dim lt              As Currency
    Dim wfd             As tagWIN32_FIND_DATA

    lngFindFileHandle = FindFirstFile(strFileName, _
                                      wfd)
'    If lngFindFileHandle <> 0 Then  2003/07/21 修正
    If lngFindFileHandle <> INVALID_HANDLE_VALUE Then
        ' ハンドルをクローズする。
        lngResult = FindClose(lngFindFileHandle)

        ' ローカル時間に変換する。
        lngResult = FileTimeToLocalFileTime(wfd.ftCreationTime, lt)
        ' FILETIMEをＶＢの日付型に変換する。
        dteCreateTime = CDate((lt / conMillisecondPerDay) - conDayZeroBios)

        ' ローカル時間に変換する。
        lngResult = FileTimeToLocalFileTime(wfd.ftLastWriteTime, lt)
        ' FILETIMEをＶＢの日付型に変換する。
        dteWriteTime = CDate((lt / conMillisecondPerDay) - conDayZeroBios)

        ' ローカル時間に変換する。
        lngResult = FileTimeToLocalFileTime(wfd.ftLastAccessTime, lt)
        ' FILETIMEをＶＢの日付型に変換する。
        dteAccessTime = CDate((lt / conMillisecondPerDay) - conDayZeroBios)
    End If
End Sub

##ファイルのタイムスタンプの変更

```visualbasic
'
' ファイルのタイムスタンプを設定する。
'
Public Function SetFileTimeStamp(strFileName As String, _
                                 dteCreateTime As Date, _
                                 dteWriteTime As Date, _
                                 dteAccessTime As Date) As Boolean
    Dim lft             As Currency
    Dim cft             As Currency
    Dim wft             As Currency
    Dim aft             As Currency
    Dim lngResult       As Long
    Dim lngFileHandle   As Long
    Dim lngFlag         As Long
    Dim ovi             As tagOSVERSIONINFO

    ' ＶＢの日付型をFILETIMEに変換する。
    lft = CCur((dteCreateTime + conDayZeroBios) * conMillisecondPerDay)
    ' ローカル時間をUTC時間へ変換する。
    lngResult = LocalFileTimeToFileTime(lft, cft)

    ' ＶＢの日付型をFILETIMEに変換する。
    lft = CCur((dteWriteTime + conDayZeroBios) * conMillisecondPerDay)
    ' ローカル時間をUTC時間へ変換する。
    lngResult = LocalFileTimeToFileTime(lft, wft)

    ' ＶＢの日付型をFILETIMEに変換する。
    lft = CCur((dteAccessTime + conDayZeroBios) * conMillisecondPerDay)
    ' ローカル時間をUTC時間へ変換する。
    lngResult = LocalFileTimeToFileTime(lft, aft)

    ovi.dwOSVersionInfoSize = Len(ovi)
    lngResult = GetVersionEx(ovi)
    ' OSがNTかどうか？
    If ovi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
    ' OSがNTかどうか？
    If ovi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
        ' このフラグを入れるとＯＳがＮＴの時のみディレクトリのハンドルを取得できる。
        lngFlag = FILE_FLAG_BACKUP_SEMANTICS
    End If
    ' ファイルを開いて、ファイルハンドルを取得する。
    lngFileHandle = CreateFile(strFileName, _
                               GENERIC_READ Or GENERIC_WRITE, _
                               0, _
                               ByVal 0&, _
                               OPEN_EXISTING, _
                               lngFlag, _
                               0)
'    If lngFileHandle <> 0 Then  2003/07/21 修正
    If lngFileHandle <> INVALID_HANDLE_VALUE Then
        ' タイムスタンプを変更する。
        lngResult = SetFileTime(lngFileHandle, _
                                cft, _
                                aft, _
                                wft)
        If lngResult = 0 Then
            SetFileTimeStamp = False
        Else
            SetFileTimeStamp = True
        End If
        ' ファイルを閉じる。
        Call CloseHandle(lngFileHandle)
    Else
        SetFileTimeStamp = False
    End If
End Function