[решено] Возможно ли в свойствах ярлыка поменять размер шрифта посредством cmd/vbs?

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)

- - [решено] Возможно ли в свойствах ярлыка поменять размер шрифта посредством cmd/vbs? (http://forum.oszone.net/showthread.php?t=212440)

Anton04

02-08-2011 12:57 1724496

Возможно ли в свойствах ярлыка поменять размер шрифта посредством cmd/vbs?

Возможно ли в свойствах ярлыка поменять размер шрифта посредством cmd/vbs?

Например после установки "Far manager" появляется ярлык на рабочем столе, но по умолчанию там стоит 20 размер шрифта, а хочется (для примера) 28.

Интересует, в основном, решение на cmd, но на vbs то же пойдёт.

Iska	03-08-2011 07:12 1724940

Например, так:

Код:

Option Explicit



Const SSFMOpenReadWrite = 1



Const strConsoleDataBlockSignature = "CC000000020000A0"

Const lngFontSizePosition          = 24





Dim objFSO

Dim objSpeechFileStream



Dim strLnkFileName

Dim lngConsoleDataBlockPosition



Dim arrContent





'strLnkFileName = "E:\Песочница\0063\Far2.lnk"

strLnkFileName = WScript.Arguments.Item(0)



Set objFSO                = WScript.CreateObject("Scripting.FileSystemObject")

Set objSpeechFileStream   = WScript.CreateObject("SAPI.spFileStream")



With objFSO

        If .FileExists(strLnkFileName) Then

                If UCase(.GetExtensionName(strLnkFileName)) = UCase("lnk") Then

                        .GetFile(strLnkFileName).Copy strLnkFileName & ".bak", True

                        

                        With objSpeechFileStream

                                .Open strLnkFileName, SSFMOpenReadWrite

                                .Read arrContent, objFSO.GetFile(strLnkFileName).Size

                                

                                lngConsoleDataBlockPosition = InStr(ConvertByteArray2HexString(arrContent), strConsoleDataBlockSignature)

                                

                                If lngConsoleDataBlockPosition <> 0 Then

                                        .Seek lngConsoleDataBlockPosition \ 2 + Len(strConsoleDataBlockSignature) / 2 + lngFontSizePosition + 2

                                        .Write 28

                                Else

                                        WScript.Echo "Can't find ConsoleDataBlock section in [" & strLnkFileName & "]"

                                End If

                                

                                .Close()

                        End With

                Else

                        WScript.Echo "File [" & strLnkFileName & "] is not *.lnk file"

                End If

        Else

                WScript.Echo "File [" & strLnkFileName & "] not found"

        End If

End With



Set objSpeechFileStream   = Nothing

Set objFSO                = Nothing



WScript.Quit 0

'=============================================================================



'=============================================================================

Function ConvertByteArray2HexString(arrByteArray)

        Dim i

        Dim strValue

        

        strValue = ""

        

        For i = 1 To LenB(arrByteArray)

                strValue = strValue & Right("00" & Hex(AscB(MidB(arrByteArray, i, 1))), 2)

        Next

        

        ConvertByteArray2HexString = strValue

End Function

'=============================================================================

Подразумевается, что в ярлыке задан TrueType шрифт.

Iska	03-08-2011 08:14 1724971

Для cmd, ежели кто восхочет реализовать:
1. Найти в файле ярлыка сигнатуру из восьми байт «CC 00 00 00 02 00 00 A0». Если она найдена — значит в ярлыке наличествует секция «ConsoleDataBlock».
2. От начала найденной сигнатуры отсчитать (8+24+3) байта: размер самой сигнатуры (8 байт) плюс смещение внутри секции поля «FontSize» после сигнатуры (24 байта) плюс смещение нужного байта внутри поля; размер самого поля «FontSize» — четыре байта, нас, для TrueType шрифта, интересует 2-й байт

3. Для байта, полученному по этому смещению, задать потребный размер TrueType шрифта.

Anton04

03-08-2011 10:02 1725016

Цитата:

Цитата Iska

Например, так: »

Я так понимаю, что .Write 28 это желаемый размер шрифта? А strLnkFileName = "E:\Песочница\0063\Far2.lnk" это путь к ярлыку?

Спасибо попробую и отпишусь.

P.S. А можно чтобы путь к ярлыку указывался вне скрипта? например чтоб можно было применить в cmd: my.vbs "%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk"

Iska	03-08-2011 12:06 1725106

Цитата:

Цитата Anton04

Я так понимаю, что .Write 28 это желаемый размер шрифта? »

Да.

Цитата:

Цитата Anton04

А strLnkFileName = "E:\Песочница\0063\Far2.lnk" это путь к ярлыку? »

Да, но эта строка в скрипте закомментирована:

Код:

'strLnkFileName = "E:\Песочница\0063\Far2.lnk"

Была оставлена «на пробу». А так путь к ярлыку берётся из первого параметра скрипта:

Код:

strLnkFileName = WScript.Arguments.Item(0)

Т.е., в командной строке можно вызывать именно так, как Вы написали:

Цитата:

Цитата Anton04

чтоб можно было применить в cmd: my.vbs "%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" »

Anton04, Вы хотите менять размер шрифта в ярлыке сразу после установки Far Manager'а?

Anton04

03-08-2011 13:12 1725162

Цитата:

Цитата Iska

Вы хотите менять размер шрифта в ярлыке сразу после установки Far Manager'а? »

Да конечно. А что это разве что-то меняет!? Я выбрал Фар как наиболее яркий пример...

P.S. Всё работает спасибо. Правда за-комментировал строку создания bak файла, т.к. мне не к чему.

Iska	03-08-2011 16:58 1725347

Anton04, я не уверен, но, помнится, сразу после установки Far Manager'а в ярлыке указан растровый, не TrueType, шрифт. Скрипт надо будет менять.

Цитата:

Цитата Anton04

комментировал строку создания bak файла, т.к. мне не к чему. »

На всякий случай: вдруг где что у меня не так ;).

