loochanin
@loochanin
Дизайнер. Шанувач AI та автоматизації

Как переименовать файлы шрифтов в их оригинальные названия?

Подскажите пожалуйста, как переименовать файлы шрифтов в их оригинальные названия, которые указанны в свойствах
5fed8b6d0464c346901299.jpeg
  • Вопрос задан
  • 109 просмотров
Пригласить эксперта
Ответы на вопрос 3
firedragon
@firedragon
Senior .NET developer
Попробуйте с помощью Тотал коммандер, у него по моему есть команда массового переименования в том числе и по мета атрибутам
Ответ написан
wisgest
@wisgest
Не ИТ-специалист. Рабочий. Шизоидный психопат.
Можно переименовать, например, на VBScript, используя для получения свойств файла методы объекта Shell.Application:ExtendedProperty или GetDetailsOf. Для первого надо знать текстовое наименование свойства, его узнать у меня пока не получилось, да и не всегда оно есть. Для второго —числовой индекс, его можно узнать опытным путём, у меня получилось 21, но на других машинах может быть другое число.

Дело не пошло со шрифтами с расширением FON (растровыми?): у них значение найденного мной свойства не отличается для разновидностей шрифта в разных файлах. Но со шрифтами True Type (расширение TTF) что-то получилось. Впрочем, в случае, когда имя отличается лишь регистром, я переименовывать не стал, так как тогда возникает ошибка «Файл уже существует».
Const PROPERTY_INDEX = 21
	' ВНИМАНИЕ:
	' Индес PROPERTY_INDEX свойства, содержащего название шрифта,
	' определён опытным путём
	' <http://forum.script-coding.com/viewtopic.php?id=38>
	' и зависит от установленного программного обеспечения!!!

Set Shell = CreateObject("Shell.Application")

Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_EDITBOX = &H10
Const BIF_NONEWFOLDERBUTTON = &H200
Do
	Set Folder = Shell.BrowseForFolder(0, WScript.ScriptName, _
		BIF_RETURNONLYFSDIRS Or BIF_EDITBOX Or BIF_NONEWFOLDERBUTTON)
	If Folder Is Nothing Then WScript.Quit
	If Folder.Self.Path = Shell.NameSpace("shell:Fonts").Self.Path Then
		MsgBox "C системной папкой шрифтов не работает!", _
			vbExclamation, WScript.ScriptName
	Else
		Exit Do
	End If
Loop

Set FolderItems = Folder.Items()
Count = FolderItems.Count
Redim Items(Count - 1)
For I = 0 to Count - 1
	Set Items(I) = FolderItems.Item(I)
Next

Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Item In Items
	Path = Item.Path
	ExtensionName = FSO.GetExtensionName(Path)
	If UCase(ExtensionName) = "TTF" Then
		FontTitle = Folder.GetDetailsOf(Item, PROPERTY_INDEX)
		If UCase(FontTitle) <> UCase(FSO.GetBaseName(Path)) Then
			OldName = FSO.GetFile(Path).Name
			NewName = FontTitle & "." & ExtensionName
			On Error Resume Next
			FSO.GetFile(Path).Name = NewName
			If Err Then MsgBox _
				OldName & " => " & NewName & vbNewLine & _
				Err.Description, vbExclamation, WScript.ScriptName
			On Error GoTo 0
		End If
	End If
Next
MsgBox "Конец.", vbInformation, WScript.ScriptName
Ответ написан
loochanin
@loochanin Автор вопроса
Дизайнер. Шанувач AI та автоматизації
У себя б блоге продолжаю тему — https://serhii.lutsk.city/y6e1A0znO
Ответ написан
Ваш ответ на вопрос

Войдите, чтобы написать ответ

Войти через центр авторизации
Похожие вопросы