UMU WSH Git：
+文件内容对比，内容一样的删除其中一个。
+输出日志
' 46_RenameImageToDateTime.VBS' UMU @ 16:33 2014/12/5' [UMU WSH 教程](46) WIA 和 WindowsInstaller 应用实例 - 按图片拍摄时间批量重命名并去重Option ExplicitConst APP_TITLE = "UMU.Script.Tools.RenameImageToDateTime+"Const APP_DESCRIPTION = "本程序用来把带 EXIF 信息的图片按拍摄时间批量重命名。"Const APP_USAGE = "请把要处理的文件或文件夹拖放到本程序的图标上！"Dim args, fso, wiSet args = WScript.ArgumentsSet fso = CreateObject("Scripting.FileSystemObject")Set wi = CreateObject("WindowsInstaller.Installer")If args.Count = 0 Then Usage()Else Dim is_move Dim target_directory Dim is_logging Dim log_file Dim succeeded_count, failed_count, exists_count Main()End IfSet args = NothingSet fso = NothingSet wi = NothingPrivate Sub Usage() Dim wsh Dim send_to, copy_to MsgBox APP_DESCRIPTION & vbCrLf & APP_USAGE, vbInformation, APP_TITLE Set wsh = CreateObject("WScript.Shell") send_to = wsh.SpecialFolders("SendTo") copy_to = send_to & "\" & APP_TITLE & ".VBE" Dim copy_to_sendto If Not fso.FileExists(copy_to) Then copy_to_sendto = True ElseIf Not IsFileTheSame(copy_to, WScript.ScriptFullName) Then copy_to_sendto = True Else copy_to_sendto = False End If If copy_to_sendto Then If vbOK = MsgBox(APP_DESCRIPTION & vbCrLf & APP_USAGE & vbCrLf & vbCrLf & _ "提示：您可以把此文件放在 Sendto 目录里，然后使用右键菜单的“发送到”。" & vbCrLf & _ "您的 Sendto 目录是 " & send_to & vbCrLf & "按“确定”执行复制操作。", _ vbOKCancel + vbInformation, APP_TITLE) Then fso.CopyFile WScript.ScriptFullName, copy_to If vbYes = MsgBox("是否查看 Sendto 目录？", vbQuestion + vbYesNo, APP_TITLE) Then wsh.Run "%SystemRoot%\explorer.exe /n, /select," & copy_to End If End If End If Set wsh = NothingEnd SubPrivate Sub Main() is_move = MsgBox("重命名文件？按“否”复制文件，按“取消”退出！" & vbCrLf & "如果选择“是”则文件重复时，会删除多余文件。", vbYesNoCancel + vbQuestion, "询问") If vbCancel = is_move Then Exit Sub End If is_logging = MsgBox("产生日志？按“取消”退出！", vbYesNoCancel + vbQuestion, "询问") If vbCancel = is_logging Then Exit Sub End If If is_logging = vbYes Then Set log_file = fso.CreateTextFile(fso.GetSpecialFolder(2) & "\" & APP_TITLE & ".log") End If target_directory = InputBox("请输入存放目录：", "存放目录") If Len(target_directory) = 0 Then Exit Sub End If If Not fso.FolderExists(target_directory) Then MsgBox target_directory, vbError, "存放目录不存在" Exit Sub End If If Right(target_directory, 1) <> "\" Then target_directory = target_directory & "\" End If succeeded_count = 0 failed_count = 0 exists_count = 0 Dim ar For Each ar In args If fso.FolderExists(ar) Then Call RenameImageToDateTime_s(ar) ElseIf fso.FileExists(ar) Then Call RenameImageToDateTime(ar) End If Next If is_logging = vbYes Then log_file.Close Set log_file = Nothing End If MsgBox "重命名 " & succeeded_count & " 个，失败 " & failed_count & _ " 个，文件已经存在 " & exists_count & " 个！", 4160, "整个世界清净了！"End SubPrivate Sub RenameImageToDateTime_s(ByVal folder_path) 'On Error Resume Next Dim rfd, fs, f, fds, fd Set rfd = fso.GetFolder(folder_path) Set fs = rfd.Files For Each f In fs Call RenameImageToDateTime(f.Path) Next Set fds = rfd.SubFolders For Each fd In fds Call RenameImageToDateTime_s(fd.Path) NextEnd SubPrivate Sub RenameImageToDateTime(ByRef file_path) 'On Error Resume Next Dim dt dt = GetImageDateTime(file_path) If Len(dt) > 0 Then Dim y, m Dim path y = Left(dt, 4) m = Mid(dt, 6, 2) path = target_directory & y If Not fso.FolderExists(path) Then Call fso.CreateFolder(path) End If path = path & "\" & y & "-" & m If Not fso.FolderExists(path) Then Call fso.CreateFolder(path) End If If Err.Number <> 0 Then failed_count = failed_count + 1 Err.Clear Exit Sub End If Dim ext ext = Mid(file_path, InStrRev(file_path, ".")) path = path & "\" & dt & ext If 0 = StrComp(file_path, path, vbTextCompare) Then ' 路径一样，不做处理 exists_count = exists_count + 1 If is_logging = vbYes Then log_file.WriteLine "=" & file_path log_file.WriteLine "=" log_file.WriteLine "----------------" End If ElseIf fso.FileExists(path) Then exists_count = exists_count + 1 If IsFileTheSame(file_path, path) Then fso.DeleteFile file_path If is_logging = vbYes Then log_file.WriteLine "~" & file_path log_file.WriteLine "@" & path log_file.WriteLine "----------------" End If Else If is_logging = vbYes Then log_file.WriteLine file_path log_file.WriteLine "@" & path log_file.WriteLine "----------------" End If End If ElseIf vbYes = is_move Then fso.MoveFile file_path, path If Err.Number <> 0 Then failed_count = failed_count + 1 Err.Clear If is_logging = vbYes Then log_file.WriteLine "~" & file_path log_file.WriteLine "-" & path log_file.WriteLine "----------------" End If Else succeeded_count = succeeded_count + 1 If is_logging = vbYes Then log_file.WriteLine "~" & file_path log_file.WriteLine "+" & path log_file.WriteLine "----------------" End If End If Else fso.CopyFile file_path, path If Err.Number <> 0 Then failed_count = failed_count + 1 Err.Clear If is_logging = vbYes Then log_file.WriteLine "&" & file_path log_file.WriteLine "-" & path log_file.WriteLine "----------------" End If Else succeeded_count = succeeded_count + 1 If is_logging = vbYes Then log_file.WriteLine "&" & file_path log_file.WriteLine "+" & path log_file.WriteLine "----------------" End If End If End If Else ' 没有拍照日期 If is_logging = vbYes Then log_file.WriteLine file_path log_file.WriteLine "!" log_file.WriteLine "----------------" End If End IfEnd SubPrivate Function GetImageDateTime(ByRef file_path) On Error Resume Next GetImageDateTime = "" Dim image_file Set image_file = CreateObject("WIA.ImageFile") image_file.LoadFile file_path If Err.Number <> 0 Then ' 可能不是图像，或者图像格式无法识别 Exit Function End If Dim dt Dim prop_names Dim name prop_names = Array("ExifDTOrig", "ExifDTDigitized", "DateTime") For Each name In prop_names If image_file.Properties.Exists(name) Then Dim prop Set prop = image_file.Properties(name) dt = prop.Value Set prop = Nothing Exit For End If Next Set image_file = Nothing If Len(dt) > 0 Then dt = Replace(dt, "/", "-") dt = Replace(dt, ":", "-") dt = Replace(dt, " ", "_") GetImageDateTime = dt End IfEnd FunctionPrivate Function BigEndianHex(int) Dim result Dim b1, b2, b3, b4 result = Right("0000000" & Hex(int), 8) b1 = Mid(result, 7, 2) b2 = Mid(result, 5, 2) b3 = Mid(result, 3, 2) b4 = Mid(result, 1, 2) BigEndianHex = b1 & b2 & b3 & b4End FunctionPrivate Function GetFileHash(ByRef file_name) Dim file_hash Dim hash_value Dim i Set file_hash = wi.FileHash(file_name, 0) hash_value = "" For i = 1 To file_hash.FieldCount hash_value = hash_value & BigEndianHex(file_hash.IntegerData(i)) Next Set file_hash = Nothing GetFileHash = hash_valueEnd FunctionPrivate Function IsFileTheSame(ByRef file1, ByRef file2) If 0 = StrComp(file1, file2, vbTextCompare) Then IsFileTheSame = True Else Dim hash1, hash2 hash1 = GetFileHash(file1) hash2 = GetFileHash(file2) If hash1 = hash2 And Len(hash1) > 0 Then IsFileTheSame = True Else IsFileTheSame = False End If End IfEnd Function