[Iska]

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

читать дальше »

Код:

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 шрифт.