Como puedo obtener la fecha de creación de un archivo ?

Tano Mendoza · #1 (**permalink**) 07/06/2006, 20:31

Necesito conocer las fechas de creación y última modificación de archivos desde Visual Basic 6, y si es posible modificarlas.
Me pueden decir como se hace ?

marcos1979 · #2 (**permalink**) 07/06/2006, 23:59

Bue, aca vamos:

Declara esto:

Código:

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_DELETE As Long = &H4
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Private Const OPEN_EXISTING = 3

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 Long
End Type

'Para obtener el handle
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

'Cierra el handle anterior
Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long

'Para obtener las fechas
Private Declare Function GetFileTime Lib "kernel32" _
  (ByVal hFile As Long, _
   lpCreationTime As FILETIME, _
   lpLastAccessTime As FILETIME, _
   lpLastWriteTime As FILETIME) As Long
   
'Para convertir las fechas
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 SystemTimeToFileTime Lib "kernel32" _
  (lpSystemTime As SYSTEMTIME, _
   lpFileTime As FILETIME) As Long

Private Declare Function LocalFileTimeToFileTime Lib "kernel32" _
  (lpLocalFileTime As FILETIME, _
   lpFileTime As FILETIME) As Long

'Para guardar las fechas
Private Declare Function SetFileTime Lib "kernel32" _
  (ByVal hFile As Long, _
   lpCreationTime As FILETIME, _
   lpLastAccessTime As Any, _
   lpLastWriteTime As Any) As Long

'Tipo usado para agrupar las tres fechas
Private Type FechasDeArchivo
    Creacion As Date
    Modificacion As Date
    Acceso As Date
End Type

Luego estas funciones:

Código:

'Funcion para guardar las fechas
Private Function GuardarFechas(ByVal s_PathFile As String, ByRef t_Fechas As FechasDeArchivo) As Boolean


    Dim FechaCreacion As FILETIME
    Dim FechaAcceso As FILETIME
    Dim FechaModif As FILETIME
    Dim fHandle As Long
    Dim SysFechaCreacion As SYSTEMTIME
    Dim SysFechaAcceso As SYSTEMTIME
    Dim SysFechaModif As SYSTEMTIME
    
    'Obtener el handle
    fHandle = CreateFile(s_PathFile, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_DELETE, 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0&)
    
    'Cambiamos las fechas
    With SysFechaCreacion
        .wDay = Day(t_Fechas.Creacion)
        .wMonth = Month(t_Fechas.Creacion)
        .wYear = Year(t_Fechas.Creacion)
        .wHour = Hour(t_Fechas.Creacion)
        .wMinute = Minute(t_Fechas.Creacion)
        .wSecond = Second(t_Fechas.Creacion)
        .wMilliseconds = 0
    End With
    
    With SysFechaModif
        .wDay = Day(t_Fechas.Modificacion)
        .wMonth = Month(t_Fechas.Modificacion)
        .wYear = Year(t_Fechas.Modificacion)
        .wHour = Hour(t_Fechas.Modificacion)
        .wMinute = Minute(t_Fechas.Modificacion)
        .wSecond = Second(t_Fechas.Modificacion)
        .wMilliseconds = 0
    End With
    
    With SysFechaAcceso
        .wDay = Day(t_Fechas.Acceso)
        .wMonth = Month(t_Fechas.Acceso)
        .wYear = Year(t_Fechas.Acceso)
        .wHour = Hour(t_Fechas.Acceso)
        .wMinute = Minute(t_Fechas.Acceso)
        .wSecond = Second(t_Fechas.Acceso)
        .wMilliseconds = 0
    End With
    
    'Convertimos las fechas
    If SystemTimeToFileTime(SysFechaCreacion, FechaCreacion) <> 1 Then GoTo ErrHandler
   
    If LocalFileTimeToFileTime(FechaCreacion, FechaCreacion) <> 1 Then GoTo ErrHandler
      
    'Convertimos otra
    If SystemTimeToFileTime(SysFechaModif, FechaModif) <> 1 Then GoTo ErrHandler
   
    If LocalFileTimeToFileTime(FechaModif, FechaModif) <> 1 Then GoTo ErrHandler
      
    'Convertimos la ultima
    If SystemTimeToFileTime(SysFechaAcceso, FechaAcceso) <> 1 Then GoTo ErrHandler
   
    If LocalFileTimeToFileTime(FechaAcceso, FechaAcceso) <> 1 Then GoTo ErrHandler
    
    'Cambiamos las fechas del archivo
    If SetFileTime(fHandle, FechaCreacion, FechaAcceso, FechaModif) <> 1 Then GoTo ErrHandler
    
    'Cerramos el handle
    If CloseHandle(fHandle) <> 1 Then GoTo ErrHandler
    
    GuardarFechas = True
    
    Exit Function
    
