Правильная перезапись файлов

    Если Вы создаёте проект для работы с документами, используя стандартные Basic'овские файловые операторы Вы столкнётесь с проблемой: перезаписываемые Вами документы будут терять свои атрибуты при каждом сохранении. Это может быть не так уж и важно для Вас, но это не соответствует правилам компьютерного хорошего тона.
    В этой статье я изложу код модуля позволяющего решить эту проблему.


'Сначала необходимые функции
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 GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'-------------------------------------------------------------------------------------
'Теперь типы и константы
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_ALWAYS = 4
'------------------------------------------------------------------------------------

' Ну и переменные модуля
Private ftLASaved As FILETIME ' Время последнего доступа
Private ftCTSaved As FILETIME ' Время создания
Private ftLWSaved As FILETIME ' Время последнего изменения
Private lngFAttrSaved As Long ' Атрибуты файла



' Процедура сохранения аттрибутов
Public Sub SaveFileAttr(ByVal FileName As String)
    Dim hFile As Long
    lngFAttrSaved = GetFileAttributes(FileName) 'получаем атрибуты
    hFile = CreateFile(FileName, GENERIC_READ, 0, 0, OPEN_ALWAYS, 0, 0) 'Открываем файл
        ' Использование OpenFile делает код более громоздким.
    GetFileTime hFile, ftCTSaved, ftLASaved, ftLWSaved ' Получаем все виды файлового времени
    CloseHandle hFile ' Закрываем манипулятор
End Sub


' Процедура восстановления аттрибутов

Public Sub RestoreFileAttr(ByVal FileName As String)
    Dim hFile As Long
    SetFileAttributes FileName, lngFAttrSaved
    hFile = CreateFile(FileName, GENERIC_WRITE, 0, 0, OPEN_ALWAYS, 0, 0)
    SetFileTime hFile, ftCTSaved, ftLASaved, ftLWSaved
    CloseHandle hFile
End Sub


    Применять этот метод довольно удобно. Перед сохранением данных в файл сохраняем атрибуты, а после восстанавливаем. Главное чётко соблюдать последовательность вызовов SaveFileAttr и RestoreFileAttr. Можно расширить возможности этих функций создав стек атрибутов.