Cистемная установка выбранных шрифтов

'•••••••••••••••••••••••••••••••••••••••••••••••
' Установка выбранных в панели шрифтов в систему
' Параметр: %WL
'•••••••••••••••••••••••••• Автор: Flasher © •••

If WScript.Arguments.Count = 0 Then WScript.Quit
Exts = "|chr|fnt|fon|fot|mmm|otf|ttf|ttc|pfm|pfb|"
Dim WSH : Set WSH = CreateObject("WScript.Shell")
Set Dict = CreateObject("Scripting.Dictionary")
Set ShAp = CreateObject("Shell.Application")
Fonts = WSH.SpecialFolders("Fonts") & "\"
Set oFonts = ShAp.NameSpace(&H14)
Title = "   Установка шрифтов"
With CreateObject("Scripting.FileSystemObject")
  Set File = .OpenTextFile(WScript.Arguments(0),,,-1)
  Do : F = File.ReadLine : FN = .GetFileName(F) : Ext = .GetExtensionName(F)
    If .FileExists(F) And InStr(Exts, "|" & LCase(Ext & "|")) Then
      PF = .GetParentFolderName(F) : BN = .GetBaseName(F) : C = 1
      Font = ShAp.NameSpace(PF).ParseName(FN).ExtendedProperty("DocTitle")
      If .FileExists(Fonts & FN) Then
        If Font = oFonts.ParseName(FN).ExtendedProperty("DocTitle") Then C = 0
      ElseIf Left(Right(BN, 2), 1) = "_" And InStr("abcdef", LCase(Right(BN, 1))) Then
        For i = 0 To 20
          FName = Left(BN, Len(BN) - 1) & i & "." & Ext
          If .FileExists(Fonts & FName) Then
            With oFonts.Items .Filter 73920, Font & "*"
              If .Count Then C = 0 : Exit For
            End With
          Else Exit For End If
        Next
      End If
      If C Then
        T = T + 1 : FNames = FNames & Font & vbCr
        If Dict.Exists(PF) Then FN = Dict.Item(PF) & ";" & FN
        Dict.Item(PF) = FN
      End If
    End If
  Loop Until File.AtEndOfStream : File.Close
End With
If C Then
  For Each Key in Dict.Keys
    Set Items = ShAp.NameSpace(Key).Items
    Items.Filter 73920, Dict(Key)
    oFonts.CopyHere Items
  Next : Dict.RemoveAll
End If : PFix2 = " " : If T > 1 Then PFix1 = "ы" : PFix2 = "ы:" & vbCr
If T Then  WSH.Popup "Установлен" & PFix1 & " шрифт" & PFix2 & FNames, 5, _
Title Else WSH.Popup "Отсутствующие в системе шрифты не выбраны!", 3, Title