Правильная перезапись файлов в visual basic
Если Вы создаёте проект для работы с документами, используя стандартные 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. Можно расширить возможности этихфункций создав стек атрибутов.
