Программистские изыски на коленке #4
Ситуация - имеем в основной директории папки в которых содержатся субпапки на один уровень вниз с файлами , надо переименовать субпапки по шаблону "Имя папки - имя субпапки"
и переписать их в папку "Конечная".
Возникла из-за того что найден торрент Модель для сборки в котором папки имеют имя писателя , а подпапки имя произведения , а надо папки с именем писателя ,пробел, тире, пробел, наименование произведения.
Скрипт запускается прямо в дирректории с папками , работу увидите по уменьшающемуся количеству папок в дирректории , в конце работы бипер компа пробибикает 6 раз.
Код написан в VBS ( блокнот - сохранить в расширении .vbs), папки должны быть в той же дирректории что и скрипт , после обработки возьмете переименованные в папки "Конечная".
Количество обрабатываемых папок не ограничено.
Код :
Dim FSO, Folder, List, List2, Folder2, Papka
Set FSO = CreateObject("Scripting.FileSystemObject")
Set F = FSO.GetFile(Wscript.ScriptFullName)
path = FSO.GetParentFolderName(F)
REM Отключаем сообщения об ошибке - если папка "Конечная" уже есть
On Error Resume Next
REM Создание в дирректории с скриптом папки "Конечная"
fso.createfolder path & "\" & "Конечная"
Set Folder = FSO.GetFolder(path)
REM Цикл перечисление папок в директории
For Each Papka In Folder.SubFolders
List1 = Papka.Name
REM Присвоение path2 пути к папке в цикле
path2= path & "\" & List1
Set Folder2 = FSO.GetFolder(path2)
For Each Papka2 In Folder2.SubFolders
REM Цикл перечисление папок в субдиректориях
List2 = Papka2.Name
REM Присвоение File1 пути к субпапке
File1 = path2 & "\" & List2
REM Исключение из обработки папки "Конечная" чтоб в ней подпапки не имели в имени название этой папки
if List1<>"Конечная" then
File2 = List1 & " - " & List2
else
File2 = List2
end if
REM Переименование через CMD
Dim Ws,Command,Execution
Set Ws = CreateObject("WScript.Shell")
Command = "Cmd /c Ren "& DblQuote(File1) &" "& DblQuote(File2) &""
Execution = Ws.Run(Command,0,False)
Wscript.Sleep(200)
REM Расчет путей и перемещение папок в папку "Конечная"
File3 = path2 & "\" & File2
File4 = path & "\" & "Конечная\"
FSO.MoveFolder File3 , File4
Next
Wscript.Sleep(200)
File5 = path & "\" & "Конечная"
REM В конце удаляем папки исходные уже без подпапок и исключаем из стирания папку "Конечная"
if path2<>File5 then
FSO.DeleteFolder path2 , False
End If
Next
REM БИБИКАЕМ когда закончили обработку
set wshShell = Wscript.CreateObject("wscript.Shell")
beep = chr(007)
WshShell.Run "cmd /c @Echo " & beep, 0
WshShell.Run "cmd /c @Echo " & beep, 0
WshShell.Run "cmd /c @Echo " & beep, 0
WshShell.Run "cmd /c @Echo " & beep, 0
WshShell.Run "cmd /c @Echo " & beep, 0
WshShell.Run "cmd /c @Echo " & beep, 0
WshShell.Run "cmd /c @Echo " & beep, 0
REM НЕ ТРОГАТЬ ! Это субскрипт для переименования папок
'**********************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************
Продолжаем эпопею малоизвесного и очень простого.
И так у нас новый диск купленный из магазина и у вас противная винда xp,7,10 ....
правая клавиша мыши по рабочему столу - создать ярлык .
Вписываем:
обьект C:\Windows\System32\diskmgmt.msc
Рабочая папка C:\Windows\system32
жмем окей и получаем ярлык от диспетчера дисков - где вы можите форматировать распределять, зеркалить и рейдить что вам угодно.
