Monarch-LFV

|
Posted: Sun Oct 12, 2025 12:11 Post subject: |
|
|
Подниму тему, просто столкнулся с проблемой, что предложенная в соседней ветке команда копирования имен папок и файлов "lists=%Z%UL||##path<4>" имеет ряд недостатков:
1. Очень долго работает когда количество файлов и папок огромно (тест проводил на 50 000 файлов и 4000 папок, операция длится где-то секунд 30)
2. Неправильно обрабатывает файлы с несколькими точками в конце "имя файла 12.10.2025 г..txt" => "имя файла 12.10.2025 г" (одна точка теряется)
3. неправильно отрабатывает имена начинающиеся с точки например файл ".gitignore" => "" (ничего, так как посчитал имя расширением).
Посему решил написать скрипт VBS, и вообще отойти от понятия файлов и папок, а рассматривать и обрабатывать имена как единый текстовый массив:
 Copy_Filename_And_Foldername.vbs Code: | ' Скопировать имена папок и файлов без расширений
' Параметры: %Z%WF
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set objRegEx = CreateObject("VBScript.RegExp")
List=FSO.OpenTextFile(WScript.Arguments(0),,,-1).ReadAll
if err.number<>0 then msgbox "Не выделено ни одного элемента": wscript.quit
List=replace(List, vbcrlf, "*")
With objRegEx
.Pattern = "([^\*\\]+?\\?)(\.[^\*\.\\]+)?\*"
.Global = true
Text = .replace(List, "$1" & vbcrlf)
End With
Text=replace(Text, "\", "")
Text=left(Text, len(Text)-2)
'=== Возможная автозамена, например, " - " на TAB для вставки в Excel, или "_" на " "
' Text=replace(Text, " - ", chr(9))
' Text=replace(Text, "_", " ")
'=============================================================
CopyToClip_UTF8_without_BOM(Text)
' WshShell.Popup "Имена скопированы", 1, "", vbOkonly
Set FSO = Nothing
Set WshShell = Nothing
Set objRegEx = Nothing
sub CopyToClip_UTF8_without_BOM(MultiLine_text)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
tmpclp = WshShell.ExpandEnvironmentStrings("%temp%") & "\~$Clipboard.txt"
If FSO.fileExists(tmpclp) then FSO.DeleteFile tmpclp
with CreateObject("ADODB.Stream")
.Charset = "utf-8"
.Type = 2
.Open
.WriteText MultiLine_text
.Position = 0
.Type = 1
.Position = 3
data = .Read
.close
.open
.Write data
.SaveToFile tmpclp, 1
.Close
end with
WshShell.Run "cmd /c chcp 65001&&type " & tmpclp & "| clip", 0, True
FSO.DeleteFile tmpclp
end sub |
По итогу:
1. Время копирования имен 50 000 файлов и 4000 папок = 0,17 сек
2. точки в конце имен файлов сохраняются
3. Имена файлов, начинающиеся с точки сохраняются.
4. Плюс закомментированные строки в середине скрипта на случай, если потребуется некая обработка (замена) чего-либо.
Вдруг кому пригодится  |
|