修改文件夹和文件属性时间-源代码

Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime 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 SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
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, ByVal PassZero As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal PassZero As Long) As Long
Private Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function openfile1 Lib "kernel32" Alias "OpenFile" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1&
Private Const FILE_SHARE_DELETE = &H4&
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
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 OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName As String * 128
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private FTime As FILETIME '创建时间
Private FTime2 As FILETIME '修改时间
Private FTime3 As FILETIME '访问时间
Private STime As SYSTEMTIME '系统时间
Private Ofs As OFSTRUCT
Private NewDate As Date
Private Const HFILE_ERROR = &HFFFF
Private Const OFS_MAXPATHNAME = 128
Private Const OF_READWRITE = &H2






Private Sub Command1_Click()
Dim CreationTime As FILETIME '文件的创建时间
Dim LastAccessTime As FILETIME '文件上一次访问的时间
Dim STime As SYSTEMTIME
Dim LastWriteTime As FILETIME '文件最近一次修改的时间
Dim hdir As Long
Dim mydir As String

If Label6.Caption = "" Then
MsgBox "请选择目录"
Exit Sub
End If
sda = CDate(Text4.Text) - 1 / 3


NewDate = sda
mydir = Label6.Caption
STime.wDay = Day(NewDate)
STime.wMonth = Month(NewDate)
STime.wYear = Year(NewDate)
STime.wHour = Hour(NewDate)
STime.wMinute = Minute(NewDate)
STime.wSecond = Second(NewDate)

SystemTimeToFileTime STime, CreationTime
hdir = CreateFile(mydir, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_DELETE, _

ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, ByVal 0&)
SetFileTime hdir, CreationTime, LastAccessTime, LastWriteTime
CloseHandle hdir
Label8.Caption = "修改成功!"
End Sub

Private Sub Command2_Click()
Dim filename As String
Dim FSO As New FileSystemObject
Dim mfile As File

filename = Label7.Caption
Set mfile = FSO.GetFile(filename)
List1.Clear
List1.AddItem "文件 创建时间:" + CStr(mfile.DateCreated) '创建时间
List1.AddItem "文件最后修改时间:" + CStr(mfile.DateLastModified) '最后修改时间
List1.AddItem "文件最后访问时间:" + CStr(mfile.DateLastAccessed) '最后访问时间
Text1.Text = mfile.DateCreated
Text2.Text = mfile.DateLastModified
Text3.Text = mfile.DateLastAccessed
End Sub

Private Sub Command3_Click()
Set FSO = CreateObject("Scripting.FileSystemObject") '建立FSO对象
Set fo = FSO.GetFolder(Label6.Caption) '用FSO打开Folder文件夹
List2.Clear
List2.AddItem "文件夹创建时间:" + CStr(fo.DateCreated)
Text4.Text = fo.DateCreated
End Sub

Private Sub Command4_Click()

If Label7.Caption = "" Then
MsgBox "请选择文件"
Exit Sub
End If


hFile = openfile1(Label7.Caption, Ofs, OF_READWRITE)
If hFile <> HFILE_ERROR Then
NewDate = Text1.Text
GetLocalTime STime '获取本地时间
STime.wDay = Day(NewDate)
STime.wMonth = Month(NewDate)
STime.wYear = Year(NewDate)
STime.wHour = Hour(NewDate)
STime.wMinute = Minute(NewDate)
STime.wSecond = Second(NewDate)
SystemTimeToFileTime STime, FTime
LocalFileTimeToFileTime FTime, FTime
SystemTimeToFileTime STime, FTime3
LocalFileTimeToFileTime FTime3, FTime3

NewDate = Text2.Text
GetLocalTime STime '获取本地时间
STime.wDay = Day(NewDate)
STime.wMonth = Month(NewDate)
STime.wYear = Year(NewDate)
STime.wHour = Hour(NewDate)
STime.wMinute = Minute(NewDate)
STime.wSecond = Second(NewDate)
SystemTimeToFileTime STime, FTime3
LocalFileTimeToFileTime FTime3, FTime3

'访问时间 Ftime2
NewDate = Text3.Text
GetLocalTime STime '获取本地时间
STime.wDay = Day(NewDate)
STime.wMonth = Month(NewDate)
STime.wYear = Year(NewDate)
STime.wHour = Hour(NewDate)
STime.wMinute = Minute(NewDate)
STime.wSecond = Second(NewDate)
SystemTimeToFileTime STime, FTime2
LocalFileTimeToFileTime FTime2, FTime2

I = SetFileTime(hFile, FTime, FTime2, FTime3)
End If
CloseHandle hFile
Label9.Caption = "修改成功!"
End Sub

Private Sub Dir1_Change()
Label6.Caption = Dir1.Path
File1.Path = Dir1.Path
List2.Clear
Text4.Text = ""
If Len(Label6.Caption) > 3 Then
Call Command3_Click
End If
Label7.Caption = ""
List1.Clear
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label8.Caption = ""

End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
Label7.Caption = File1.Path +

File1.filename
If Len(File1.Path) > 3 Then
Label7.Caption = File1.Path + "\" + File1.filename
End If
Call Command2_Click
Label9.Caption = ""
End Sub

Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Label6.Caption = ""
Label7.Caption = ""
Label8.Caption = ""
Label9.Caption = ""
Form1.Caption = "文件夹和文件属性修改器V1.1 "
End Sub