Anton04

31-08-2011 16:09 1743339

Iska,

Так, посмотрел, чё-то не нравится мне этот шрифт "Lucida Console" хочу "Точечные шрифты" и размером 10х18.
Поможете реализовать?

Iska	31-08-2011 18:22 1743424

Anton04, я попробую почитать документацию на эту тему в ближайшие пару дней.

P.S. Я предпочитаю Consolas из последних версий Windows 7. Помнится, вроде как его можно получить с сайта Microsoft и сравнительно честно пользовать и под старыми ОС. Не пробовали?

Anton04

01-09-2011 11:09 1743890

Вложений: 1

Цитата:

Цитата Iska

я попробую почитать документацию на эту тему в ближайшие пару дней. »

Буду ждать. Спасибо.

Цитата:

Цитата Iska

Я предпочитаю Consolas из последних версий Windows 7. Помнится, вроде как его можно получить с сайта Microsoft и сравнительно честно пользовать и под старыми ОС. Не пробовали? »

Посмотрел, но он тоже не очень, больно режет глаз, я даже скриншот сделал для сравнения (в верху точечный в низу Consolas).

Iska	03-09-2011 09:09 1745154

Цитата:

Цитата Anton04

хочу "Точечные шрифты" и размером 10х18. »

Anton04, посмотрел. Примерно так:

Код:

Option Explicit



Const SSFMOpenReadWrite = 1



Const strConsoleDataBlockSignature = "CC000000020000A0"

Const lngFontSizePosition          = 24





Dim objFSO

Dim objSpeechFileStream



Dim strLnkFileName

Dim lngConsoleDataBlockPosition



Dim arrContent



Dim byteValue

Dim strFontName

Dim i



'strLnkFileName = "E:\Песочница\0063\Far2.lnk"

strLnkFileName = WScript.Arguments.Item(0)



Set objFSO                = WScript.CreateObject("Scripting.FileSystemObject")

Set objSpeechFileStream   = WScript.CreateObject("SAPI.spFileStream")



With objFSO

        If .FileExists(strLnkFileName) Then

                If UCase(.GetExtensionName(strLnkFileName)) = UCase("lnk") Then

                        .GetFile(strLnkFileName).Copy strLnkFileName & ".bak", True

                        

                        With objSpeechFileStream

                                .Open strLnkFileName, SSFMOpenReadWrite

                                .Read arrContent, objFSO.GetFile(strLnkFileName).Size

                                

                                lngConsoleDataBlockPosition = InStr(ConvertByteArray2HexString(arrContent), strConsoleDataBlockSignature)

                                

                                If lngConsoleDataBlockPosition <> 0 Then

                                        .Seek lngConsoleDataBlockPosition \ 2 + Len(strConsoleDataBlockSignature) / 2 + lngFontSizePosition

                                        

                                        ' FontSize: 10x18

                                        .Write CByte(&H0A)

                                        .Write CByte(&H00)

                                        .Write CByte(&H12)

                                        .Write CByte(&H00)

                                        

                                        ' FontFamily: FF_MODERN

                                        .Write CByte(&H30)

                                        .Write CByte(&H00)

                                        .Write CByte(&H00)

                                        .Write CByte(&H00)

                                        

                                        ' FontWeight: 400

                                        .Write CByte(&H90)

                                        .Write CByte(&H01)

                                        .Write CByte(&H00)

                                        .Write CByte(&H00)

                                        

                                        ' Face Name: Terminal

                                        strFontName = Left("Terminal" & String(32, Chr(0)), 32)

                                        

                                        For i = 1 To Len(strFontName)

                                                .Write Asc(Mid(strFontName, i, 1))

                                        Next

                                Else

                                        WScript.Echo "Can't find ConsoleDataBlock section in [" & strLnkFileName & "]"

                                End If

                                

                                .Close()

                        End With

                Else

                        WScript.Echo "File [" & strLnkFileName & "] is not *.lnk file"

                End If

        Else

                WScript.Echo "File [" & strLnkFileName & "] not found"

        End If

