Option Compare Database
Option Explicit

Public Const FILE_ATTRIBUTE_ARCHIVE = &H20      'ｱｰｶｲﾌﾞ属性
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800  '
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10    'ﾃﾞｨﾚｸﾄﾘ属性
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_ATTRIBUTE_TEMPORARY = &H100   '

Public Const GENERIC_READ = &H80000000          '読み込みモード
Public Const GENERIC_WRITE = &H40000000         '書き込みモード
Public Const OPEN_EXISTING = 3                  'ファイルをオープンする。
Public Const OPEN_ALWAYS = 4                    'ファイルがあれば、ファイルをオープンする。

Type FILETIME
    dwLowDateTime As Long  '下位32bit
    dwHighDateTime As Long '上位32bit
End Type

Type SYSTEMTIME
    wYear As Integer         '現在の年
    wMonth As Integer        '月(1月=1, 2月=2)
    wDayOfWeek As Integer    '曜日(日曜=0, 月曜=1)
    wDay As Integer          '日
    wHour As Integer         '時
    wMinute As Integer       '分
    wSecond As Integer       '秒
    wMilliseconds As Integer 'ﾐﾘ秒
End Type

'ファイルハンドル取得
Declare Function CreateFileLong 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
'ハンドル開放
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'ファイルタイム取得
Declare Function GetFileTime Lib "kernel32" (ByVal hFile&, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
'ファイルタイムをローカルタイムに変換
Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
'ローカルタイムをシステムタイムに変換
Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
'システムタイムをローカルファイルタイムに変換
Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
'ローカルファイルタイムをファイルタイムに変換
Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
'最後に更新した日時を変更
Declare Function SetFileTimeLong Lib "kernel32" Alias "SetFileTime" (ByVal hFile&, ByVal lpCreationTime As Long, ByVal lpLastAccessTime As Long, lpLastWriteTime As FILETIME) As Long

'WindowsTempPathを取得
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nSize As Long, ByVal lpBuffer As String) As Long

Sub LsGetFileTime(TempFile As String, 作成日 As Date, 最終アクセス日 As Date, 最終更新日 As Date)
    'TempFile に渡されたファイルの日付情報を返します。
    Dim hFile As Long, RtnCd As Long
    Dim lpCreationTime As FILETIME
    Dim lpLastAccessTime As FILETIME
    Dim lpLastWriteTime As FILETIME
    Dim lpLocalFileTime As FILETIME
    Dim lpSystemTime As SYSTEMTIME
    Dim wDateTime As Date
    
    'ファイルハンドル取得
    hFile = CreateFileLong(TempFile, GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0)
    
    'ファイルタイム取得(作成日,最終アクセス日,最終更新日)
    RtnCd = GetFileTime(hFile, lpCreationTime, lpLastAccessTime, lpLastWriteTime)
    
    'ハンドル開放
    RtnCd = CloseHandle(hFile)
    
    'ファイルタイムをローカルタイムに変換
    RtnCd = FileTimeToLocalFileTime(lpCreationTime, lpLocalFileTime)
    GoSub Conv
    作成日 = wDateTime
    
    '最終アクセス日のファイルタイムをローカルタイムに変換
    RtnCd = FileTimeToLocalFileTime(lpLastAccessTime, lpLocalFileTime)
    GoSub Conv
    最終アクセス日 = wDateTime
    
    '最終更新日のファイルタイムをローカルタイムに変換
    RtnCd = FileTimeToLocalFileTime(lpLastWriteTime, lpLocalFileTime)
    GoSub Conv
    最終更新日 = wDateTime
Exit Sub

Conv:
    'ローカルタイムをシステムタイムに変換
    RtnCd = FileTimeToSystemTime(lpLocalFileTime, lpSystemTime)

    With lpSystemTime
        wDateTime = Format(.wYear & "/" & .wMonth & "/" & .wDay & " " & .wHour & ":" & .wMinute & ":" & .wSecond, "yyyy/mm/dd hh:nn:ss")
    End With
Return
End Sub

Sub LsSetFileTime(TempFile As String, wDateTime As Date)
    'TempFile に渡されたファイルの最終更新日を、wDateTimeに設定します。
    Dim RtnCd As Long, hFile As Long
    Dim lpCreationTime As FILETIME
    Dim lpLastAccessTime As FILETIME
    Dim lpLastWriteTime As FILETIME
    Dim lpLocalFileTime As FILETIME
    Dim lpSystemTime As SYSTEMTIME
    
    '設定する日時をセット
    With lpSystemTime
        .wYear = Year(wDateTime)
        .wMonth = Month(wDateTime)
        .wDay = Day(wDateTime)
        .wHour = Hour(wDateTime)
        .wMinute = Minute(wDateTime)
        .wSecond = Second(wDateTime)
    End With
    
    'システムタイムをローカルファイルタイムに変換
    RtnCd = SystemTimeToFileTime(lpSystemTime, lpLocalFileTime)
    
    'ローカルファイルタイムをファイルタイムに変換
    RtnCd = LocalFileTimeToFileTime(lpLocalFileTime, lpLastWriteTime)
    
    'ファイルを開いてそのハンドルを得る
    hFile = CreateFileLong(TempFile, GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0)
    
    '最終更新日を設定
    RtnCd = SetFileTimeLong(hFile, 0, 0, lpLastWriteTime)
    
    'ファイルハンドルを開放
    RtnCd = CloseHandle(hFile)
End Sub

'WindowsTempPathを取得
Function LsGetTempPath() As String
    Dim Gwdvar As String, Gwdvar_Length As Long
    Gwdvar = Space(255)
    Gwdvar_Length = GetTempPath(nSize:=255, lpBuffer:=Gwdvar)
    '2002/10/09 Bug Fix
    'LsGetTempPath = Trim$(Left$(Gwdvar, Gwdvar_Length))
    LsGetTempPath = LsNullTrim(Gwdvar)
End Function

'Null文字以降を削除
Function LsNullTrim(strExp As String) As String
    Dim i As Integer
    i = InStr(strExp, vbNullChar)
    If i > 1 Then
        LsNullTrim = Left$(strExp, i - 1)
    Else
        LsNullTrim = strExp
    End If
End Function