Lire et modifier les attributs de date d'un fichier
Soyez le premier à donner votre avis sur cette source.
Vue 31 106 fois - Téléchargée 1 585 fois
Description
Ce programme a pour objectif de lire (et pourquoi pas, de modifier) les dates qui apparaissent lors d'un affichage des propriétés du fichier. A toutes fins utiles.
La portion de code affichée ici ne montre que les routines intéressantes, mais en ZIP figure une application complète.
Dans le fichier ZIP, vous trouverez :
- Une feuille présentant l'interface utilisateur
- Un module comprenant les routines (réutilisable dans une autre appli).
La portion de code affichée ici ne montre que les routines intéressantes, mais en ZIP figure une application complète.
Source / Exemple :
Option Explicit
'==============================================================================
' Constantes
Public Const cstrAppTitle = "Dates de fichier"
Private Const GENERIC_READ = &H80000000 'Accès en lecture
Private Const GENERIC_WRITE = &H40000000 'Acces en écriture
Private Const INVALID_HANDLE_VALUE = -1 'Identificateur non valide
Private Const MAX_PATH = 260 'Longueur de chemin maximum
Private Const OFN_HIDEREADONLY = &H4 'Masquer "Lecture seule"
Private Const OFN_NODEREFERENCELINKS = &H100000 'Ouvrir le fichier .LNK
'et non le fichier pointé
Private Const OPEN_EXISTING = 3 'Ne créée pas de fichier
'==============================================================================
' Structures
'Date fichier
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
'Informations ouverture/sauvegarde de fichier
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'Attributs de sécurité (inutile sous Windows 9x)
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'Date fichier, format converti
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
'==============================================================================
' Déclarations API
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) 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 GetLastError Lib "kernel32" () As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) 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 SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
'==============================================================================
' Fonctions membres
Public Function GetOpenFile(ByVal hWndOwner As Long) As String
'Affiche la boîte "Ouvrir", retourne le chemin d'accès ou une chaîne vide sur
'annulation, consulter la doc pour les infos sur les paramètres, sinon il y en
'a pour 12 pages de commentaires
Dim ofn As OPENFILENAME
Dim strFile As String * MAX_PATH, lngFile As Long
Dim lngFileExtension As Long
Dim lngFileOffset As Long, lngError As Long
lngFile = MAX_PATH
ofn.lStructSize = Len(ofn)
ofn.hWndOwner = hWndOwner 'Propriétaire de la fenêtre
ofn.hInstance = 0&
ofn.lpstrFilter = "Tous les fichiers (*.*)" + vbNullChar + "*.*" + _
vbNullChar + vbNullChar
ofn.lpstrCustomFilter = vbNullString
ofn.nMaxCustFilter = 0&
ofn.nFilterIndex = 1
ofn.lpstrFile = strFile
ofn.nMaxFile = lngFile
ofn.lpstrFileTitle = vbNullString
ofn.nMaxFileTitle = 0&
ofn.lpstrInitialDir = vbNullString
ofn.lpstrTitle = "Ouvrir un fichier"
ofn.flags = OFN_HIDEREADONLY Or OFN_NODEREFERENCELINKS
ofn.nFileOffset = lngFileOffset
ofn.nFileExtension = lngFileExtension
ofn.lpstrDefExt = vbNullString
ofn.lCustData = 0&
ofn.lpfnHook = 0&
ofn.lpTemplateName = 0&
lngFile = GetOpenFileName(ofn)
If lngFile <> 0 Then
'On a cliqué sur OK
'Un peu galère en VB de trouver la fin d'une chaîne C.
'Dans l'instruction InStr, on part de l'indicateur de l'extension pour
'aller plus vite
GetOpenFile = Left(ofn.lpstrFile, InStr(ofn.nFileExtension, _
ofn.lpstrFile, vbNullChar) - 1)
Else
'Information de débogage. Consulter CDERR.H pour une info sur le
'code d'erreur (si <> 0)
lngError = CommDlgExtendedError()
GetOpenFile = ""
If lngError <> 0 Then
'lngError contient le code d'erreur
Debug.Assert False
End If
End If
End Function
Public Function GetFileTimes(strFile As String, stCreation As SYSTEMTIME, _
stLastAccess As SYSTEMTIME, stLastWrite As SYSTEMTIME) As Boolean
'Récupération des dates du fichier, renvoie True si OK
'Les informations de date sont renvoyés par référence
Dim ftCreation As FILETIME, ftLastAccess As FILETIME
Dim ftLastWrite As FILETIME, lnghFile As Long
Debug.Assert strFile <> ""
lnghFile = OpenFile(strFile, False)
If lnghFile = INVALID_HANDLE_VALUE Then
MsgBox "Impossible d'ouvrir le fichier " + strFile, vbExclamation
'Voir la fonction OpenFile() en mode débogage pour le code d'erreur
Exit Function
End If
'Bon, ben maintenant ça roule tout seul
GetFileTime lnghFile, ftCreation, ftLastAccess, ftLastWrite
CloseHandle lnghFile
'Conversion Temps Universel -> Temps local
FileTimeToLocalFileTime ftCreation, ftCreation
FileTimeToLocalFileTime ftLastAccess, ftLastAccess
FileTimeToLocalFileTime ftLastWrite, ftLastWrite
'Conversion temps binaire -> temps "humain" (voir les structures FILETIME
'et SYSTEMTIME pour comprendre ce que je veux dire)
FileTimeToSystemTime ftCreation, stCreation
FileTimeToSystemTime ftLastAccess, stLastAccess
FileTimeToSystemTime ftLastWrite, stLastWrite
GetFileTimes = True
End Function
Private Function OpenFile(strFileName As String, blnAccess As Boolean) As Long
'Ouverture d'un fichier strFileName avec blnAccess à True pour l'écriture,
'à False pour lecture seule.
'Renvoi de l'identificateur de fichier
Dim sa As SECURITY_ATTRIBUTES
Dim lngError As Long, lnghFile As Long
Debug.Assert strFileName <> ""
'Sécurité par défaut (non utilisé sous Windows 9x).
sa.nLength = Len(sa)
sa.bInheritHandle = 0&
'Le fichier est ouvert en accès exclusif.
'Modifier le paramètre dwShareMode pour modifier ou lire des fichiers déjà
'ouverts par d'autres programmes
lnghFile = CreateFile(strFileName + vbNullChar, _
IIf(blnAccess, GENERIC_WRITE, GENERIC_READ), 0&, sa, _
OPEN_EXISTING, 0&, 0&)
'Code de débogage, voir WINERROR.H pour la signification
lngError = GetLastError()
OpenFile = lnghFile
End Function
Public Function SetFileTimes(strFile As String, stCreation As SYSTEMTIME, _
stLastAccess As SYSTEMTIME, stLastWrite As SYSTEMTIME) As Boolean
'Affectation des dates du fichier, renvoie True si OK
Dim ftCreation As FILETIME, ftLastAccess As FILETIME
Dim ftLastWrite As FILETIME, lnghFile As Long
Dim blnSuccess As Boolean
Debug.Assert strFile <> "" 'Alors, on a perdu sa maman ?
'Conversion Temps "humain" -> Temps machine
SystemTimeToFileTime stCreation, ftCreation
SystemTimeToFileTime stLastAccess, ftLastAccess
SystemTimeToFileTime stLastWrite, ftLastWrite
'Conversion temps local -> Temps universel
LocalFileTimeToFileTime ftCreation, ftCreation
LocalFileTimeToFileTime ftLastAccess, ftLastAccess
LocalFileTimeToFileTime ftLastWrite, ftLastWrite
lnghFile = OpenFile(strFile, True)
If lnghFile = INVALID_HANDLE_VALUE Then
MsgBox "Impossible d'ouvrir le fichier " + strFile, vbExclamation, _
cstrAppTitle
'Voir la fonction OpenFile en débogage pour le code d'erreur
Exit Function
End If
'SetFileTime renvoie True si OK
blnSuccess = SetFileTime(lnghFile, ftCreation, ftLastAccess, ftLastWrite) <> 0
'Fermeture du fichier
CloseHandle lnghFile
SetFileTimes = blnSuccess
End Function
Conclusion :
Dans le fichier ZIP, vous trouverez :
- Une feuille présentant l'interface utilisateur
- Un module comprenant les routines (réutilisable dans une autre appli).
Codes Sources
A voir également
- Systemtimetofiletime
- Attribut vb net - Meilleures réponses
- Open_existing - Meilleures réponses
- Visual Basic / VB.NET : Lire et modifier les permissions et les audits des fichiers et dossiers sous - Guide
- Lire et modifier les proprietées - Codes sources - C / C++ / C++.NET (Fichiers / Disque)
- Comment modifier l'attribut d'un fichier avec windows scripting host - Codes sources - Foxpro (Applications complètes)
- Lire et modifier les permissions et les audits des cles de registre sous nt/2000/xp (sacl et dacl) - Codes sources - Visual Basic / VB.NET (Sécurité)
- Visual Basic / VB.NET : Enregistrer lire et modifier/écrire dans un fichier texte au format u - Guide
- Messages postés
-
332
- Date d'inscription
- lundi 29 septembre 2008
- Statut
- Membre
- Dernière intervention
- 10 avril 2020
1Bravo pour ce code !
J'en avais eu un qui ne comprenait pas le Closehandle(), du coup, XP n'acceptait pas de le supprimer par exemple en disant "Une autre application utilise actuellement ce fichier".
Encore bravo et merci.
Joss.
Je n'arrive pas à trouver !!
Merci
wx
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.