End With



Set objSpeechFileStream   = Nothing

Set objFSO                = Nothing



WScript.Quit 0

'=============================================================================



'=============================================================================

Function ConvertByteArray2HexString(arrByteArray)

        Dim i

        Dim strValue

        

        strValue = ""

        

        For i = 1 To LenB(arrByteArray)

                strValue = strValue & Right("00" & Hex(AscB(MidB(arrByteArray, i, 1))), 2)

        Next

        

        ConvertByteArray2HexString = strValue

End Function

'=============================================================================

Anton04

05-09-2011 10:49 1746433

Iska,

Так всё хорошо, но вот если неизвестно какой размер и тип шрифта установлен, а известно какой хочется чтоб был, как тогда быть!?

Iska	05-09-2011 11:05 1746442

Цитата:

Цитата Anton04

Так всё хорошо, но вот если неизвестно какой размер и тип шрифта установлен, а известно какой хочется чтоб был, как тогда быть!? »

Поясните Ваш вопрос. Я не понял.

Anton04

05-09-2011 11:21 1746452

Iska,

Ну вот данный скрипт мы натравливали на ярлык фара после его установки, где было заранее известно какой размер шрифта установлен (в нашем примере это 24). А теперь представим ситуацию когда размер этого шрифта (да и тип Consolas, Lucida Console или Точечный шрифт) неизвестен, т.е. какой размер или тип шрифта неясен (ну изменили на какой-то и всё тут). А вот какой поставить хочется мы знаем.
Можно же реализовать это в скрипте?

P.S. Конечно универсальней было бы, если бы все параметры прописывались в командной строке при запуске скрипта, ну типа: my.vbs 10х18 "Точечный шрифт"%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" или my.vbs 28 "Lucida Console"%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" ну и т.п.

Iska	05-09-2011 13:09 1746515

Anton04, так и есть. Какой размер хотите — такой и ставьте, какой шрифт хотите — такой и пишите. В роли «точечного шрифта» в Windows выступает шрифт Terminal. Есть определённые ограничения на использование шрифтов для консольных приложений, но не более того.

Цитата:

Цитата Anton04

Ну вот данный скрипт мы натравливали на ярлык фара после его установки, где было заранее известно какой размер шрифта установлен (в нашем примере это 24).

Без разницы, какой до этого был задан шрифт и размер в ярлыке.

Цитата:

Цитата Anton04

А вот какой поставить хочется мы знаем. Можно же реализовать это в скрипте? »

Именно это и было выше сделано. Что не так?

Anton04

05-09-2011 13:24 1746527

Iska,

А всё увидел, не заметил Terminal... :tomato2:

Но всё же по поводу универсальности

Цитата:

Цитата Anton04

P.S. Конечно универсальней было бы, если бы все параметры прописывались в командной строке при запуске скрипта, ну типа: my.vbs 10х18 "Точечный шрифт"%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" или my.vbs 28 "Lucida Console"%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" ну и т.п. »

может реализуем!? ;)

Iska	05-09-2011 14:21 1746576

Цитата:

Цитата Anton04

может реализуем!? »

Конечно, можно. А смысл? Сколько нынче осталось консольных приложений, для которых нужны ярлыки с уникальными настройками шрифтов? Навскидку я кроме Far Manager'а ничего не припомню, где бы такое реально требовалось.

Что скажете?

Anton04

05-09-2011 14:50 1746593

Цитата:

Цитата Iska

Конечно, можно. А смысл? Сколько нынче осталось консольных приложений, для которых нужны ярлыки с уникальными настройками шрифтов? »

Это то конечно да их действительно не много, просто хотелось универсальности вдруг где ещё пригодится. Запас карман не тянет... ;) :Beer:

Iska	05-09-2011 16:45 1746678

Если делать такой вариант — нужно будет предусмотреть обработку аргументов, включая требование непротиворечивости, корректности, достаточности и т.п. Т.е., уметь обрабатывать все возможные ошибочные ситуации с аргументами. Размер скрипта вырастет втрое.

Другое дело, если, допустим, взяться и нарисовать компонент (хотя бы и *.wsc), который будет всем этим заниматься, отслеживать и обрабатывать — тогда другое дело. Мне вот, допустим, хотелось бы внедрять в ярлык Far Manager'а ту палитру цветов, которая была характерна для Windows 9x (вместо нынешней), ибо править палитру цветов самим редактором ярлыков — это натуральный мазохизм.

Anton04

06-09-2011 13:50 1747314

Цитата:

Цитата Iska

Всё понял, не оправдано и не перспективно... Ещё раз спасибо Iska :Beer:

Тему закрываю....

Iska	06-09-2011 16:53 1747445

2Anton04: да, это исключительно вопрос такого характера — стоит ли овчинка выделки.

Время: 05:13.