Declare PtrSafe Function

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Public Type FILETIMES
    CreationTime As FILETIME
    LastAccessTime As FILETIME
    LastWriteTime As FILETIME
End Type
Private Declare PtrSafe 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 LongPtr _
    ) As LongPtr
Private Declare PtrSafe Function GetFileTime _
    Lib "kernel32" ( _
        ByVal hFile As LongPtr, _
        lpCreationTime As FILETIME, _
        lpLastAccessTime As FILETIME, _
        lpLastWriteTime As FILETIME _
    ) As Long
Private Declare PtrSafe Function SetFileTime Lib "kernel32" ( _
    ByVal hFile As LongPtr, _
    lpCreationTime As FILETIME, _
    lpLastAccessTime As FILETIME, _
    lpLastWriteTime As FILETIME _
) As Long
Private Declare PtrSafe Function GetFileAttributes _
    Lib "kernel32.dll" _
    Alias "GetFileAttributesA" ( _
        ByVal lpFileName As String _
    ) As Long
Public Declare PtrSafe Function SetFileAttributes _
    Lib "kernel32.dll" _
    Alias "SetFileAttributesA" ( _
        ByVal lpFileName As String, _
        ByVal dwFileAttributes As Long _
    ) As Long
Private Declare PtrSafe Function CloseHandle _
    Lib "kernel32" ( _
        ByVal hObject As LongPtr _
    ) As Long
Private Declare PtrSafe Function GetLastError _
    Lib "kernel32" ( _
    ) As Long

Private Const _
    GENERIC_WRITE& = &H40000000, _
    GENERIC_READ& = &H80000000, _
    OPEN_EXISTING& = 3, _
    FILE_SHARE_READ& = &H1, _
    INVALID_HANDLE_VALUE& = -1, _
    zip$ = "c:\UsefulSoft\WinRAR\Rar.exe"

Public Function ReadFromfile(strFilePath, ByRef FT As FILETIMES, ByRef hFileAttr&, p1, ByRef p2 As Variant) As Boolean
    Dim hFile&
    'читаем встроенные свойства исходного файла
    With p1
        On Error Resume Next
        p2(1) = .Item(7): p2(2) = .Item(8)
        p2(3) = .Item(9): p2(4) = .Item(11)
        p2(5) = .Item(12): p2(6) = .Item(13)
        Err.Clear
    End With
    'создаем файловый дескриптор, указывающий на исходный файл
    hFile = CreateFile(strFilePath, GENERIC_READ, FILE_SHARE_READ, 0&, OPEN_EXISTING, 1, 0&)
    If hFile <> INVALID_HANDLE_VALUE Then
        'читаем датувремя создания, открытия, сохранения файла
        GetFileTime hFile, FT.CreationTime, FT.LastAccessTime, FT.LastWriteTime
        'читаем атрибуты файла
        hFileAttr = GetFileAttributes(strFilePath)
        'закрываем дескриптор
        CloseHandle hFile
        ReadFromfile = (Err.Number + GetLastError) = 0
    End If
End Function
Public Function write2file(strNewFilePath$, FT As FILETIMES, hFileAttr&, p2 As Variant) As Boolean
    Dim hFile&, objTimeZone, TZOffset#
    On Error Resume Next
    'определяем часовой пояс
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
        For Each objTimeZone In .ExecQuery("Select * from Win32_TimeZone")
            TZOffset = objTimeZone.Bias / 1440
        Next
    End With
    'заменяем встроенные свойства скопированного файла
    With CreateObject("wscript.shell")
        Err.Clear
        .Run "%comspec% /c ""cd ""%tmp%""&&""" & zip & """ x """ & _
             strNewFilePath & """ docProps\app.xml -y""", 0, 1
        .Run "%comspec% /c ""cd ""%tmp%""&&""" & zip & """ x """ & _
             strNewFilePath & """ docProps\core.xml -y""", 0, 1
        With CreateObject("MSXML2.DOMDocument.6.0")
            .async = False: .validateOnParse = False
            .Load Environ("tmp") & "\docProps\core.xml"
            If Not IsEmpty(p2(1)) Then _
                .SelectSingleNode("//*[local-name()='lastModifiedBy']").Text = p2(1)
            If Not IsEmpty(p2(2)) Then _
                .SelectSingleNode("//*[local-name()='revision']").Text = p2(2)
            If Not IsEmpty(p2(4)) Then _
                .SelectSingleNode("//*[local-name()='created']").Text = _
                    Format(p2(4) - TZOffset, "yyyy-mm-ddTHH:MM:SSZ")
            If Not IsEmpty(p2(5)) Then _
                .SelectSingleNode("//*[local-name()='modified']").Text = _
                    Format(p2(5) - TZOffset, "yyyy-mm-ddTHH:MM:SSZ")
            .Save Environ("tmp") & "\docProps\core.xml"
            .Load Environ("tmp") & "\docProps\app.xml"
            If Not IsEmpty(p2(3)) Then _
                .SelectSingleNode("//*[local-name()='Application']").Text = p2(3)
            If Not IsEmpty(p2(6)) Then _
                .SelectSingleNode("//*[local-name()='TotalTime']").Text = p2(6)
            .Save Environ("tmp") & "\docProps\app.xml"
        End With
        .Run "%comspec% /c ""cd ""%tmp%""&&""" & zip & """ u """ & _
             strNewFilePath & """ docProps\app.xml -y""", 0, 1
        .Run "%comspec% /c ""cd ""%tmp%""&&""" & zip & """ u """ & _
             strNewFilePath & """ docProps\app.xml -y""", 0, 1
        Kill Environ("tmp") & "\docProps\*.*"
        RmDir Environ("tmp") & "\docProps"
    End With
    'создаем файловый дескриптор, указывающий на конвертированный файл
    hFile = CreateFile(strNewFilePath, GENERIC_WRITE, 0&, 0&, OPEN_EXISTING, 0&, 0&)
    If hFile <> INVALID_HANDLE_VALUE& Then
        'заменяем датувремя создания, открытия, сохранения файла
        SetFileTime hFile, FT.CreationTime, FT.LastAccessTime, FT.LastWriteTime
        'заменяем атрибуты файла
        SetFileAttributes strNewFilePath, hFileAttr
        'закрываем дескриптор
        CloseHandle hFile
        write2file = (Err.Number + GetLastError) = 0
    End If
End Function