if WScript.Arguments.Count = 0 Then
MsgBox "Не указаны параметры!", vbOKOnly + vbError, "Внимание!"
Wscript.Quit
End If
' определяем регулярное выражение для поиска
' даты снимка из exif данных: в плагине поле Date
Dim re
Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.MultiLine = False
re.Pattern = "4: Date: .*" ' 4-е поле, возвращаемое плагином
Dim TempFile, FSO, SelFile, wdxtest, wdxplug, WshShell, DateFolder, c, res, n_month, n_day, n_year
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set TempFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
wdxtest="h:\PRG\TotalCommander\Scripts\wdxtest\wdxtest.exe"'путь к wdxtest.exe
wdxplug="h:\PRG\TotalCommander\Plugins\wdx\wdx_exif\Exif.wdx"'путь к Exif плагину
' основной цикл для перебора всех выделенных файлов и переданных в скрипт
Do While Not TempFile.AtEndOfStream
Set SelFile = FSO.GetFile(TempFile.ReadLine) 'путь к файлу, инфу о котором получаем
' запускаем wdxtext.exe с соответствующими параметрами
Set res = WshShell.Exec(wdxtest & " " & wdxplug & " " & SelFile)
c = res.StdOut.ReadAll
Set field=re.Execute(c)
FileName = FSO.GetBaseName(SelFile)
' проверка на условие корректного ответа;
' при несоответствии файла критериям плагина (отсутствует EXIF-информация)
' плагин в каждое поле возвращает ошибку, которая начинается с символов --,
' тогда за имя создаваемого каталога берется дата последней модификации файла
' (обычно соотвествует дате создания)
If InStr(field(0).Value,"--")>0 Then
DateFolder = Left(SelFile.DateLastModified, 10)
Else
DateFolder = Replace(Mid(field(0).Value,10,10),"/",".")
' приведение даты к виду dd.mm.yyyy
n_year = Left(DateFolder,4)
n_month = Mid(DateFolder,6,2)
n_day = Right (DateFolder,2)
DateFolder = n_day & "." & n_month & "." & n_year
End If
FilePath = SelFile.ParentFolder
If WScript.Arguments.Count > 1 Then
NewFilePath = WScript.Arguments(1) & DateFolder
Else
NewFilePath = FilePath & "\" & DateFolder
End If
If Not FSO.FolderExists(NewFilePath) Then
FSO.CreateFolder(NewFilePath)
End If
If Not FSO.FileExists(NewFilePath & "\" & FileName) Then
FSO.MoveFile SelFile, NewFilePath & "\"
Else
MsgBox "Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!"
End If
Loop
|