ErrHandler:

    GuardarFechas = False
    
    MsgBox "Ocurrio un error gurdando las fechas", vbCritical, "Error"

End Function

'Funcion para leer las fechas
Private Function LeerFechas(ByVal s_PathFile As String) As FechasDeArchivo

    Dim FechaCreacion As FILETIME
    Dim FechaAcceso As FILETIME
    Dim FechaModif As FILETIME
    Dim fHandle As Long
    Dim SysFechaCreacion As SYSTEMTIME
    Dim SysFechaAcceso As SYSTEMTIME
    Dim SysFechaModif As SYSTEMTIME
    
On Error GoTo ErrHandler
    
    'Obtener el handle
    fHandle = CreateFile(s_PathFile, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_DELETE, 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0&)
    
    'Leemos las fechas (este formato no se puede manejar asi)
    If GetFileTime(fHandle, FechaCreacion, FechaAcceso, FechaModif) <> 1 Then GoTo ErrHandler
    
    'Convertimos una de las fechas
    If FileTimeToLocalFileTime(FechaCreacion, FechaCreacion) <> 1 Then GoTo ErrHandler
    
    If FileTimeToSystemTime(FechaCreacion, SysFechaCreacion) <> 1 Then GoTo ErrHandler
    
    'Convertimos otra
    If FileTimeToLocalFileTime(FechaAcceso, FechaAcceso) <> 1 Then GoTo ErrHandler
    
    If FileTimeToSystemTime(FechaAcceso, SysFechaAcceso) <> 1 Then GoTo ErrHandler
    
    'Convertimos la ultima
    If FileTimeToLocalFileTime(FechaModif, FechaModif) <> 1 Then GoTo ErrHandler
    
    If FileTimeToSystemTime(FechaModif, SysFechaModif) <> 1 Then GoTo ErrHandler
    
    LeerFechas.Creacion = DateSerial(SysFechaCreacion.wYear, SysFechaCreacion.wMonth, SysFechaCreacion.wDay) + TimeSerial(SysFechaCreacion.wHour, SysFechaCreacion.wMinute, SysFechaCreacion.wSecond)
    LeerFechas.Modificacion = DateSerial(SysFechaModif.wYear, SysFechaModif.wMonth, SysFechaModif.wDay) + TimeSerial(SysFechaModif.wHour, SysFechaModif.wMinute, SysFechaModif.wSecond)
    LeerFechas.Acceso = DateSerial(SysFechaAcceso.wYear, SysFechaAcceso.wMonth, SysFechaAcceso.wDay) + TimeSerial(SysFechaAcceso.wHour, SysFechaAcceso.wMinute, SysFechaAcceso.wSecond)

    If CloseHandle(fHandle) <> 1 Then GoTo ErrHandler
    
    Exit Function
    
ErrHandler:

    LeerFechas.Creacion = Empty
    LeerFechas.Modificacion = Empty
    LeerFechas.Acceso = Empty
    
    MsgBox "Ocurrio un error leyendo las fechas", vbCritical, "Error"

