Lev
|
 Posted: Tue May 16, 2006 00:27 Post subject: |
 |
|
Найти и пометить файлы с одинаковыми именами
Исходное сообщение - http://www.ghisler.ch/board/viewtopic.php?t=8844
Peter
В списке есть исходные данные (например: 1.doc, 2.do3, 3.doc, 4.doc) и их производные (1.pdf, 2.pdf, 3.pdf, 5.pdf).
Требуется выполнить несколько задач:
a) Найти все doc-файлы, к которым нет соответствующего pdf (напр. 4.doc)
b) Найти все pdf-файлы, к которым нет соответствующего doc (напр. 5.pdf)
c) Найти все pdf-файлы старее, чем исходный doc, и соответственно устаревшие
----
van Dusen
| Code: | 'Script for Script content Plugin
' van Dusen
' (c)Lev Freidin, 2005
' http://www.totalcmd.net/plugring/script_wdx.html
' http://wincmd.ru/plugring/script_wdx.html
Dim fso, f1, f2
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.GetFile(filename)
sBaseIst = lcase(fso.GetBaseName(filename))
sExtIst = lcase(fso.GetExtensionName(filename))
sDateModF1 = f1.DateLastModified
sExtSoll1 = "doc"
sExtSoll2 = "pdf"
Const ForReading = 1
SELECT Case sExtIst
Case sExtSoll1
sResult = sExtSoll2 & " - сответствующий файл"
If fso.FileExists(sBaseIst & "." & sExtSoll2) Then
Set f2 = fso.GetFile(sBaseIst & "." & sExtSoll2)
sTimeDiff = DateDiff("n", sDateModF1, f2.DateLastModified)
If sTimeDiff < 0 Then
sResult = "2: " & sResult & " устарел"
Else
sResult = "1: " & sResult & " свежий"
End If
sResult = sResult & " (" & sTimeDiff & " Min. Diff.)"
Else
sResult = "3: " & sResult & " отсутствует"
End If
Case sExtSoll2
If fso.FileExists(sBaseIst & "." & sExtSoll1) Then
Set f2 = fso.GetFile(sBaseIst & "." & sExtSoll1)
sTimeDiff = DateDiff("n", sDateModF1, f2.DateLastModified)
If sTimeDiff > = 0 Then
sResult = "2: Файл устарел"
Else
sResult = "1: Свежий файл"
End If
sResult = sResult & " ("& sTimeDiff & " Min. Diff.)"
Else
sResult = "3: "& sExtSoll1 &" - соответствующий файл отсутствует"
End If
Case Else
sResult = ""
End SELECT
content = sResult
Set fso=nothing
Set f1=nothing
Set f2=nothing |
Лично мне разница во времени не понадобилась, я натравливал скрипт на папку с кучей jpg фоток и соответствующими им обтравленными tif'ами, понравилось  |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
