I was trying to change the modification date on folders and I figured out, that the original PB function returns always zero.
I do not know if this is/was intentional.
Fortunately i work under windows and know the msdn helppages a bit.
This is what came out of it: Maybe someone can use that too.
Before you compile the program, change the folder name to one that exists on your system.
See this line: Define Folder$ = "C:\Temp\" ; <== change this to your folder !!!
Hint: Watch the folder modified time in the explorer while running ... (only if you added the modified date field to the view.)
BTW: Found a missing api function for time zone dependent conversion.... but that can be easily fixed.
Code: Select all
; :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; :: File : SetFileTime.pb -- and folders
; ::
; :: Purpose : change the creation, access, lastwrite date/time of folders
; :: because the original PB function always returns zero
; ::
; :: License : Free, unrestricted, no warranty whatsoever -- Use at your own risk! │
; ::
; :: Changed : ImportC to Import to support X86 and x64
; :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
CompilerIf #PB_Compiler_OS = #PB_OS_Windows ;' windows only -- i think :-)
; CompilerError "OS supported, you can now comment me."
CompilerElse
CompilerError "OS isn't supported, sorry."
CompilerEndIf
EnableExplicit
;
;ImportC "" ; Kernel32 -- on x64, this will behave the same as Import
Import "" ; Kernel32 -- stdcall on X86
TzSpecificLocalTimeToSystemTime(*lpTimeZoneInformation.TIME_ZONE_INFORMATION, *LocalTime.SYSTEMTIME, *UniversalTime.SYSTEMTIME)
; BOOL WINAPI TzSpecificLocalTimeToSystemTime(
; _In_opt_ LPTIME_ZONE_INFORMATION lpTimeZoneInformation,
; _In_ LPSYSTEMTIME lpLocalTime,
; _Out_ LPSYSTEMTIME lpUniversalTime
; );
EndImport
; :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; :: helper system functions
Procedure.s FormatMessage(ErrorCode, xAppendErrorCode=#False) ;' returns message (Error text) from system according to errorcode, code can be included
Protected result$, *buf, buflen
; DWORD FormatMessage(DWORD dwFlags, LPCVOID lpSource, DWORD dwMessageId, DWORD dwLanguageId, LPTSTR lpBuffer, DWORD nSize, va_list *Arguments);
; 0x0409 United States (US) 0x01 SUBLANG_ENGLISH_US
; 0x0407 Germany (DE) 0x01 SUBLANG_GERMAN
buflen = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM, 0, ErrorCode, 0, @*buf, 0, 0)
If buflen > 0
result$ = PeekS(*buf, buflen-2) ;' remove #CRLF$ at the end
LocalFree_(*buf) ;' free the memory
If xAppendErrorCode <> #False
result$ + " // ErrorCode = 0x"+RSet(Hex(ErrorCode), 8, "0")+" ("+Str(ErrorCode)+")"
EndIf
Else
Debug "ERROR with FormatMessage_() == 0x"+Hex(GetLastError_()) ;' error in the formatmessage_ function
EndIf
ProcedureReturn result$
EndProcedure ;()
Procedure.s GetLastError()
ProcedureReturn FormatMessage(GetLastError_(), #True)
EndProcedure ;()
; :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; :: Date() to filetime convertion functions
Procedure FileTimeToDate(*FT.FILETIME) ;' convert windows API time format to Date() format
Protected stUTC.SYSTEMTIME, st.SYSTEMTIME
FileTimeToSystemTime_(*FT, stUTC)
SystemTimeToTzSpecificLocalTime_(#Null, stUTC, st) ; msdn: If lpTimeZone is NULL, the function uses the currently active time zone.
ProcedureReturn Date(st\wYear, st\wMonth, st\wDay, st\wHour, st\wMinute, st\wSecond)
EndProcedure ;()
Procedure DateToFileTime(date, *FT.FILETIME) ;' convert Date() to windows API time format
Protected stUTC.SYSTEMTIME, st.SYSTEMTIME
st\wYear = Year(date) : st\wMonth = Month(date) : st\wDay = Day(date)
st\wDayOfWeek = DayOfWeek(date)
st\wHour = Hour(date) : st\wMinute = Minute(date) : st\wSecond = Second(date)
TzSpecificLocalTimeToSystemTime(#Null, st, stUTC)
SystemTimeToFileTime_(stUTC, *FT)
EndProcedure ;()
; :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; :: similar to GetFileDate(FileName$, DateType)
Procedure GetFileTime(File$, DateType) ;' get the time of a file or folder
Protected result, rc, hFile, ft.FILETIME
hFile = CreateFile_(@File$, #GENERIC_READ, #FILE_SHARE_READ|#FILE_SHARE_WRITE, 0, #OPEN_EXISTING, #FILE_ATTRIBUTE_NORMAL|#FILE_FLAG_BACKUP_SEMANTICS, 0)
If hFile <> #INVALID_HANDLE_VALUE
Select DateType
Case #PB_Date_Created : rc = GetFileTime_(hFile, ft, 0, 0)
Case #PB_Date_Accessed : rc = GetFileTime_(hFile, 0, ft, 0)
Case #PB_Date_Modified : rc = GetFileTime_(hFile, 0, 0, ft)
EndSelect
If rc = 0 :Debug " LastError of GetFileTime_() => " + GetLastError() + " "
Else
result = FileTimeToDate(ft)
EndIf
CloseHandle_(hFile)
Else
Debug " LastError of CreateFile_() => " + GetLastError() + " "
EndIf
ProcedureReturn result
EndProcedure ;()
; :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; :: set file time -- File$ can be file or folder -- improvement to standard PB
; :: similar to SetFileDate(FileName$, DateType, Date)
Procedure SetFileTime(File$, DateType, Date) ;' set the time of a file or folder
Protected result, hFile, ft.FILETIME
hFile = CreateFile_(@File$, #GENERIC_WRITE, #FILE_SHARE_READ|#FILE_SHARE_WRITE, 0, #OPEN_EXISTING, #FILE_ATTRIBUTE_NORMAL|#FILE_FLAG_BACKUP_SEMANTICS, 0)
If hFile <> #INVALID_HANDLE_VALUE
DateToFileTime(Date, ft)
Select DateType
Case #PB_Date_Created : result = SetFileTime_(hFile, ft, 0, 0) ;' msdn: if the function succeeds, the return value is nonzero.
Case #PB_Date_Accessed : result = SetFileTime_(hFile, 0, ft, 0)
Case #PB_Date_Modified : result = SetFileTime_(hFile, 0, 0, ft)
EndSelect
CloseHandle_(hFile)
EndIf
ProcedureReturn result ;' same as api function -- if succeeds return nonzero
EndProcedure ;()
; :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; :: Test the functions
CompilerIf #PB_Compiler_IsMainFile
Define Folder$ = "C:\Temp\" ; <== change this to your folder !!!
Define tmp, olddate, newdate = Date(2021, 1, 1, 1, 0, 0) ;' 1.1.2021 1:00:00
Macro Info(sMsg, dDate)
MessageRequester("INFO", "Folder: '" + Folder$ + "' " + #LF$ + "Modified ("+sMsg+"): " + FormatDate("%dd.%mm.%yyyy %hh:%ii:%ss", dDate) , #MB_ICONINFORMATION)
EndMacro
If FileSize(Folder$) <> -2
MessageRequester("ERROR", "Unknown Folder: '" + Folder$ + "' " + #LF$ + "Choose an existing folder and compile again!", #MB_ICONERROR)
End
EndIf
olddate = GetFileTime(Folder$, #PB_Date_Modified)
Info("before", olddate)
SetFileTime(Folder$, #PB_Date_Modified, newdate)
tmp = GetFileTime(Folder$, #PB_Date_Modified)
Info("after", tmp)
SetFileTime(Folder$, #PB_Date_Modified, oldDate)
Info("reset", olddate)
CompilerEndIf
; :: Bottom of File :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::