End Function

Para usarlo:

Código:

Private Sub cmdLeer_Click()

    Dim fechas As FechasDeArchivo
    
    fechas = LeerFechas("C:\Prueba.txt")
    
    MsgBox fechas.Creacion & vbCrLf & fechas.Modificacion & vbCrLf & fechas.Acceso

End Sub

Private Sub cmdEscribir_Click()
    
    Dim fechas As FechasDeArchivo
    
    fechas.Acceso = "2099/11/18 05:25:22"
    fechas.Modificacion = "2007/12/21 21:24:53"
    fechas.Creacion = "2007/06/21 10:45:58"
    
    If GuardarFechas("C:\Prueba1.txt", fechas) = True Then
        fechas = LeerFechas("C:\Prueba.txt")
        
        MsgBox "Las nuevas fechas son: " & vbCrLf & fechas.Creacion & vbCrLf & fechas.Modificacion & vbCrLf & fechas.Acceso
        
    Else
    
        MsgBox "No se pudieron escribir las fechas"
    
    End If
    
End Sub

Espero que te ayude, un saludo

Tano Mendoza · #3 (**permalink**) 08/06/2006, 08:53

Muchas gracias. Pruebo.

carlos100 · #4 (**permalink**) 15/03/2007, 13:41

s_PathFile, me dice que el procedimiento externo no es valido, me imagino que se requiere una referencia, me puedes decir cual es?

atte,

carlos100

seba123neo · #5 (**permalink**) 16/03/2007, 02:18

aca te dejo un ejemplo que funciona perfecto:pone 4 textbox,el primero va a ser para ingresar la ruta del archivo y su extencion.y los otros te muestran cuando fue creado modificado y ultimo ingreso.y tambien pone 3 botones,uno para salir y uno para apretarlo despues de ingresar la ruta que hace que te muestre los datos,y el otro para la ventana de propiedades del archivo.

Option Explicit

Private Const OFS_MAXPATHNAME = 128
Private Const OF_READWRITE = &H2

Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(0 to OFS_MAXPATHNAME -1) As Byte '0-based
End Type

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 Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(0 to 31) As Integer '32, 0-based
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(0 to 31) As Integer '32, 0-based
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type

Private Declare Sub GetLocalTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME)

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 FILETIME, _
lpLastAccessTime As FILETIME, _
lpLastWriteTime As FILETIME) As Long

Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME) As Long

Private Declare Function SystemTimeToFileTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME, _
lpFileTime As FILETIME) As Long

Private Declare Function OpenFile Lib "kernel32" _
(ByVal lpFileName As String, _
lpReOpenBuff As OFSTRUCT, _
ByVal wStyle As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hFile As Long) As Long

Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type

Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400

Private Declare Function ShellExecuteEx Lib "shell32" _
Alias "ShellExecuteEx" _
(SEI As SHELLEXECUTEINFO) As Long

Private Sub Command1_Click()

Unload Me

End Sub

Private Sub Command2_Click()

'variables required
Dim hFile As Long
Dim fName As String
Dim tmp As String

'structures required
Dim OFS As OFSTRUCT
Dim SYS_TIME As SYSTEMTIME
Dim FT_CREATE As FILETIME
Dim FT_ACCESS As FILETIME
Dim FT_WRITE As FILETIME
Dim NEW_TIME As FILETIME

'assign the textbox entry to the filename
fName = (Text1)

'open the file
hFile = OpenFile(fName, OFS, OF_READWRITE)

'get the FILETIME info for the created,
'accessed and last write info
Call GetFileTime(hFile, FT_CREATE, FT_ACCESS, FT_WRITE)

