Lire et modifier les attributs de date d'un fichier

Soyez le premier à donner votre avis sur cette source.

Vue 30 850 fois - Téléchargée 1 570 fois

Télécharger le projet

Commenter

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.

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).

Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler

Galactus13

Messages postés: 332
Date d'inscription: lundi 29 septembre 2008
Statut: Membre
Dernière intervention: 10 avril 2020

1
11 nov. 2009 à 11:49

Bravo Bien expliqué !

Signaler

myjoss

Messages postés: 3
Date d'inscription: jeudi 3 mars 2005
Statut: Membre
Dernière intervention: 11 août 2006

7 août 2006 à 13:01

Bonjour,
Bravo 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.

Signaler

Salaminovitch

Messages postés: 13
Date d'inscription: dimanche 29 décembre 2002
Statut: Membre
Dernière intervention: 13 avril 2006

27 sept. 2005 à 16:03

Magnifique!!!!

Signaler

Messages postés: 23
Date d'inscription: lundi 19 juillet 2004
Statut: Membre
Dernière intervention: 3 novembre 2007

7 sept. 2005 à 14:43

Existe t-il dans le meme style une API pour récupérer et/ou modifier la propriété "auteur" d'un fichier ?
Je n'arrive pas à trouver !!
Merci
wx

Signaler

cs_chocobo

Messages postés: 126
Date d'inscription: samedi 18 janvier 2003
Statut: Membre
Dernière intervention: 4 mars 2005

23 févr. 2005 à 13:17

Excellent bravo il marche super bien ton programme et c très bien expliqué en + !!

Afficher les 7 commentaires

S'inscrire maintenant

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.

Source / Exemple :

Conclusion :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !