Создание списка со структурой выбранных элементов
Q: Так уж случилось, что для создания списков файлов с подкаталогами я использую плагин CatalogMaker.
Он сохраняет древовидные списки каталогов с файлами, а справа - их атрибуты, выстроенные по одной вертикали. Всё очень удобно и наглядно.
Проблемы начались, когда в именах моих файлов с папками начали появляться спецсимволы и иероглифы. Остаётся лишь пропустить всё подобное и в итоге список оказывается неполным.
Можно ли мне как-то помочь записать в списки файлов и папок специальные символы?:
A: Привожу в качестве решения vbs-скрипт с похожим на CatalogMaker функционалом и с учётом записи юникодных символов:
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Создание списка со структурой выбранных в панели элементов
' Условия:
' 1) vbs-файл сохранить в Юникоде: UTF16 LE c ВОМ или UTF16 BE без ВОМ
' 2) путь запуска - пустой
' 3) выбрать для просмотра моноширинный шрифт
' например: Courier New, Lucida Console
' Параметры (! - обязательный):
' 1. <путь к списку элементов> (!)
' 2. "<путь назначения>\" (!) (если установить "", то - активный каталог);
' 3. <не/указывать размер файлов в байтах: 0/1> (!)
' 4. <не/указывать дату модификации файлов 0/1> (!)
' 5. <не/указывать время модификации файлов 0/1> (!)
' 6. <сортировать файлы по имени/размеру/дате и времени: 0/1/2> (!)
' 7. <сортировать файлы по возрастанию/убыванию: 0/1> (!)
' 8. <отступ - кол-во пробелов> (!)
' 9. <фильтр-список расширений файлов> разделитель - запятая
' 10. "<относительный путь к редактору для открытия файла>"
' Примеры:
' 1) %WL "" 1 1 0 1 1 2 jpg,jpeg,png,gif
' 2) %WL "%T" 1 1 1 2 1 3 "" "Utils\Akelpad\Akelpad.exe"
' Автор - Flasher ©
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
With WScript.Arguments
On Error Resume Next
List = .Item(0) : Path = .Item(1) : FSize = .Item(2) : FDate = .Item(3) : FTime = .Item(4)
FSort = .Item(5) : Rev = .Item(6) : Indent = .Item(7) : If .Count > 8 Then Filt = .Item(8)
If .Count > 9 Then Editor = .Item(9)
If Len(List) > 0 And .Count < 8 Then Errors "Не выполнено условие:" & vbnewline &_
"минимальное число параметров - 8", 16
If Err.Number > 0 Then Errors "Не выбраны элементы!", 5 : On Error goto 0
For Arg = 2 to 6 : If .Item(Arg) < 0 Or .Item(Arg) > 2 Then Nums = Nums & ", " & Arg + 1
Next : If Nums <> "" Then Errors "Для следующих параметров" & vbnewline &_
"значения не верны: " & Mid(Nums, 2), 17
End With : Summ = FSize + FDate + FTime : If FTime Then FDate = 1
Sub Errors(Desc, SCount)
MsgBox Desc, vbExclamation, Space(SCount) & "Создание списка элементов" : Wscript.Quit
End Sub
Select Case FSort
Case 1 Sort = "FSize" : Case 2 Sort = "FDate"
End Select : If Rev Then Sort = Sort & " DESC" : If Summ = 0 Then Sort = "Name"
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH : Set WSH = CreateObject("WScript.Shell")
Set Coll = CreateObject("Scripting.Dictionary")
Set Dict = CreateObject("ADODB.Recordset")
CD = WSH.CurrentDirectory : TrgDepth = UBound(Split(CD, "\"))
Coll.Add 1, 0 : SetLocale(1049) : Dict.Fields.Append "Name", 200, 255
If FSize Then _
Sz = " Размер в байтах" : SpSz = " " & String(15, "¯") : Dict.Fields.Append "FSize", 139, 15
If FDate Then _
FD = " Дата" : SpFD = " " & String(10, "¯") : Dict.Fields.Append "FDate", 135, 22
If FTime Then FT = Space(8) & "Время" : SpFT = " " & String(8, "¯") : Dict.Open
Mass = Split(FSO.GetFile(List).OpenAsTextStream(1,-1).ReadAll, vbNewLine)
Last = Mass(Ubound(Mass) - 1)
For Each F in Mass
If Trim(F) > vbNullString Then
If FSO.FolderExists(F) Then ForFolder FSO.GetFolder(F), SS Else Indent = 0 : ForFile F, SS, 1
End If
Next : Count = Coll.Item(1) : If Count < 15 Then Count = 15
If Count > 15 Then Spc = Space(Count - 15)
For Each St in Split(SS, vbCr)
Sr = "" : St1 = "" : T2 = "" : Sr1 = "" : St2 = "" : T1 = InStr(St, vbTab)
If T1 Then
Sr = Left(St, T1 - 1) : St1 = Mid(St, T1 + 1) : T2 = InStr(St1, vbTab)
If FSize Then St = Sr & Space(Count - Len(Sr) + 3) & St1
If FDate Then
If FSize Then
Sr1 = Left(St1, T2 - 1) : St2 = Mid(St1, T2 + 1)
St = Sr & Space(Count - Len(Sr) + 3) & Sr1 & Space(18-Len(Sr1)) & DateValue(St2)
Else St = Sr & Space(Count - Len(Sr) + 3) & DateValue(St1) : End If
If FTime Then
If FSize Then TV = TimeValue(St2) Else TV = TimeValue(St1)
St = St & " " & TV
End If
End If
End If : Text = Text & vbCr & St
Next
If Text <> "" Then
If Right(Path, 1) <> "\" Then Path = Path & "\"
Name = FSO.GetFileName(CD) : If Name = "" Then Name = "Drive " & Left(CD, 1)
NewName = Path & Name & ".txt" : FN = NewName : n = 0 : Const M = 0
Do While FSO.FileExists(NewName)
n = n + 1 : If n < 10^M Then PFix = Right(String(M, "0") & n, M) Else PFix = n
NewName = Path & FSO.GetBaseName(FN) & " (" & PFix & ")." & FSO.GetExtensionName(FN)
Loop
FSO.OpenTextFile(NewName, 2, True, -1).Write "Имя папки/файла" & Spc & Sz & FD & FT &_
vbnewline & String(Count, "¯") & SpSz & SpFD & SpFT & Text
If Editor <> "" Then WSH.Exec "%COMMANDER_PATH%\" & Editor & " """ & NewName & """"
End If : Set FSO = Nothing : Set WSH = Nothing : Set Dict = Nothing
Set Coll = Nothing : WScript.Quit
Sub ForFolder(Folder, S)
Depth = UBound(Split(Folder.Path, "\")) - TrgDepth - 1
FName = Space(Depth*Indent) & Folder.Name & "\"
S = S & vbNewLine & FName : Length = Len(FName)
If Length > Coll.Item(1) Then Coll.Item(1) = Length
For Each Fl In Folder.SubFolders : ForFolder Fl, S : Next
Set Files = Folder.Files
Max = Files.Count
If Max Then
For Each Fl In Files
i = i + 1 : ForFile Fl, "", Depth
If i = Max And Dict.RecordCount Then
Cr = vbCr : Dict.Sort = Sort : If Right(S, 1) = vbCr Then Cr = ""
S = S & Cr & Dict.GetString : i = 0 : Dict.CancelBatch
End If
Next
End If
End Sub
Sub ForFile(File, S, FDepth)
If Filt <> "" Then
For Each Fi in Split(Filt,",")
If StrComp(Fi, FSO.GetExtensionName(File), 1) = 0 Then FileProc File, S, FDepth : Exit For
Next
Else FileProc File, S, FDepth
End If
If FSO.GetParentFolderName(File) = CD And File = Last Then
Dict.Sort = Sort : Cr = vbCr : If Right(S, 1) = vbCr Then Cr = ""
S = S & Cr & Dict.GetString : i = 0 : Dict.CancelBatch
End If
End Sub
Sub FileProc(FF, S, FlDepth)
Set A = FSO.GetFile(FF)
Str = Space(Indent + FlDepth*Indent) & A.Name : Length = Len(Str)
If Length > Coll.Item(1) Then Coll.Item(1) = Length
Dict.AddNew : Dict("Name") = Str
If FSize Then Dict("FSize") = CCur(A.Size)
If FDate Then Dict("FDate") = CStr(A.DateLastModified) : Dict.Update
End Sub
Flasher
12.11.2014