Batya
|
 Posted: Tue Sep 16, 2008 18:02 Post subject: |
 |
|
Brnandman
vbs-скрипт:
| Code: | '======================================================================
' Переименование выделенных файлов по маске
' [G]-[P]-{заданное слово}-[C]
' где [P] - имя родительской папки,
' [G] - имя папки на 2 уровня вверх ("дедушка"),
' [С] - отдельный счетчик для каждого [P].
' При этом расширение файлов не меняется.
'
' Параметры вызова из TC:
' %L
'======================================================================
Option Explicit
'======== Изменяемые параметры ========================================
' Заданное слово для маски переименования
Const GeneralWord = "picture"
' Разделитель в маске
Const Delimiter = "-"
' Разрядность счетчика в маске
Const Precision = 3
'======================================================================
Dim Mess, FSO, FileList, F, P, PF, G, Ext, NewName, NewPath
Dim Errors, Counter
SetMess
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Errors = CreateObject("Scripting.Dictionary")
Set Counter = CreateObject("Scripting.Dictionary")
CheckParam
For Each F In Split(FSO.OpenTextFile(FileList, 1, False).ReadAll, vbNewLine)
F = Trim(F)
If F <> "" Then
If FSO.FileExists(F) Then
Ext = "." & FSO.GetExtensionName(F)
PF = FSO.GetParentFolderName(F)
P = FSO.GetBaseName(PF)
G = FSO.GetBaseName(FSO.GetParentFolderName(PF))
If Not Counter.Exists(PF) Then
Counter.Add PF, 1
Else
Counter(PF) = Counter(PF) + 1
End If
NewName = G & Delimiter & P & Delimiter & GeneralWord & Delimiter & Num(Counter(PF), Precision) & Ext
NewPath = PF & "\" & NewName
On Error Resume Next
FSO.MoveFile F, NewPath
If Err.Number > 0 Then
Errors.Add F & " -> " & NewName, vbNewLine & Err.Description
End If
On Error GoTo 0
End If
End If
Next
If Errors.Count > 0 Then
MessBox JoinErr(Errors), 2
Else
MessBox Mess(3), 3
End If
Quit
Function Num(pC, pPrecision)
Num = Right(String(pPrecision, "0") & pC, pPrecision)
End Function
Sub CheckParam
If WScript.Arguments.Count = 0 Then
MessBox Mess(1), 1
Quit
End If
FileList = WScript.Arguments(0)
If Not FSO.FileExists(FileList) Then
MessBox Mess(2), 1
Quit
End If
End Sub
Sub SetMess
Set Mess = CreateObject("Scripting.Dictionary")
Mess.Add 0, "Переименование по маске"
Mess.Add 1, "Не указаны параметры!"
Mess.Add 2, "Входной параметр не является файлом!"
Mess.Add 3, "Операция завершена."
Mess.Add 4, "Операция завершена с ошибками." & vbNewLine
Mess.Add 5, "Невозможно выполнить переименование:" & vbNewLine
End Sub
Function JoinErr(pDic)
Dim lKey
For Each lKey In pDic
JoinErr = JoinErr & vbNewLine & vbNewLine & Mess(5) & _
lKey & pDic(lKey)
Next
JoinErr = Mess(4) & JoinErr
End Function
Function MessBox(pMess, pMode)
Dim lIcon
Select Case pMode
Case 1 lIcon = vbCritical + vbOKOnly
Case 2 lIcon = vbExclamation + vbOKOnly
Case 3 lIcon = vbInformation + vbOKOnly
End Select
MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function
Sub Quit
Set Counter = Nothing
Set Errors = Nothing
Set FSO = Nothing
Wscript.Quit
End Sub |
_________________
Нет, я не сплю. Я просто медленно моргаю.
Last edited by Batya on Sat Sep 20, 2008 01:41; edited 1 time in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
