File - Controlla gli attributi del file

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long

End Type
Private 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
Private Type BY_HANDLE_FILE_INFORMATION
  dwFileAttributes As Long ''
  ftCreationTime As FILETIME ''
  ftLastAccessTime As FILETIME ''
  ftLastWriteTime As FILETIME ''
  dwVolumeSerialNumber As Long  ''
  nFileSizeHigh As Long
  nFileSizeLow As Long ''
  nNumberOfLinks As Long ''
  nFileIndexHigh As Long
  nFileIndexLow As Long
End Type
Const FILE_ATTRIBUTE_ARCHIVE = &H20
'Un file di archivio (la maggior parte dei files).
Const FILE_ATTRIBUTE_COMPRESSED = &H800
'Un file in un drive o in una directori compressa.
Const FILE_ATTRIBUTE_DIRECTORY = &H10
'Una directory invece di un file.
Const FILE_ATTRIBUTE_HIDDEN = &H2
'File nascosto.
Const FILE_ATTRIBUTE_NORMAL = &H80
'File senza attributi.
Const FILE_ATTRIBUTE_READONLY = &H1
'File di sola lettura.
Const FILE_ATTRIBUTE_SYSTEM = &H4
'File di sistema (lo usa solo il sistema operativo)
Dim nomefile As String
Const FILE_SHARE_READ = &H1
'Allow other programs to read data from the file.
Const FILE_SHARE_WRITE = &H2
Const CREATE_ALWAYS = 2
'Create a new file. Overwrite the file (i.e., delete the old one first) if it already exists.
Const CREATE_NEW = 1
'Create a new file. The function fails if the file already exists.
Const OPEN_ALWAYS = 4
'Open an existing file. If the file does not exist, it will be created.
Const OPEN_EXISTING = 3
'Open an existing file. The function fails if the file does not exist.
Const TRUNCATE_EXISTING = 5

Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
'Delete the file once it is closed.
Const FILE_FLAG_NO_BUFFERING = &H20000000
Const FILE_FLAG_OVERLAPPED = &H40000000
'Allow asynchronous I/O; i.e., allow the file to be read from and written to simultaneously. If used, functions that read and write to the file must specify the OVERLAPPED structure identifying the file pointer. Windows 95 does not support overlapped disk files, although Windows NT does.
Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
'Allow file names to be case-sensitive.
Const FILE_FLAG_RANDOM_ACCESS = &H10000000
'Optimize the file cache for random access (skipping around to various parts of the file).
Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
'Optimize the file cache for sequential access (starting at the beginning and continuing to the end of the file).
Const FILE_FLAG_WRITE_THROUGH = &H80000000
Dim localtime As FILETIME  ' receives local creation time
Dim systime As SYSTEMTIME  ' receives creation time

Private Sub Command1_Click()
CommonDialog1.ShowOpen
Dim nomefile As String
Dim hfile As Long  ' receives the handle to the file
Dim fileinfo As BY_HANDLE_FILE_INFORMATION  ' receives info about the file
Dim hexstring As String  ' will receive the hexadecimal form of the serial number
Dim retval As Long  ' return value
Dim Size As String
Dim attribs As Long
Dim links As Long
nomefile = CommonDialog1.FileName
Label17.Caption = nomefile
' Get a handle to the file
hfile = CreateFileNS(nomefile, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0)
If hfile = -1 Then  ' if the file could not be opened
  MsgBox "Non � possibile aprire il file "
  End  ' abort the program
End If

' Display the serial number, using hexadecimal:
retval = GetFileInformationByHandle(hfile, fileinfo)  ' read the information

hexstring = Hex(fileinfo.dwVolumeSerialNumber)  ' get the hexadecimal value of the serial number
Label5.Caption = hexstring
Size = (fileinfo.nFileSizeLow) '
Label2.Caption = Format(Size, "###,###,###")

