I was in search for a routine to get a file's date&time info from within
mapbasic.
Thanks to Yas NaKayama and others, here it is. I'm posting it for those of
you who would be interested.
Juan Pufleau
Mexico.
----------------------------------------------------------------------
' Programa FechaHora
include "mapbasic.def"
Type FILETIME
dwLowDateTime As integer
dwHighDateTime As integer
End Type
Type SystemTime
wYear As SmallInt
wMonth As SmallInt
wDayOfWeek As SmallInt
wDay As SmallInt
wHour As SmallInt
wMinute As SmallInt
wSecond As SmallInt
wMilliseconds As SmallInt
End Type
Declare Sub Main
Declare Sub ImprimeHora ( HoraSistema as SystemTime )
Declare Function FechaHoraLocal ( HoraAPI as FileTime, HoraSistema as
SystemTime ) as logical
Declare Function lopen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As
String, ByVal iReadWrite As integer) As integer
Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As
integer) As integer
Declare Function GetFileTime Lib "kernel32" (ByVal hFile As integer,
lpCreationTime As FILETIME, lpLastAccessTime As FILETIME,
lpLastWriteTime As FILETIME) As integer
Declare Function FileTimeToSystemTime Lib "KERNEL32"
( lpFileTime As FileTime, lpSystemTime As SystemTime) As
Integer
Declare Function FileTimeToLocalFileTime Lib "KERNEL32"
( lpFileTime As FileTime, lpLocalFileTime As FileTime) As
Integer
'***********************
Sub Main
Dim NumArchivo as integer, Bien as logical,
Creacion, Acceso, Escritura as FileTime,
DatoSistema as SystemTime,
Dato, Dato2 as Integer,
File as string
File = FileOpenDlg( "" , "*.*" , "" , "Seleccione Archivo" )
NumArchivo = Lopen ( File , 1 ) ' iReadWrite needs to be "1".
'Should be something as
"readonly" / "shared" ?
if NumArchivo = -1 then note "File Error" end program end if
Dato = GetFileTime ( NumArchivo, Creacion, Acceso, Escritura )
if Dato = 0 then note "Date Error" end program end if
Dato2 = Lclose ( NumArchivo )
if Dato2 <> 0 then note "Close Error" end program end if
print chr$(12)+ "Date / Time info for file "+File
Bien = FechaHoraLocal ( Creacion, DatoSistema )
if Bien then
print "Creacion"
Call ImprimeHora (DatoSistema )
else print "error"
end if
Bien = FechaHoraLocal ( Escritura, DatoSistema )
if Bien then
print "Escritura"
Call ImprimeHora (DatoSistema )
end if
Bien = FechaHoraLocal ( Acceso, DatoSistema )
if Bien then
print "Acceso (dato guardado sin hora)"
Call ImprimeHora (DatoSistema )
end if
end sub
Sub ImprimeHora ( HoraSistema as SystemTime )
if (HoraSistema.wHour = 0 and HoraSistema.wMinute = 0
and HoraSistema.wSecond = 0 and HoraSistema.wMilliSeconds =
0) then
'no data for file time.
print " a�o " +HoraSistema.wYear +
" mes " + HoraSistema.wMonth +
" dia " + HoraSistema.wDay +
" diaSem " + HoraSistema.wDayOfWeek
else
print " a�o " +HoraSistema.wYear +
" mes " + HoraSistema.wMonth +
" dia " + HoraSistema.wDay +
" diaSem " + HoraSistema.wDayOfWeek +
" hora " + HoraSistema.wHour +
" min " + HoraSistema.wMinute +
" seg " + HoraSistema.wSecond +
" ms " + HoraSistema.wMilliSeconds
End If
End Sub
Function FechaHoraLocal ( HoraAPI as FileTime, Horasistema as SystemTime )
as logical
Dim FHlocal as FileTime, FHsistema as SystemTime, Ok as logical
FechaHoraLocal = False
If HoraAPI.dwLowDateTime = 0 And HoraAPI.dwHighDateTime = 0 Then Exit
Function end if
Ok = FileTimeToLocalFileTime( HoraAPI, FHLocal)
If Ok Then Ok = FileTimeToSystemTime( FHLocal, FHsistema) end if
'if you want plain system time (without local offset), use this line
instead.
'Ok = FileTimeToSystemTime( HoraAPI, FHsistema)
if not ok then exit function end if
HoraSistema.wYear = FHsistema.wYear
HoraSistema.wMonth = FHsistema.wMonth
HoraSistema.wDayOfWeek = FHsistema.wDayOfWeek
HoraSistema.wDay = FHsistema.wDay
HoraSistema.wHour = FHsistema.wHour
HoraSistema.wMinute = FHsistema.wMinute
HoraSistema.wSecond = FHsistema.wSecond
HoraSistema.wMilliSeconds = FHsistema.wMilliSeconds
FechaHoraLocal = True
End Function
----------------------------------------------------------------------
To unsubscribe from this list, send e-mail to [EMAIL PROTECTED] and put
"unsubscribe MAPINFO-L" in the message body, or contact [EMAIL PROTECTED]
