Вобщем, есть необходимость изменять любые даты у файла.
Написал такой вот модуль. Используется API вперемешку с FSO.
--------------------------------------------------
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
Option Explicit
'Модуль для изменения даты модификации файлов
Private Const OFS_MAXPATHNAME = 128
Private Const OF_READ = &H0
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
' Функция задает файлу дату создания, модификации и последнего доступа
' *использование API-функции совместно с FSO
Function SetDateAsIWant(ByVal FilePath As String, _
Optional ByVal DateCreate As Date, _
Optional ByVal DateModify As Date, _
Optional ByVal DateAccess As Date, _
Optional ByVal MessageOn As Boolean) As Boolean
' Обработка ошибок
If IsNull(FilePath) Or FilePath = "" Then
SetDateAsIWant = False
Exit Function
End If
If IsEmpty(DateCreate) And IsEmpty(DateModify) And IsEmpty(DateAccess) Then
SetDateAsIWant = False
Exit Function
End If
SetDateAsIWant = False
'Вроде особых ошибок нет - продолжим...
Dim fsoFile As Scripting.File
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject") 'Microsoft Scripting Runtime
'Проверка существования файла
If fso.FileExists(FilePath) Then
Set fsoFile = fso.GetFile(FilePath)
Dim FTCreate As FILETIME
Dim FTModify As FILETIME
Dim FTAccess As FILETIME
Dim tOFSTRUCT As OFSTRUCT
Dim hfile As Long
'*в структуры записываются текущие значения дат
FTCreate.dwHighDateTime = CLng(fsoFile.DateCreated)
FTCreate.dwLowDateTime = CLng(fsoFile.DateCreated)
FTModify.dwHighDateTime = CLng(fsoFile.DateLastModified)
FTModify.dwLowDateTime = CLng(fsoFile.DateLastModified)
FTAccess.dwHighDateTime = CLng(fsoFile.DateLastAccessed)
FTAccess.dwLowDateTime = CLng(fsoFile.DateLastAccessed)
'*используется API-функция открытия файла, поскольку
'для установки дат нужен дескриптор этого файла
hfile = OpenFile(FilePath, tOFSTRUCT, OF_READ)
If Not IsEmpty(MessageOn) And MessageOn Then
MsgBox " tOFSTRUCT.cBytes = " & tOFSTRUCT.cBytes & vbNewLine & _
" tOFSTRUCT.fFixedDisk = " & tOFSTRUCT.fFixedDisk & vbNewLine & _
" tOFSTRUCT.nErrCode = " & tOFSTRUCT.nErrCode & vbNewLine & _
" tOFSTRUCT.Reserved1 = " & tOFSTRUCT.Reserved1 & vbNewLine & _
" tOFSTRUCT.Reserved2 = " & tOFSTRUCT.Reserved2 & vbNewLine & _
" tOFSTRUCT.szPathName(OFS_MAXPATHNAME) = " & tOFSTRUCT.szPathName(OFS_MAXPATHNAME)
End If
If Not IsEmpty(DateCreate) Then
FTCreate.dwHighDateTime = CLng(DateCreate)
FTCreate.dwLowDateTime = CLng(DateCreate)
End If
If Not IsEmpty(DateModify) Then
FTModify.dwHighDateTime = CLng(DateModify)
FTModify.dwLowDateTime = CLng(DateModify)
End If
If Not IsEmpty(DateAccess) Then
FTAccess.dwHighDateTime = CLng(DateAccess)
FTAccess.dwLowDateTime = CLng(DateAccess)
End If
SetFileTime hfile, FTCreate, FTModify, FTAccess
SetDateAsIWant = True
Else
SetDateAsIWant = False
End If
If Not IsEmpty(MessageOn) And MessageOn Then
MsgBox " Дата создания : " & fsoFile.DateCreated & vbNewLine & _
" Дата модификации : " & fsoFile.DateLastModified & vbNewLine & _
" Дата последнего доступа : " & fsoFile.DateLastAccessed
End If
Set fsoFile = Nothing
Set fso = Nothing
On Error Resume Next
CloseHandle hfile
End Function
---------------------------------------
Например такой вызов
SetDateAsIWant( "C:\test.txt" , Date, Date, Date)
поставленную задачу не решает.
Как вы думаете, почему?
Спасибо за внимание.
