Computer - Lettura Delle Caratteristiche Di Un DRIVER

Private Sub Form_Unload(Cancel As Integer)
'MsgBox "Esempio scritto da Stefano - glott@eponet.it", vbInformation, "Esempio di DriveName"
'MsgBox "Se lo trovi utile fammelo sapere !", vbExclamation, "Esempio di DriveName"
End Sub

Private Sub List1_DblClick()
'If MsgBox("Altro codice e prodotti freeware per Visual Basic, tips e consigli vari li puoi trovare a:" & vbCrLf & "http://www.geocities.com/SiliconValley/Lakes/1218""" & vbCrLf & "Mettere questo indirizzo negli Appunti?", vbYesNo, "Site Info") = vbYes Then
'    Clipboard.Clear
'    Clipboard.SetText "http://www.geocities.com/SiliconValley/Lakes/1218"
'End If
End Sub

MODULO BAS
Option Explicit
''chiamata API
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
''costanti combinate in lpSystemFlags:
Public Const FILE_VOLUME_IS_COMPRESSED = &H8000
Public Const FILE_UNICODE_ON_DISK = &H4
Public Const FILE_CASE_PRESERVED_NAMES = &H2
Public Const FILE_CASE_SENSITIVE_SEARCH = &H1
Public Const FILE_PERSISTENT_ACLS = &H8
Public Const FILE_FILE_COMPRESSION = &H10
''tipo di ritorno funzione vb
Public Type DriveInformation
DriveName As String
DriveLabel As String
SerialNumber As Long ''formato numerico
SerialCode As String ''formato xxxx-yyyy
MaximumNameLenght As Long
FileSystemName As String
FileSystemFlags As Long
Compressed As Boolean
SupportsUnicode As Boolean
CasePreservedNames As Boolean
CaseSensitiveSearch As Boolean
PersistentACLS As Boolean
SupportsCompression As Boolean
End Type
Public Function DriveInfo(DriveName As String) As DriveInformation
''
''dato il nome del drive, ne rende le caratteristiche sotto forma di UDT
''a interfacciando con le chiamate API
''scritto da stefano, glott@eponet.it
''
''rende .drivename = "" se impossibile effettuare chiamata
Dim lpRootPathName As String   ''parametri per chiamata API
Dim lpVolumeNameBuffer As String
Dim nVolumeNameSize As Long
Dim lpVolumeSerialNumber As Long
Dim lpFileSystemNameBuffer As String
Dim nFileSystemNameSize As Long
Dim lpMaximumComponentLength As Long
Dim lpFileSystemFlags As Long
lpRootPathName = DriveName
lpVolumeNameBuffer = Space$(256)
lpFileSystemNameBuffer = Space$(256)
lpMaximumComponentLength = 0
lpVolumeSerialNumber = 0
lpFileSystemFlags = 0
''
If Len(lpRootPathName) = 1 Then lpRootPathName = lpRootPathName & ":\"
''
Dim LReturnCode As Long
LReturnCode = GetVolumeInformation(lpRootPathName, lpVolumeNameBuffer, Len(lpVolumeNameBuffer), lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, Len(lpFileSystemNameBuffer))
If LReturnCode = 0 Then
    DriveInfo.DriveName = ""
    Exit Function
End If
'    DriveName As String
'    DriveLabel As String
'    SerialNumber As Long ''formato numerico
'    SerialCode As String ''formato xxxx-yyyy
'    FileSystemName as string
'    MaximumNameLenght As Long
'    FileSystemFlags As Long
'        Compressed As Boolean
'        SupportsUnicode As Boolean
'        CasePreservedNames As Boolean
'        CaseSensitiveSearch As Boolean
'        PersistentACLS As Boolean
'        SupportsCompression As Boolean
With DriveInfo
    .DriveName = lpRootPathName
    .DriveLabel = lpVolumeNameBuffer
    .SerialCode = Left(Hex(lpVolumeSerialNumber), 4) & "-" & Right(Hex(lpVolumeSerialNumber), 4)
    .SerialNumber = lpVolumeSerialNumber
    .FileSystemName = lpFileSystemNameBuffer
    .MaximumNameLenght = lpMaximumComponentLength
    .FileSystemFlags = lpFileSystemFlags
    .Compressed = (lpFileSystemFlags And FILE_VOLUME_IS_COMPRESSED) = FILE_VOLUME_IS_COMPRESSED
    .SupportsCompression = (lpFileSystemFlags And FILE_FILE_COMPRESSION) = FILE_FILE_COMPRESSION
    .SupportsUnicode = (lpFileSystemFlags And FILE_UNICODE_ON_DISK) = FILE_UNICODE_ON_DISK
    .CasePreservedNames = (lpFileSystemFlags And FILE_CASE_PRESERVED_NAMES) = FILE_CASE_PRESERVED_NAMES
    .CaseSensitiveSearch = (lpFileSystemFlags And FILE_CASE_SENSITIVE_SEARCH) = FILE_CASE_SENSITIVE_SEARCH
    .PersistentACLS = (lpFileSystemFlags And FILE_PERSISTENT_ACLS) = FILE_PERSISTENT_ACLS
