Форумы HiProg.com - MS ACCESS, VBA, VB

ник: Дядя Федор
Атрибуты файла.

Option Compare Database Option Explicit Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long Declare Function SetFileAttributes Lib "kernel32.dll" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long Public Const Slash As String = "\" Public Const FILE_ATTRIBUTE_ARCHIVE = &H20 'An archive file (which most files are). Public Const FILE_ATTRIBUTE_COMPRESSED = &H800 'A file residing in a compressed drive or directory. Public Const FILE_ATTRIBUTE_DIRECTORY = &H10 'A directory instead of a file. Public Const FILE_ATTRIBUTE_HIDDEN = &H2 'A hidden file, not normally visible to the user. Public Const FILE_ATTRIBUTE_NORMAL = &H80 'An attribute-less file (cannot be combined with other attributes). Public Const FILE_ATTRIBUTE_READONLY = &H1 'A read-only file. Public Const FILE_ATTRIBUTE_SYSTEM = &H4 'A system file, used exclusively by the operating system. Declare Function GetFileTime Lib "kernel32.dll" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long Declare Function SetFileTime Lib "kernel32.dll" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long Declare Sub GetSystemTimeAsFileTime Lib "kernel32.dll" (lpSystemTimeAsFileTime As FileTime) Type FileTime   dwLowDateTime As Long   dwHighDateTime As Long End Type Public Type SYSTEMTIME     wYear As Integer     wMonth As Integer     wDayOfWeek As Integer     wDay As Integer     wHour As Integer     wMinute As Integer     wSecond As Integer     wMilliseconds As Integer End Type Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" _ (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, lpSecurityAttributes As Any, _ ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long Declare Function FileTimeToLocalFileTime Lib "kernel32.dll" (lpFileTime As FileTime, lpLocalFileTime As FileTime) As Long Declare Function FileTimeToSystemTime Lib "kernel32.dll" (lpFileTime As FileTime, lpSystemTime As SYSTEMTIME) As Long Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long Public Const GENERIC_READ = &H80000000 Public Const GENERIC_WRITE = &H40000000 Public Const FILE_SHARE_READ = &H1 Public Const FILE_SHARE_WRITE = &H2 Public Const CREATE_ALWAYS = 2 Public Const CREATE_NEW = 1 Public Const OPEN_ALWAYS = 4 Public Const OPEN_EXISTING = 3 Public Const TRUNCATE_EXISTING = 5 Public Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000 Public Const FILE_FLAG_NO_BUFFERING = &H20000000 Public Const FILE_FLAG_OVERLAPPED = &H40000000 Public Const FILE_FLAG_POSIX_SEMANTICS = &H1000000 Public Const FILE_FLAG_RANDOM_ACCESS = &H10000000 Public Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000 Public Const FILE_FLAG_WRITE_THROUGH = &H80000000 Public Sub SetFilesAtt(DirTmp As String, _                     IntArchive As Integer, _                     IntHidden As Integer, _                     IntReadonly As Integer, _                     IntSystem As Integer, _                     IntCompressed As Integer)                      On Error GoTo errs     If Len(Dir(DirTmp) & "") <> 0 Then         Dim AttrTmp As Long             If IntArchive = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "Archive") = 1) Then                AttrTmp = AttrTmp + 32             End If                      If IntHidden = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "Hidden") = 1) Then                AttrTmp = AttrTmp + 2             End If                          If IntReadonly = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "Readonly") = 1) Then                AttrTmp = AttrTmp + 1             End If                          If IntSystem = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "System") = 1) Then                AttrTmp = AttrTmp + 4             End If                      If IntCompressed = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "Compressed") = 1) Then                AttrTmp = AttrTmp + 2048             End If                  Call SetFileAttributes(DirTmp, AttrTmp)     End If errs: End Sub

Примеры:

Private Sub BtnDel_Click() If MsgBox("Отменить прикрепление файла " & Me.FileKRPIshDocFiles & "." & ExtKRPIshDocFiles & " ?", vbYesNo + vbQuestion + vbDefaultButton2, "Внимание") = vbYes Then     Dim PathFile As String     PathFile = StrDirTmp & Format(Me.IdKRPIshDoc, "00000000") & "\" & Format(Me.IdKRPIshDocFiles, "00000000") & "." & Me.ExtKRPIshDocFiles     On Error Resume Next     SetFilesAtt PathFile, -1, -1, -1, -1, -1     Kill (PathFile)     If Len(Dir(PathFile)) = 0 Then         DoCmd.SetWarnings False         DoCmd.RunSQL ("DELETE TblKRPIshDocFiles.*, TblKRPIshDocFiles.IdKRPIshDocFiles FROM TblKRPIshDocFiles WHERE TblKRPIshDocFiles.IdKRPIshDocFiles=" & Me.IdKRPIshDocFiles & ";")         DoCmd.SetWarnings True         Me.Requery       Else         SetFilesAtt PathFile, 0, 0, 1, 0, 0         MsgBox "При отмене прикрепления файла произошла ошибка !", vbInformation, "Ошибка"     End If End If End Sub Private Sub btnopen_Click() Dim PathFile As String PathFile = StrDirTmp & Format(Me.IdKRPIshDoc, "00000000") & "\" & Format(Me.IdKRPIshDocFiles, "00000000") & "." & Me.ExtKRPIshDocFiles     If Len(Dir(PathFile)) <> 0 Then         SetFilesAtt PathFile, 0, 0, 1, 0, 0         Call fHandleFile(PathFile, Win_MAX) 'Это проц. открытия  файла программой по умолчанию (если надо - код дам)       Else         MsgBox "Прикрепленый файл не найден !", vbInformation, "Ошибка"     End If End Sub