QQ“发到我的电脑”图片更改文件日期，如何恢复正确日期。

ning84 · 发表于 2024-4-10 10:30

修改文件、文件夹的创建时间、修改时间_shell 获取文件创建时间-CSDN博客 https://blog.csdn.net/tangyin025/article/details/128764302

看了这个帖子有点思路。能走到这步，应该目标可以实现。

ning84 · 发表于 2024-4-12 07:00

学习学习在学习。

https://github.com/MicrosoftDocs ... ll/shell-settime.md

xamples
The following example shows SetTime in use. Proper usage is shown for JScript, VBScript, and Visual Basic.

JScript:

<script language="JScript">
function fnShellSetTimeJ()
{
      var objShell = new ActiveXObject("shell.application");

      objShell.SetTime();
}
</script>
VBScript:

<script language="VBScript">
function fnShellSetTimeVB()
      dim objShell

      set objShell = CreateObject("shell.application")
      objShell.SetTime

      set objShell = nothing
end function
</script>
Visual Basic:

Private Sub fnShellSetTimeVB()
Dim objShell As Shell

Set objShell = New Shell
objShell.SetTime

Set objShell = Nothing
End Sub
Requirements
Requirement Value
Minimum supported client
Windows 2000 Professional, Windows XP [desktop apps only]
Minimum supported server
Windows 2000 Server [desktop apps only]
Header
Shldisp.h
IDL
Shldisp.idl
DLL
Shell32.dll (version 4.71 or later)

ning84 · 发表于 2024-4-13 13:40

越学越深，还是没有达到目标需求，更改文件的时间。