End With
End Function

Api # ''questa procedura e' un esempio che chiama la funzione
''VB DriveInfo. Essa a sua volta va sulle API di Windows,

''ma al chiamante questo non riguarda; esso legge

''i vari membri di un Type user defined, come

''illustrato nell'esempio

''

il form ha solo un ListBox
Dim MyDrive As DriveInformation
MyDrive = DriveInfo(InputBox("Lettera del drive (anche floppy e cd-audio)", "Esempio di DriveInfo", "C"))
With MyDrive
' DriveName As String

' DriveLabel As String

' SerialNumber As Long ''formato numerico

' SerialCode As String ''formato xxxx-yyyy

' MaximumNameLenght As Long

' FileSystemName As String

' FileSystemFlags As Long

' Compressed As Boolean

' SupportsUnicode As Boolean

' CasePreservedNames As Boolean

' CaseSensitiveSearch As Boolean

' PersistentACLS As Boolean

' SupportsCompression As Boolean

If .DriveName = "" Then MsgBox "Nessuna informazione per questo drive", vbCritical, "Esempio di DriveName"
List1.AddItem "Nome del drive: " & UCase(.DriveName)
List1.AddItem "Etichetta: " & .DriveLabel
List1.AddItem "Numero di serie (Long): " & .SerialNumber
List1.AddItem "Numero di serie (Formattato): " & .SerialCode
List1.AddItem "Nome del file system: " & .FileSystemName
List1.AddItem "Lunghezza massima di un nome di file: " & .MaximumNameLenght

List1.AddItem ""
List1.AddItem "Flags del file system: " & .FileSystemFlags & ", e cioe':"
If .Compressed Then
List1.AddItem " Disco compresso"
Else
List1.AddItem " Disco non compresso"
End If

If .SupportsCompression Then
List1.AddItem " Disco comprimibile"
Else
List1.AddItem " Disco non comprimibile"
End If

If .SupportsUnicode Then
List1.AddItem " Il file system supporta Unicode"
Else
List1.AddItem " Il file system non supporta Unicode"
End If

If .CasePreservedNames Then
List1.AddItem " Differenza maiuscole/minuscole in scrittura"
Else
List1.AddItem " Nessuna differenza maiuscole/minuscole in scrittura"
End If

If .CaseSensitiveSearch Then
List1.AddItem " Ricerca con differenza maiuscole/minuscole"
Else
List1.AddItem " Ricerca senza differenza maiuscole/minuscole"
End If

If .PersistentACLS Then
List1.AddItem " Supporto delle 'Access control lists'"
Else
List1.AddItem " 'Access control lists' non supportate"
End If
End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
'MsgBox "Esempio scritto da Stefano - glott@eponet.it", vbInformation, "Esempio di DriveName"

'MsgBox "Se lo trovi utile fammelo sapere !", vbExclamation, "Esempio di DriveName"

End Sub

Private Sub List1_DblClick()
'If MsgBox("Altro codice e prodotti freeware per Visual Basic, tips e consigli vari li puoi trovare a:" & vbCrLf & "http://www.geocities.com/SiliconValley/Lakes/1218""" & vbCrLf & "Mettere questo indirizzo negli Appunti?", vbYesNo, "Site Info") = vbYes Then

' Clipboard.Clear

' Clipboard.SetText "http://www.geocities.com/SiliconValley/Lakes/1218"

