Changer date et heure d'un fichier

getion date fichier DATE FICHIER
---------------------
Option Explicit
'
' text1 + text2 + text3 + command1
'
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long,
lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As
FILETIME) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long,
lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any) 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 LocalFileTimeToFileTime Lib "kernel32"
(lpLocalFileTime As FILETIME, lpFileTime 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, lpSecurityAttributes As Any, 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 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
'
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const FILE_SHARE_WRITE = &H2
Const FILE_SHARE_READ = &H1
Const OPEN_EXISTING = 3
Const FILE_ATTRIBUTE_ARCHIVE = &H20
'
Dim NomFichier As String
Dim RetVal As Long
Dim hFile As Long
'
Dim AccessTime As FILETIME
Dim CreationTime As FILETIME
Dim LastWriteTime As FILETIME
Dim WriteTime As FILETIME
Dim SYSTEMTIME As SYSTEMTIME
Dim TimeSystem As SYSTEMTIME
'
Sub Form_Load() ' lecture
ChDrive App.Path
ChDir App.Path
Call lit_temps
End Sub

Sub lit_temps()
NomFichier = App.Path & "test.txt"
hFile = CreateFile(NomFichier, GENERIC_READ, FILE_SHARE_READ, ByVal
CLng(0), OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0)
If hFile = -1 Then
MsgBox "Impossible d'ouvrir le fichier : " + NomFichier, vbExclamation
Exit Sub
End If
'
RetVal = GetFileTime(hFile, CreationTime, AccessTime, LastWriteTime) '
date
RetVal = FileTimeToLocalFileTime(CreationTime, CreationTime) ' date locale
filetime
RetVal = FileTimeToLocalFileTime(AccessTime, AccessTime)
RetVal = FileTimeToLocalFileTime(LastWriteTime, LastWriteTime)
'
RetVal = FileTimeToSystemTime(CreationTime, SYSTEMTIME) ' date systemTime
Text1 = SYSTEMTIME.wDay & "/" & SYSTEMTIME.wMonth & "/" & SYSTEMTIME.wYear
& " " & SYSTEMTIME.wHour & ":" & SYSTEMTIME.wMinute & ":" &
SYSTEMTIME.wSecond
RetVal = FileTimeToSystemTime(AccessTime, SYSTEMTIME)
Text2 = SYSTEMTIME.wDay & "/" & SYSTEMTIME.wMonth & "/" & SYSTEMTIME.wYear
& " " & SYSTEMTIME.wHour & ":" & SYSTEMTIME.wMinute & ":" &
SYSTEMTIME.wSecond
RetVal = FileTimeToSystemTime(LastWriteTime, SYSTEMTIME)
Text3 = SYSTEMTIME.wDay & "/" & SYSTEMTIME.wMonth & "/" & SYSTEMTIME.wYear
& " " & SYSTEMTIME.wHour & ":" & SYSTEMTIME.wMinute & ":" &
SYSTEMTIME.wSecond
CloseHandle (hFile)
End Sub

Sub Command1_Click() ' change
hFile = CreateFile(NomFichier, GENERIC_WRITE, FILE_SHARE_WRITE Or
FILE_SHARE_READ, ByVal CLng(0), OPEN_EXISTING, 0, 0)
'
If hFile = -1 Then
MsgBox "Impossible d'ouvrir le fichier (fichier en lecture seule)" &
vbLf & NomFichier, vbExclamation
Exit Sub
End If
'
TimeSystem = ObtenirDateHeure(Text1)
RetVal = SystemTimeToFileTime(TimeSystem, CreationTime)
RetVal = LocalFileTimeToFileTime(CreationTime, CreationTime)
'
TimeSystem = ObtenirDateHeure(Text2)
RetVal = SystemTimeToFileTime(TimeSystem, AccessTime)
RetVal = LocalFileTimeToFileTime(AccessTime, AccessTime)
'
TimeSystem = ObtenirDateHeure(Text3)
RetVal = SystemTimeToFileTime(TimeSystem, WriteTime)
RetVal = LocalFileTimeToFileTime(WriteTime, WriteTime)
'
RetVal = SetFileTime(hFile, CreationTime, AccessTime, WriteTime) 'modif
file
CloseHandle (hFile)
End Sub

Private Function ObtenirDateHeure(Texte As String) As SYSTEMTIME
Dim nPosMois As Byte
Dim nPosAnnee As Byte
Dim nPosHeure As Byte
Dim nPosMinute As Byte
Dim nPosSeconde As Byte
'
nPosMois = InStr(Texte, "/")
nPosAnnee = InStr(nPosMois + 1, Texte, "/")
nPosHeure = InStr(Texte, " ")
nPosMinute = InStr(nPosHeure + 1, Texte, ":")
nPosSeconde = InStr(nPosMinute + 1, Texte, ":")
'
If nPosMois = 0 Or nPosAnnee = 0 Or nPosHeure = 0 Or nPosMinute = 0 Or
nPosSeconde = 0 Then
MsgBox "Entrez la date et l'heure au format : jj/mm/aaaa hh:mm:ss !",
vbExclamation
Exit Function
End If
'
ObtenirDateHeure.wDay = Val(Left$(Texte, nPosMois - 1))
ObtenirDateHeure.wMonth = Val(Mid$(Texte, nPosMois + 1, (nPosAnnee -
nPosMois)))
ObtenirDateHeure.wYear = Val(Mid$(Texte, nPosAnnee + 1, (nPosAnnee -
nPosMois + 2)))
ObtenirDateHeure.wHour = Val(Mid$(Texte, nPosHeure + 1, (nPosMinute -
nPosHeure)))
ObtenirDateHeure.wMinute = Val(Mid$(Texte, nPosMinute + 1, (nPosSeconde -
nPosMinute)))
ObtenirDateHeure.wSecond = Val(Mid$(Texte, nPosSeconde + 1))
End Function

Sub Form_Unload(Cancel As Integer)
CloseHandle (hFile)
End Sub



--
Site de MES LOGICIELS
http://irolog.free.fr
Site éditeur de MES ROMANS édités
http://irolog.free.fr/romans
mon adresse EMail
http://irolog.free.fr/ecrire/index.htm
------------------------------------------------------------------------------------
"Bruno" <bphesans@infonie.fr> a écrit dans le message de news:
erp3gs$agl$1@news.tiscali.fr...

Bonjour,
Y a t'il une fonction directe pour changer la date et l'heure d'un fichier
? j'ai cherché sur le net, j'ai trouvé un code en passant par les API, ca
m'a l'air bien important. Dans le temps ,je programmais en C sous MSDOS en
appelant une intérruption sytème c'était relativement souple..
merci d'avance
bruno