[Iska]

хочу "Точечные шрифты" и размером 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]

Iska,

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

[Iska]

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

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

[Anton04]

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]

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

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

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

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

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

[Anton04]

Iska,

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

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

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

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

[Iska]

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

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

Что скажете?

[Anton04]

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

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

[Iska]

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

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

[Anton04]

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

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

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