'----- debug only ---------------------------
'show the system time info
tmp = "Date Created:" & vbTab & GetFileDateString(FT_CREATE) & vbCrLf
tmp = tmp & "Last Access:" & vbTab & GetFileDateString(FT_ACCESS) & vbCrLf
tmp = tmp & "Last Modified:" & vbTab & GetFileDateString(FT_WRITE)
Text2.Text = tmp
'--------------------------------------------

'obtain the local system time
'(adjusts for the GMT deviation
'of the local time zone)
GetLocalTime SYS_TIME

'----- debug only ---------------------------
'show the system time info
tmp = ""
tmp = "Day:" & vbTab & SYS_TIME.wDay & vbCrLf
tmp = tmp & "Month:" & vbTab & SYS_TIME.wMonth & vbCrLf
tmp = tmp & "Year:" & vbTab & SYS_TIME.wYear & vbCrLf
tmp = tmp & "String:" & vbTab & GetSystemDateString(SYS_TIME)
Text3.Text = tmp
'--------------------------------------------

'convert the system time to a valid file time
Call SystemTimeToFileTime(SYS_TIME, NEW_TIME)

'set the created, accessed and modified dates all
'to the new dates. A null (0&) could be passed as
'any of the NEW_TIME parameters to leave that date unchanged.
Call SetFileTime(hFile, NEW_TIME, NEW_TIME, NEW_TIME)

're-read the updated FILETIME info for the created,
'accessed and last write info
Call GetFileTime(hFile, FT_CREATE, FT_ACCESS, FT_WRITE)

'----- debug only ---------------------------
'show the system time info
tmp = "New Date Created:" & vbTab & GetFileDateString(FT_CREATE) & vbCrLf
tmp = tmp & "New Last Access:" & vbTab & GetFileDateString(FT_ACCESS) & vbCrLf
tmp = tmp & "New Last Modified:" & vbTab & GetFileDateString(FT_WRITE)
Text4.Text = tmp
'--------------------------------------------

'clean up by closing the file
Call CloseHandle(hFile)

End Sub

Private Sub Command3_Click()

Dim SEI As SHELLEXECUTEINFO

'Fill in the SHELLEXECUTEINFO structure
'and call the ShellExecuteEx API
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or _
SEE_MASK_INVOKEIDLIST Or _
SEE_MASK_FLAG_NO_UI
.hwnd = Me.hwnd
.lpVerb = "properties"
.lpFile = (Text1)
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With

'call the API
Call ShellExecuteEx(SEI)

End Sub

Private Function GetFileDateString(CT As FILETIME) As String

Dim ST As SYSTEMTIME
Dim ds As Single

'convert the passed FILETIME to a
'valid SYSTEMTIME format for display
If FileTimeToSystemTime(CT, ST) Then
ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
GetFileDateString = Format$(ds, "DDDD MMMM D, YYYY")
Else
GetFileDateString = ""
End If

End Function

Private Function GetSystemDateString(ST As SYSTEMTIME) As String

Dim ds As Single

ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)

If ds Then
GetSystemDateString = Format$(ds, "DDDD MMMM D, YYYY")
Else
GetSystemDateString = "error!"
End If

End Function

al correr el programa ingresa en el text1 la ruta del archivo y su extencion tambien y apreta el boton 2.

matarasky · #6 (**permalink**) 26/01/2011, 13:30

Dim ruta As String
'creado
MsgBox(File.GetCreationTime(ruta))
'modificado
MsgBox(FileSystem.FileDateTime(ruta))

hugo180486 · #7 (**permalink**) 27/01/2011, 12:55

Otra alternativa, se repitio el post muchas veces no?, ah Disculpen pero este no sirve para modificar... Lo siento...

http://www.forosdelweb.com/f69/obten...8/#post3722383

cristhyan · #8 (**permalink**) 25/11/2011, 05:21

Esta es la mejor alternativa para obtener metadatos o informacion tipo nom, fecha de creacion y ultima modificacion con el visual studio 2010. En este link de microsoft:

http://msdn.microsoft.com/es-es/library/as4xcs58.aspx