GarfildNewNEW

Программистские изыски на коленке #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

Wscript.Sleep(200)

File5 = path & "\" & "Конечная"

REM В конце удаляем папки исходные уже без подпапок и исключаем из стирания папку "Конечная"

if path2<>File5 then

FSO.DeleteFolder path2 , False

End If

REM БИБИКАЕМ когда закончили обработку

set wshShell = Wscript.CreateObject("wscript.Shell")

beep = chr(007)

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

жмем окей и получаем ярлык от диспетчера дисков - где вы можите форматировать распределять, зеркалить и рейдить что вам угодно.