VB Tips File e dir
 

Cambiare la data e l'ora di un file

1. Creare un nuovo progetto in VB4 (32). Form1 è creata di deafult
2. Aggiungere il codice nella sezione dichiarazioni 

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 Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

(le dichiarazioni qui di seguito devono essere su di una unica riga)
Private Declare Function SetFileTimeWrite Lib "kernel32" Alias 
"SetFileTime" (ByVal hFile As Long, ByVal MullP As Long, 
ByVal NullP2 As Long, lpLastWriteTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" 
(lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) 
As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" 
(lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long

3. inserire un command button. Command1 è il nome di default.
4. aggiungere il codice:

Private Sub Command1_Click()
Dim Year As Integer, Month As Integer
Dim Day As Integer, Hour As Integer
Dim Minute As Integer, Second As Integer
Dim TimeStamp As Variant
Dim Filename As String
Dim X As Integer

Year = 1996
Month = 1
Day = 1
Hour = 1
Minute = 0
Second = 0

TimeStamp = DateSerial(Year, Month, Day) + TimeSerial(Hour, Minute, Second)
Filename = "c:\autoexec.bat"

X = ModifyFileStamp(Filename, TimeStamp)

MsgBox "La data e l'ora del file sono stati modificati"

End Sub

5. Create una funzione di nome ModifyFileStamp:

Function ModifyFileStamp(Filename As String, TimeStamp As Variant) As Integer
Dim X As Long
Dim Handle As Long
Dim System_Time As SYSTEMTIME
Dim File_Time As FILETIME
Dim Local_Time As FILETIME

System_Time.wYear = Year(TimeStamp)
System_Time.wMonth = Month(TimeStamp)
System_Time.wDay = Day(TimeStamp)
System_Time.wDayOfWeek = WeekDay(TimeStamp) - 1
System_Time.wHour = Hour(TimeStamp)
System_Time.wSecond = Second(TimeStamp)
System_Time.wMilliseconds = 0

'convert the system time to a file time
X = SystemTimeToFileTime(System_Time, Local_Time)

'convert local file time to file time based on UTC
X = LocalFileTimeToFileTime(Local_Time, File_Time)

'open the file so we can get a file handle to the file
Handle = CreateFile(Filename, GENERIC_WRITE, FILE_SHARE_READ Or 
FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)

'now change the file time and date stamp
X = SetFileTimeWrite(Handle, ByVal 0&, ByVal 0&, File_Time)
CloseHandle Handle

End Function

6. Lanciare l'esempio premendo F5. La data e l'ora del file AUTOEXEC.BAT sarà modificata.
Trova il primo drive CD Rom e ritorna la lettera corrispondente
DICHIARAZIONE API
  Private Declare Function GetDriveType32 Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal strWhichDrive As String) As Long
  CODICE FUNZIONI PRIVATE

' Restituisce il tipo di drive selezionato

Private Function GetDriveType(ByVal intDriveNum As Integer) As Integer
   
    ' Contiene il nome dell' unità in formato String
    ' 1 = "a:\", 2 = "b:\", ecc
    Dim strDriveName As String
   
    ' converte il numero del drive in lettera e aggiunge
    ' i due punti e la barra ":\"
    ' Nel caso di drive 0 risulta:
    '   A:\
    strDriveName = Chr(Asc("A") + intDriveNum) & ":" & "\"
   
    ' Richiama la funzione GetDriveType32(Drive)
    GetDriveType = CInt(GetDriveType32(strDriveName))

End Function
  CODICE FUNZIONI PUBBLICHE

' Trova la prima unità CD-Rom e la restituisce alla funzione chiamante
' Descrizione:
' FCDRom$ = SearchCDRom
' FCDRom$ ora contiene il nome dell' unità

Public Function SearchCDRom() As String

    ' Dichiarazione variabili
    Dim DrvNum As Integer ' Numero del drive da passare alla funzione
    Dim dRet As Integer ' Tipo di drive ritornato
   
    ' Fa partire la ricerca dal drive 2 (C:\) perchè si
    ' esclude che i dischi A:\ e B:\ possano essere CDRom
    DrvNum = 2
   
    Do
       
        ' Legge che tipo di drive è quello ritornato da GetDriveType
        dRet = GetDriveType(DrvNum)
      
        If (dRet = 5) Then
            ' Trovato il CDRom e viene ritornato come stringa
            SearchCDRom = Chr(Asc("A") + DrvNum) & ":" & "\"
            Exit Function
        Else
            ' Non ancora trovato. Prosegue nella ricerca con i drive successivi
            DrvNum = DrvNum + 1
        End If
       
    Loop While dRet >= 2 And dRet <= 6
   
    ' CDRom non trovato. Ritorna una stringa vuota
    SearchCDRom = ""
      
End Function
  CODICE DA INSERIRE NEL FORM

Creare un Form contenente un pulsante ed appendere questo codice:

Private Sub Command1_Click()

   Dim DrvCD as String

   DrvCD = SearchCDRom

End Sub

  INFORMAZIONI

Se non trova nessun drive ritorna una stringa vuota ("").

La funzione
GetDriveType(ByVal intDriveNum As Integer) As Integer
rendendola pubblica, puo essere utile per riconoscere il tipo di drive passato come parametro.I codici di ritorno sono:
2 = Removibile
3 = Hard Disk
4 = Remoto
5 = CD Rom
6 = RamDisk
La proprietà Pattern

La proprietà Pattern restituiesce o imposta il tipo di file che può essere selezionato attraverso un controllo FileListBox.La sintassi della proprietà è la seguente:

oggetto.Pattern [= valore]

Per default il valore è "*.*" cioè seleziona tutti i tipi di file.Il valore può specificare anche un criterio di selezione multiplas.Per esempio con "*.doc;*.dot" si specifica che si vogliono selezionare i documenti e i modelli di Word
Cancella file

Text1.Text = c:\temp\elenco.txt
Kill Text1

Copia file

Text1.Text = c:\esempio\vb32\mio.exe
Text2.Text = c:\esempio\exes\

FileCopy Text1,Text2

Rinomina file
Text1.Text = vb3.txt
Text2.Text = vb4.txt
Name Text1 As Text2
Cancella dir
Text1.Text = c:\dev\temp
RmDir Text1

Crea dir

Text1.Text = c:\dev\temp
MkDir Text1.Text
Leggere da un file

filename = text1.text
if filename = "" then exit sub
open filename for input as #1
input #1, step1
close #1
text2.text = step1

Scrivere in un file

filename = text1.text
if filename = "" then goto errhandl
step1 = text2.text
open filname for output as #1
print #1, step1
close #1

exit sub
errhandl:
msgbox "Prego digitare un filename"
Conoscere lo spazio libero sul disco
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long

Public Function Get_Free_Disk_Space()
Dim lcRootPathName As String
Dim lnSectorsPerCluster As Long
Dim lnBytesPerSector As Long
Dim lnNumberOfFreeClusters As Long
Dim lnTotalNumberOfClusters As Long
Dim lnReturn As Long
Dim lnTotalSpace As Long
Dim lnFreeSpace As Long
lcRootPathName = "c:\" & Chr(0)
lnReturn = GetDiskFreeSpace(lcRootPathName,
lnSectorsPerCluster,lnBytesPerSector, lnNumberOfFreeClusters,
lnTotalNumberOfClusters)
lnFreeSpace = (lnSectorsPerCluster * lnBytesPerSector) *
lnNumberOfFreeClusters
lnTotalSpace = (lnSectorsPerCluster * lnBytesPerSector) *
lnTotalNumberOfClusters
Get_Free_Disk_Space = lnFreeSpace
End Function
 

Estrarre il nome file da un path completo

VB3, VB4/16, VB4/32, VB5, VB6

Può essere necessario estrarre il nome di un file dato il suo path completo. La funzione  si occupa proprio di questo. Passandole come parametro il nome di un file con il path completo, restituisce il nome del file con la sua estensione.

Function GetFileName(sPath as String) As String
    Dim next as Integer, last as Integer

    GetFileName = sPath
    next = InStr(sPath, "\")
    Do While next
        last = next
        next = InStr(last + 1, sPath, "\")
    Loop

    If last > 0 Then GetFileName = Mid$(sPath, last + 1)

End Function

La potete utilizzare così

FileName = GetFileName("c:\windows\hello.txt")