https://wenda.so.com/q/166022343 ... 6%E6%97%B6%E9%97%B4

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 Const GENERIC_WRITE = &H40000000 '常数声明
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
'API声明
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
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) 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 LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Sub Command1_Click()
Dim lngHandle As Long
Dim udtFileTime As FILETIME
Dim udtLocalTime As FILETIME
Dim udtSystemTime As SYSTEMTIME
'这里把C:\***.xls设置成2008年8月8日
'***.wyear = 2008 '设年
''***.wmonth = 8 '月"
'***.wday = 8 '日
'***.wdayofweek = 0 '周
'***.whour = 0 '时
'***.wminute = 0 '分
'***.wsecond = 0 '秒
'***.wmilliseconds = 0 '毫秒
' 转换时间格式 ,不知道微软为什么要搞得这么麻烦
SystemTimeToFileTime udtSystemTime, udtLocalTime
' 再转换
LocalFileTimeToFileTime udtLocalTime, udtFileTime
' createfile在这里不是创建，是打开要修改的文件C:\***.xls
lngHandle = CreateFile("C:\***.xls", GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
' 改变文件时间并msgbox结果
MsgBox SetFileTime(lngHandle, udtFileTime, udtFileTime, udtFileTime)
' 关掉句柄
CloseHandle lngHandle
End Sub

复制代码

ning84 · 发表于 2024-4-14 14:36

学习学习再学习，一个一个帖子试。

VB如何修改文件的创建时间?-CSDN社区 https://bbs.csdn.net/topics/70403822

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Const OFS_MAXPATHNAME = 128
Public Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
Public Const OF_READ = &H0
Public Const OF_READWRITE = &H2
Public 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
Public Type TIME_ZONE_INFORMATION
bias As Long
StandardName(32) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(32) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Public Type BY_HANDLE_FILE_INFORMATION
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
dwVolumeSerialNumber As Long
nFileSizeHigh As Long
nFileSizeLow As Long
nNumberOfLinks As Long
nFileIndexHigh As Long
nFileIndexLow As Long
End Type
Public Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
Public Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Public Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Dim FileHandle As Long
Dim OpenBuff As OFSTRUCT
Dim tZone As TIME_ZONE_INFORMATION
Dim sCreate As SYSTEMTIME
Dim sAccess As SYSTEMTIME
Dim sWrite As SYSTEMTIME
Dim fCreate As FILETIME
Dim fAccess As FILETIME
Dim fWrite As FILETIME
Dim bias As Long
Dim theTime As Date
Dim FileInfo As BY_HANDLE_FILE_INFORMATION
Public Enum FileTimeOptions
theCreateTime = 1
theLastAccessTime = 2
theLastWriteTime = 3
End Enum
Public Sub SetTime(ByVal FileName As String, ByVal CreateTime As Date, ByVal LastAccessTime As Date, ByVal LastWriteTime As Date)
'1,处理文件属性，去掉只读等属性,
If Dir(FileName, 63) = "" Then Exit Sub
SetAttr FileName, vbNormal
'2,处理时差
GetTimeZoneInformation tZone
bias = tZone.bias '时差，以分钟为单位,中国地区为早8小时，值-480。
theTime = TimeSerial(0, bias, 0)
CreateTime = CreateTime + theTime
LastAccessTime = LastAccessTime + theTime
LastWriteTime = LastWriteTime + theTime
'3,将SYSTEMTIME格式时间转换为FILETIME格式时间
sCreate.wDay = Day(CreateTime): sCreate.wHour = Hour(CreateTime): sCreate.wMinute = Minute(CreateTime): sCreate.wMonth = Month(CreateTime): sCreate.wSecond = Second(CreateTime): sCreate.wYear = Year(CreateTime)
sAccess.wDay = Day(LastAccessTime): sAccess.wHour = Hour(LastAccessTime): sAccess.wMinute = Minute(LastAccessTime): sAccess.wMonth = Month(LastAccessTime): sAccess.wSecond = Second(LastAccessTime): sAccess.wYear = Year(LastAccessTime)
sWrite.wDay = Day(LastWriteTime): sWrite.wHour = Hour(LastWriteTime): sWrite.wMinute = Minute(LastWriteTime): sWrite.wMonth = Month(LastWriteTime): sWrite.wSecond = Second(LastWriteTime): sWrite.wYear = Year(LastWriteTime)
SystemTimeToFileTime sCreate, fCreate
SystemTimeToFileTime sAccess, fAccess
SystemTimeToFileTime sWrite, fWrite
'4,修改文件时间
FileHandle = OpenFile(FileName, OpenBuff, OF_READWRITE)
SetFileTime FileHandle, fCreate, fAccess, fWrite '注:这里的三个时间采用的是格林尼治标准时间!
CloseHandle FileHandle
End Sub
Public Function GetTime(ByVal FileName As String, Optional ByVal TimeOfFile As FileTimeOptions = theCreateTime) As Date
If Dir(FileName, 63) = "" Then Exit Function
FileHandle = OpenFile(FileName, OpenBuff, OF_READ)
GetFileInformationByHandle FileHandle, FileInfo
CloseHandle FileHandle
GetTimeZoneInformation tZone
bias = tZone.bias
FileTimeToSystemTime FileInfo.ftCreationTime, sCreate
FileTimeToSystemTime FileInfo.ftLastAccessTime, sAccess
FileTimeToSystemTime FileInfo.ftLastWriteTime, sWrite
Dim CurTime As SYSTEMTIME
Select Case TimeOfFile
Case 1
CurTime = sCreate
Case 2
CurTime = sAccess
Case 3
CurTime = sWrite
End Select
GetTime = DateSerial(CurTime.wYear, CurTime.wMonth, CurTime.wDay) + TimeSerial(CurTime.wHour, CurTime.wMinute - bias, CurTime.wSecond)
End Function
Sub ll()
Dim oDate1 As Date, oDate2 As Date, oDate3 As Date
oDate1 = "1939/1/1"
oDate2 = "1949/1/1"
oDate3 = "1959/1/1"
SetTime "c:\1.jpg", oDate1, oDate2, oDate3
End Sub

复制代码

ning84 · 发表于 2024-4-15 15:58

继续复习以前学习到的知识。
https://learn.microsoft.com/zh-c ... redirectedfrom=MSDN
Folder.ParseName 方法 (Shldisp.h) - Win32 apps | Microsoft Learn https://learn.microsoft.com/zh-c ... redirectedfrom=MSDN
GetDetailsOf

Private Sub btnParseName_Click()
Dim objShell As Shell
Dim objFolder As Shell32.Folder 'ShellFolderItem
Dim objFolderItem As Shell32.FolderItem
Set objShell = New Shell
Set objFolder = objShell.Namespace("F:")
If (Not objFolder Is Nothing) Then
'Dim objFolderItem As FolderItem
Set objFolderItem = objFolder.ParseName("IMG_20240415_081120712.jpg")
Debug.Print objFolder.GetDetailsOf(objFolderItem, 3)
Debug.Print objFolder.GetDetailsOf(objFolderItem, 4)
Debug.Print objFolder.GetDetailsOf(objFolderItem, 5)
' Set tmpFile = oFolder.ParseName(ImgName)
'Add code here.
Debug.Print objFolderItem.ModifyDate
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub

复制代码

ning84 · 发表于 2024-4-17 11:03

猴子掰苞米，边学边忘，还是整理以前学习到的相关知识。

ExtendedProperty("System.Photo.DateTaken")结果相差8小时.-Excel VBA程序开发-ExcelHome技术论坛 - https://club.excelhome.net/thread-1666398-1-1.html

Private Sub dell11()
Dim oSh As Shell32.Shell
Dim ImgName
Dim oFolder As Shell32.Folder
Set oSh = New Shell32.Shell
Dim FolderIt As ShellFolderItem
Dim Str
Dim oDir
Dim oDate As Date
oDir = "F:"
ImgName = "F:\4.jpg"
ImgName = "4.jpg"
Set oFolder = oSh.Namespace(oDir)
Set tmpFile = oFolder.ParseName(ImgName)
Str = oFolder.GetDetailsOf(tmpFile, 12)
Str = Replace(Str, ChrW(8206), "")
Str = Replace(Str, ChrW(8207), "")
Debug.Print Str
Set FolderIt = oSh.Namespace(oDir).ParseName(ImgName)
With FolderIt
Debug.Print .ExtendedProperty("System.Photo.DateTaken")
Debug.Print .ModifyDate
End With
'Debug.Print oDate
Dim Fso As FileSystemObject, tFile As File
Set Fso = New FileSystemObject
Set tFile = Fso.GetFile("F:\4.jpg")
With tFile
Debug.Print .DateCreated, .DateLastAccessed, .DateLastModified
End With
Dim Img As WIA.ImageFile
Set Img = New WIA.ImageFile
Img.LoadFile "F:\4.jpg"
With Img
aa = Split(.Properties(4), " ")
Str = Replace(aa(0), ":", "/") & " " & aa(1)
oDate = Str
Debug.Print Str
End With
End Sub

复制代码

?2023/?6/?14 ??16:24不能转换为日期型.-Excel VBA程序开发-ExcelHome技术论坛 - https://club.excelhome.net/thread-1666047-1-1.html

Sub d()
Dim oSh As Shell32.Shell
Dim Img, ImgName
Dim oFolder As Shell32.Folder
Set oSh = New Shell32.Shell
Dim oDir, oFile
Dim oDate As Date
oDir = "F:"
Set oFolder = oSh.Namespace(oDir)
ImgName = "4.jpg"
Set Img = oFolder.ParseName(ImgName)
Debug.Print oFolder.GetDetailsOf(ImgName, 12), oFolder.GetDetailsOf(Img, 12)
oDate = Img.ExtendedProperty("System.Photo.DateTaken")
Debug.Print oDate
Stop
End Sub

复制代码

		自动登录	找回密码
密码			免费注册