'End If

End Sub

MODULO BAS
Option Explicit
''chiamata API

Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
''costanti combinate in lpSystemFlags:

Public Const FILE_VOLUME_IS_COMPRESSED = &H8000
Public Const FILE_UNICODE_ON_DISK = &H4
Public Const FILE_CASE_PRESERVED_NAMES = &H2
Public Const FILE_CASE_SENSITIVE_SEARCH = &H1
Public Const FILE_PERSISTENT_ACLS = &H8
Public Const FILE_FILE_COMPRESSION = &H10
''tipo di ritorno funzione vb

Public Type DriveInformation
DriveName As String
DriveLabel As String
SerialNumber As Long ''formato numerico
SerialCode As String ''formato xxxx-yyyy
MaximumNameLenght As Long
FileSystemName As String
FileSystemFlags As Long
Compressed As Boolean
SupportsUnicode As Boolean
CasePreservedNames As Boolean
CaseSensitiveSearch As Boolean
PersistentACLS As Boolean
SupportsCompression As Boolean
End Type
Public Function DriveInfo(DriveName As String) As DriveInformation
''

''dato il nome del drive, ne rende le caratteristiche sotto forma di UDT

''a interfacciando con le chiamate API

''scritto da stefano, glott@eponet.it

''

''rende .drivename = "" se impossibile effettuare chiamata

Dim lpRootPathName As String ''parametri per chiamata API
Dim lpVolumeNameBuffer As String
Dim nVolumeNameSize As Long
Dim lpVolumeSerialNumber As Long
Dim lpFileSystemNameBuffer As String
Dim nFileSystemNameSize As Long
Dim lpMaximumComponentLength As Long
Dim lpFileSystemFlags As Long
lpRootPathName = DriveName
lpVolumeNameBuffer = Space$(256)
lpFileSystemNameBuffer = Space$(256)
lpMaximumComponentLength = 0
lpVolumeSerialNumber = 0
lpFileSystemFlags = 0
''

If Len(lpRootPathName) = 1 Then lpRootPathName = lpRootPathName & ":\"
''

Dim LReturnCode As Long
LReturnCode = GetVolumeInformation(lpRootPathName, lpVolumeNameBuffer, Len(lpVolumeNameBuffer), lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, Len(lpFileSystemNameBuffer))
If LReturnCode = 0 Then
DriveInfo.DriveName = ""
Exit Function
End If
' DriveName As String

' DriveLabel As String

' SerialNumber As Long ''formato numerico

' SerialCode As String ''formato xxxx-yyyy

' FileSystemName as string

' MaximumNameLenght As Long

' FileSystemFlags As Long

' Compressed As Boolean

' SupportsUnicode As Boolean

' CasePreservedNames As Boolean

' CaseSensitiveSearch As Boolean

' PersistentACLS As Boolean

' SupportsCompression As Boolean

With DriveInfo
.DriveName = lpRootPathName
.DriveLabel = lpVolumeNameBuffer
.SerialCode = Left(Hex(lpVolumeSerialNumber), 4) & "-" & Right(Hex(lpVolumeSerialNumber), 4)
.SerialNumber = lpVolumeSerialNumber
.FileSystemName = lpFileSystemNameBuffer
.MaximumNameLenght = lpMaximumComponentLength
.FileSystemFlags = lpFileSystemFlags
.Compressed = (lpFileSystemFlags And FILE_VOLUME_IS_COMPRESSED) = FILE_VOLUME_IS_COMPRESSED
.SupportsCompression = (lpFileSystemFlags And FILE_FILE_COMPRESSION) = FILE_FILE_COMPRESSION
.SupportsUnicode = (lpFileSystemFlags And FILE_UNICODE_ON_DISK) = FILE_UNICODE_ON_DISK
.CasePreservedNames = (lpFileSystemFlags And FILE_CASE_PRESERVED_NAMES) = FILE_CASE_PRESERVED_NAMES
.CaseSensitiveSearch = (lpFileSystemFlags And FILE_CASE_SENSITIVE_SEARCH) = FILE_CASE_SENSITIVE_SEARCH
.PersistentACLS = (lpFileSystemFlags And FILE_PERSISTENT_ACLS) = FILE_PERSISTENT_ACLS
End With
End Function