attribs = (fileinfo.dwFileAttributes) '
If (attribs And FILE_ATTRIBUTE_HIDDEN) <> 0 Then Label6.Caption = "Nascosto"
If (attribs And FILE_ATTRIBUTE_READONLY) <> 0 Then Label6.Caption = "Sola lettura"
If (attribs And FILE_ATTRIBUTE_ARCHIVE) <> 0 Then Label6.Caption = "Archivio"
If (attribs And FILE_ATTRIBUTE_COMPRESSED) <> 0 Then Label6.Caption = "Archive"
If (attribs And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then Label6.Caption = "Directory"
If (attribs And FILE_ATTRIBUTE_NORMAL) <> 0 Then Label6.Caption = "Senza attributi"
If (attribs And FILE_ATTRIBUTE_SYSTEM) <> 0 Then Label6.Caption = "File di sistema"

links = (fileinfo.nNumberOfLinks)

Label9.Caption = links
retval = FileTimeToLocalFileTime(fileinfo.ftCreationTime, localtime)
  retval = FileTimeToSystemTime(localtime, systime)
  Label11.Caption = systime.wDay & "-" & systime.wMonth & "-" & systime.wYear
  retval = FileTimeToLocalFileTime(fileinfo.ftLastAccessTime, localtime)
  retval = FileTimeToSystemTime(localtime, systime)
  Label13.Caption = systime.wDay & "-" & systime.wMonth & "-" & systime.wYear
  
  retval = FileTimeToLocalFileTime(fileinfo.ftLastWriteTime, localtime)
  retval = FileTimeToSystemTime(localtime, systime)
  Label15.Caption = systime.wDay & "-" & systime.wMonth & "-" & systime.wYear

retval = FileTimeToLocalFileTime(fileinfo.ftLastAccessTime, localtime)

' Close the file:
retval = CloseHandle

End Sub

Private Declare Function GetFileInformationByHandle Lib "kernel32.dll" (ByVal hfile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
Private Declare Function CreateFileNS Lib "kernel32.dll" 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 FileTimeToLocalFileTime Lib "kernel32.dll" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32.dll" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long

End Type
Private 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
Private Type BY_HANDLE_FILE_INFORMATION
dwFileAttributes As Long ''
ftCreationTime As FILETIME ''
ftLastAccessTime As FILETIME ''
ftLastWriteTime As FILETIME ''
dwVolumeSerialNumber As Long ''
nFileSizeHigh As Long
nFileSizeLow As Long ''
nNumberOfLinks As Long ''
nFileIndexHigh As Long
nFileIndexLow As Long
End Type
Const FILE_ATTRIBUTE_ARCHIVE = &H20
'Un file di archivio (la maggior parte dei files).

Const FILE_ATTRIBUTE_COMPRESSED = &H800
'Un file in un drive o in una directori compressa.

Const FILE_ATTRIBUTE_DIRECTORY = &H10
'Una directory invece di un file.

Const FILE_ATTRIBUTE_HIDDEN = &H2
'File nascosto.

Const FILE_ATTRIBUTE_NORMAL = &H80
'File senza attributi.

Const FILE_ATTRIBUTE_READONLY = &H1
'File di sola lettura.

Const FILE_ATTRIBUTE_SYSTEM = &H4
'File di sistema (lo usa solo il sistema operativo)

Dim nomefile As String
Const FILE_SHARE_READ = &H1
'Allow other programs to read data from the file.

Const FILE_SHARE_WRITE = &H2
Const CREATE_ALWAYS = 2
'Create a new file. Overwrite the file (i.e., delete the old one first) if it already exists.

Const CREATE_NEW = 1
'Create a new file. The function fails if the file already exists.

Const OPEN_ALWAYS = 4
'Open an existing file. If the file does not exist, it will be created.

Const OPEN_EXISTING = 3
'Open an existing file. The function fails if the file does not exist.

Const TRUNCATE_EXISTING = 5

Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
'Delete the file once it is closed.

Const FILE_FLAG_NO_BUFFERING = &H20000000
Const FILE_FLAG_OVERLAPPED = &H40000000
'Allow asynchronous I/O; i.e., allow the file to be read from and written to simultaneously. If used, functions that read and write to the file must specify the OVERLAPPED structure identifying the file pointer. Windows 95 does not support overlapped disk files, although Windows NT does.

Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
'Allow file names to be case-sensitive.

Const FILE_FLAG_RANDOM_ACCESS = &H10000000
'Optimize the file cache for random access (skipping around to various parts of the file).

Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
'Optimize the file cache for sequential access (starting at the beginning and continuing to the end of the file).

Const FILE_FLAG_WRITE_THROUGH = &H80000000
Dim localtime As FILETIME ' receives local creation time
Dim systime As SYSTEMTIME ' receives creation time

Private Sub Command1_Click()
CommonDialog1.ShowOpen
Dim nomefile As String
Dim hfile As Long ' receives the handle to the file
Dim fileinfo As BY_HANDLE_FILE_INFORMATION ' receives info about the file
Dim hexstring As String ' will receive the hexadecimal form of the serial number
Dim retval As Long ' return value
Dim Size As String
Dim attribs As Long
Dim links As Long
nomefile = CommonDialog1.FileName
Label17.Caption = nomefile
' Get a handle to the file

hfile = CreateFileNS(nomefile, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0)
If hfile = -1 Then ' if the file could not be opened
MsgBox "Non e' possibile aprire il file "
End ' abort the program
End If

' Display the serial number, using hexadecimal:

retval = GetFileInformationByHandle(hfile, fileinfo) ' read the information

hexstring = Hex(fileinfo.dwVolumeSerialNumber) ' get the hexadecimal value of the serial number
Label5.Caption = hexstring
Size = (fileinfo.nFileSizeLow) '
Label2.Caption = Format(Size, "###,###,###")

attribs = (fileinfo.dwFileAttributes) '
If (attribs And FILE_ATTRIBUTE_HIDDEN) <> 0 Then Label6.Caption = "Nascosto"
If (attribs And FILE_ATTRIBUTE_READONLY) <> 0 Then Label6.Caption = "Sola lettura"
If (attribs And FILE_ATTRIBUTE_ARCHIVE) <> 0 Then Label6.Caption = "Archivio"
If (attribs And FILE_ATTRIBUTE_COMPRESSED) <> 0 Then Label6.Caption = "Archive"
If (attribs And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then Label6.Caption = "Directory"
If (attribs And FILE_ATTRIBUTE_NORMAL) <> 0 Then Label6.Caption = "Senza attributi"
If (attribs And FILE_ATTRIBUTE_SYSTEM) <> 0 Then Label6.Caption = "File di sistema"

links = (fileinfo.nNumberOfLinks)

Label9.Caption = links
retval = FileTimeToLocalFileTime(fileinfo.ftCreationTime, localtime)
retval = FileTimeToSystemTime(localtime, systime)
Label11.Caption = systime.wDay & "-" & systime.wMonth & "-" & systime.wYear
retval = FileTimeToLocalFileTime(fileinfo.ftLastAccessTime, localtime)
retval = FileTimeToSystemTime(localtime, systime)
Label13.Caption = systime.wDay & "-" & systime.wMonth & "-" & systime.wYear

retval = FileTimeToLocalFileTime(fileinfo.ftLastWriteTime, localtime)
retval = FileTimeToSystemTime(localtime, systime)
Label15.Caption = systime.wDay & "-" & systime.wMonth & "-" & systime.wYear

retval = FileTimeToLocalFileTime(fileinfo.ftLastAccessTime, localtime)

' Close the file:

retval = CloseHandle

End Sub