BATバッチ処理、VBScript一括インストールフォントスクリプト共有
22698 ワード
新しいシステムの要求によって、元のシステムにはないフォントがよく配置されています。もともとは図を作るために、ユーザーにマニュアルでフォントファイルをインストールするように要求していました。Windowsの使いやすさはかなりいいですが、まだフォントがインストールできない人の世話をしています。でも、新しいフォントがあるたびに、インストールパッケージを作るのはちょっと無理だと思います。もっと重要なのは、まだフォントはどうやってインストールするかという人がいます。以前は同じ色のWindows XPシステムで、私も便利です。直接にコントロールパネルを開けてフォントフォルダを見つけたら、インストールするフォントをドラッグしてもいいです。Windows 7やWindows 8などの各バージョンのWindowsシステムがありますが、インストールフォントという小さな操作についても状況を分けて議論し始めました。
特殊フォルダまたはDESKTOP.INIメソッドを使う
特殊フォルダの使い方
WindowsはWindows XPの場合などの特殊なフォルダ参照を保持しています。フォルダを新規作成し、拡張子をフォルダに名前を変更します。
はい、フォントに対してもフォルダを引用してもいいですか?ユーザーに直接にインストールするフォントをドラッグしてもらえばいいです。この成功の鍵は後ろの長いID番号です。その学名はGUIDといいます。通常はレジストリで調べられます。
Desktop.iniメソッドを使う
実は特殊なフォルダを作る方法はもう一つあります。フォルダのDesktop.iniを採用して、試してみる気持ちを持って、私はフォルダ内にDesktop.iniを創立しました。内容は以下の通りです。
大衆の便利さを考えて、小さな手順を作ることにしました。もちろん、まず万能のGoogleに助けを求めました。デスクトッププログラムを作りたいですが、既存のコードFontReg C Windows Font Registration&Installation Utilityも見つけました。その後、研究が進むにつれて、このおもちゃはバッチやシナリオでより簡単に実現されることが分かりました。
CMDまたはBATバッチ処理インストールフォント
通常のフォントフォルダはC:\Windows\Fontsに位置しています。環境変数付きの汎用バージョンは%SystemRoot%\Fontsに変換します。もちろん、フォントをこのパスにコピーするとインストールが完了すると思うかもしれません。そうではないです。システムインストールフォントは単にワードファイルをこのパスにコピーするだけでなく、他の操作も行われています。レジストリのフォントリストを更新します。通常、このリストはパスの下にあります。
AddFontResourceを使ってシステムフォントリストを更新します。
何がAddFontResource関数ですか?これはWin 32 API関数で、gdi 32.dllダイナミックリンクライブラリにあります。MSDNはここを参照してください。この関数をコンパイルして呼び出すことができます。何ですか?コンパイル?ここで説明したバッチ処理とはだいぶ違っているようです。急がないでください。幸い、この関数の署名は複雑ではないです。AddFontResourceAのANSIバージョンがあります。このように直接外部にrundll 32コールを通して可能性を提供します。例えば、下記のコードセグメント:
システムフォントリストをレジストリで更新します。
「Windows 7:Installing fonts via command line/script」というスレッドを参照して、下記のコードを見つけました。
VSCRIPTを使ってフォントをインストールします。
最後に私はやはり古い本業に帰ります。VB Scriptスクリプトを使ってこの機能を実現します。スクリプトの重点はShell.Application ActiveX/COMオブジェクトを使ってシステム特殊フォルダにコピーすることです。実際にはこの操作はユーザーがマニュアルでフォントフォルダにコピーしたのと同じです。システムは自動的にフォントをインストールしてくれます。レジストリの更新を考慮する必要はありません。Vistaおよびより高いバージョンのシステムについては、「The true ultimate font install for Windows 7 and XP vbs」のやり方を参考しました。を使用して、フォントファイルオブジェクトのインストールコマンドを直接呼び出します。
詳しいコードは以下の通りです。
もう一つの注意すべき点は、既にインストールされているフォントに対してフォントリストを作成し、現在インストールされているフォントがフォントリストに存在するかどうかを判断することです。フォントリストのソースは、システムの登録名(レジストリに存在する)とインストール済みのフォントファイル名です。唯一の残念なことに、インストールフォントのファイル名がフォントリストにあるかどうかを判断することにより、フォントがインストールされているかを判断します。ここの問題は主にインストールされているフォントファイル名がフォントの名前と一致するとは限らず、フォントの本当の名前はバイナリフォントファイルを読み込む必要があります。
特殊フォルダまたはDESKTOP.INIメソッドを使う
特殊フォルダの使い方
WindowsはWindows XPの場合などの特殊なフォルダ参照を保持しています。フォルダを新規作成し、拡張子をフォルダに名前を変更します。
はい、フォントに対してもフォルダを引用してもいいですか?ユーザーに直接にインストールするフォントをドラッグしてもらえばいいです。この成功の鍵は後ろの長いID番号です。その学名はGUIDといいます。通常はレジストリで調べられます。
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer
たとえば、ごみ箱は下のレジストリのパスにあります。
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace
フォントについても次のような経路で見つけました。
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ControlPanel\NameSpace
フォントのGUIDは{D 20 EA 4 E 1-357-11 d 2-A 40 B-0 C 502045152}ですが、フォルダを新規作成して名前を付けます。Desktop.iniメソッドを使う
実は特殊なフォルダを作る方法はもう一つあります。フォルダのDesktop.iniを採用して、試してみる気持ちを持って、私はフォルダ内にDesktop.iniを創立しました。内容は以下の通りです。
[.ShellClassInfo]
IconFile=%SystemRoot%\system32\SHELL32.dll
IconIndex=38
CLSID={D20EA4E1-3957-11d2-A40B-0C5020524152}
残念ながら、まだフォントカタログに直通できないので、この方法は通用しません。大衆の便利さを考えて、小さな手順を作ることにしました。もちろん、まず万能のGoogleに助けを求めました。デスクトッププログラムを作りたいですが、既存のコードFontReg C Windows Font Registration&Installation Utilityも見つけました。その後、研究が進むにつれて、このおもちゃはバッチやシナリオでより簡単に実現されることが分かりました。
CMDまたはBATバッチ処理インストールフォント
通常のフォントフォルダはC:\Windows\Fontsに位置しています。環境変数付きの汎用バージョンは%SystemRoot%\Fontsに変換します。もちろん、フォントをこのパスにコピーするとインストールが完了すると思うかもしれません。そうではないです。システムインストールフォントは単にワードファイルをこのパスにコピーするだけでなく、他の操作も行われています。レジストリのフォントリストを更新します。通常、このリストはパスの下にあります。
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts
そこで、バッチ処理にとって、オンラインでフォントをインストールするプロセスは大体2つに分かれています。まず第一歩はFontsフォルダにコピーします。これは公認されています。第二ステップは違います。一派はレジストリを更新すべきだと思います。もう一つの派はAddFontResourceという関数を使う傾向があります。AddFontResourceを使ってシステムフォントリストを更新します。
何がAddFontResource関数ですか?これはWin 32 API関数で、gdi 32.dllダイナミックリンクライブラリにあります。MSDNはここを参照してください。この関数をコンパイルして呼び出すことができます。何ですか?コンパイル?ここで説明したバッチ処理とはだいぶ違っているようです。急がないでください。幸い、この関数の署名は複雑ではないです。AddFontResourceAのANSIバージョンがあります。このように直接外部にrundll 32コールを通して可能性を提供します。例えば、下記のコードセグメント:
rundll32.exe gdi32.dll,AddFontResourceA %SystemRoot%\Fonts\ .ttf
具体的なコードは以下の通りです。
for /f %%a in ('dir /x /b *.ttf') do (
dir %windir%fonts%%a>nul 2>nul||(copy %%a %windir%fonts>nul 2>nul&rundll32.exe gdi32.dll,AddFontResourceA %windir%fonts%%a)
)
実際の操作から見ると、このコードは私のパソコンでは何の効果もありません。システムフォントリストをレジストリで更新します。
「Windows 7:Installing fonts via command line/script」というスレッドを参照して、下記のコードを見つけました。
@ECHO OFF
TITLE Adding Fonts..
REM Filename: ADD_Fonts.cmd
REM Script to ADD TrueType and OpenType Fonts for Windows
REM By Islam Adel
REM 2012-01-16
REM How to use:
REM Place the batch file inside the folder of the font files OR:
REM Optional Add source folder as parameter with ending backslash and dont use quotes, spaces are allowed
REM example "ADD_fonts.cmd" C:\Folder 1\Folder 2\
IF NOT "%*"=="" SET SRC=%*
ECHO.
ECHO Adding Fonts..
ECHO.
FOR /F %%i in ('dir /b "%SRC%*.*tf"') DO CALL :FONT %%i
REM OPTIONAL REBOOT
REM shutdown -r -f -t 10 -c "Reboot required for Fonts installation"
ECHO.
ECHO Done!
PAUSE
EXIT
:FONT
ECHO.
REM ECHO FILE=%~f1
SET FFILE=%~n1%~x1
SET FNAME=%~n1
SET FNAME=%FNAME:-= %
IF "%~x1"==".otf" SET FTYPE=(OpenType)
IF "%~x1"==".ttf" SET FTYPE=(TrueType)
ECHO FILE=%FFILE%
ECHO NAME=%FNAME%
ECHO TYPE=%FTYPE%
COPY /Y "%SRC%%~n1%~x1" "%SystemRoot%\Fonts\"
reg add "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" /v "%FNAME% %FTYPE%" /t REG_SZ /d "%FFILE%" /f
GOTO :EOF
コードをよく読んでみたら、フォントをコピーしてレジストリを更新した後、パソコンを再起動します。このようなやり方は明らかに最終ユーザーにあまり友好的ではありません。以上を総合して、バッチ処理の方式を放棄してフォントをインストールすることにしました。VSCRIPTを使ってフォントをインストールします。
最後に私はやはり古い本業に帰ります。VB Scriptスクリプトを使ってこの機能を実現します。スクリプトの重点はShell.Application ActiveX/COMオブジェクトを使ってシステム特殊フォルダにコピーすることです。実際にはこの操作はユーザーがマニュアルでフォントフォルダにコピーしたのと同じです。システムは自動的にフォントをインストールしてくれます。レジストリの更新を考慮する必要はありません。Vistaおよびより高いバージョンのシステムについては、「The true ultimate font install for Windows 7 and XP vbs」のやり方を参考しました。を使用して、フォントファイルオブジェクトのインストールコマンドを直接呼び出します。
詳しいコードは以下の通りです。
'
' File Description : VBScript Windows Fonts Installer
'
' Copyright (c) 2012-2013 WangYe. All rights reserved.
'
' Author: WangYe
' This code is distributed under the BSD license
'
' Usage:
' Drag Font files or folder to this script
' or Double click this script file, It will install fonts on the current directory
' or select font directory to install
' *** ***
'
Option Explicit
Const FONTS = &H14&
Const HKEY_LOCAL_MACHINE = &H80000002
Const strComputer = "."
Const SHELL_MY_COMPUTER = &H11
Const SHELL_WINDOW_HANDLE = 0
Const SHELL_OPTIONS = 0
Function GetOpenDirectory(title)
Dim ShlApp,ShlFdr,ShlFdrItem
Set ShlApp = WSH.CreateObject("Shell.Application")
Set ShlFdr = ShlApp.Namespace(SHELL_MY_COMPUTER)
Set ShlFdrItem = ShlFdr.Self
GetOpenDirectory = ShlFdrItem.Path
Set ShlFdrItem = Nothing
Set ShlFdr = Nothing
Set ShlFdr = ShlApp.BrowseForFolder _
(SHELL_WINDOW_HANDLE, _
title, _
SHELL_OPTIONS, _
GetOpenDirectory)
If ShlFdr Is Nothing Then
GetOpenDirectory = ""
Else
Set ShlFdrItem = ShlFdr.Self
GetOpenDirectory = ShlFdrItem.Path
Set ShlFdrItem = Nothing
End If
Set ShlApp = Nothing
End Function
Function IsVista()
IsVista = False
Dim objWMIService, colOperationSystems, objOperationSystem
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperationSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objOperationSystem In colOperationSystems
If CInt(Left(objOperationSystem.Version, 1)) > 5 Then
IsVista = True
Exit Function
End If
Next
Set colOperationSystems = Nothing
Set objWMIService = Nothing
End Function
Class FontInstaller
Private objShell
Private objFolder
Private objRegistry
Private strKeyPath
Private objRegExp
Private objFileSystemObject
Private objDictFontFiles
Private objDictFontNames
Private pfnCallBack
Private blnIsVista
Public Property Get FileSystemObject
Set FileSystemObject = objFileSystemObject
End Property
Public Property Let CallBack(value)
pfnCallBack = value
End Property
Private Sub Class_Initialize()
strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Fonts"
Set objShell = CreateObject("Shell.Application")
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.Namespace(FONTS)
Set objDictFontFiles = CreateObject("Scripting.Dictionary")
Set objDictFontNames = CreateObject("Scripting.Dictionary")
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
Set objRegExp = New RegExp
objRegExp.Global = False
objRegExp.Pattern = "^([^\(]+) \(.+$"
blnIsVista = IsVista()
makeFontNameList
makeFontFileList
End Sub
Private Sub Class_Terminate()
Set objRegExp = Nothing
Set objRegistry = Nothing
Set objFolder = Nothing
objDictFontFiles.RemoveAll
Set objDictFontFiles = Nothing
objDictFontNames.RemoveAll
Set objDictFontNames = Nothing
Set objFileSystemObject = Nothing
Set objShell = Nothing
End Sub
Private Function GetFilenameWithoutExtension(ByVal FileName)
' http://social.technet.microsoft.com/Forums/en-US/ebe19301-541a-412b-8e89-08c4263cc60b/get-filename-without-extension
Dim Result, i
Result = FileName
i = InStrRev(FileName, ".")
If ( i > 0 ) Then
Result = Mid(FileName, 1, i - 1)
End If
GetFilenameWithoutExtension = Result
End Function
Private Sub makeFontNameList()
On Error Resume Next
Dim strValue,arrEntryNames
objRegistry.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrEntryNames
For Each strValue in arrEntryNames
objDictFontNames.Add objRegExp.Replace(strValue, "$1"), strValue
Next
If Err.Number<>0 Then Err.Clear
End Sub
Private Sub makeFontFileList()
On Error Resume Next
Dim objFolderItem,colItems,objItem
Set objFolderItem = objFolder.Self
'Wscript.Echo objFolderItem.Path
Set colItems = objFolder.Items
For Each objItem in colItems
objDictFontFiles.Add GetFilenameWithoutExtension(objItem.Name),objItem.Name
Next
Set colItems = Nothing
Set objFolderItem = Nothing
If Err.Number<>0 Then Err.Clear
End Sub
Function getBaseName(ByVal strFileName)
getBaseName = objFileSystemObject.GetBaseName(strFileName)
End Function
Public Function PathAddBackslash(strFileName)
PathAddBackslash = strFileName
If objFileSystemObject.FolderExists(strFileName) Then
Dim last
'
'
last = Right(strFileName, 1)
If last<>"\" And last<>"/" Then
PathAddBackslash = strFileName & "\"
End If
End If
End Function
Public Function isFontInstalled(ByVal strName)
isFontInstalled = objDictFontNames.Exists(strName) Or objDictFontFiles.Exists(strName)
End Function
Public Function isFontFileInstalled(ByVal strFileName)
isFontFileInstalled = isFontInstalled(objFileSystemObject.GetBaseName(strFileName))
End Function
Public Sub installFromFile(ByVal strFileName)
Dim strExtension, strBaseFileName, objCallBack, nResult
strBaseFileName = objFileSystemObject.GetBaseName(strFileName)
strExtension = UCase(objFileSystemObject.GetExtensionName(strFileName))
If Len(pfnCallBack) > 0 Then
Set objCallBack = GetRef(pfnCallBack)
Else
Set objCallBack = Nothing
End If
If strExtension = "TTF" Or strExtension = "TTC" Or strExtension = "OTF" Then
If Not isFontInstalled(strBaseFileName) Then
If blnIsVista Then
Dim objFont, objFontNameSpace
Set objFontNameSpace = objShell.Namespace(objFileSystemObject.GetParentFolderName(strFileName))
Set objFont = objFontNameSpace.ParseName(objFileSystemObject.GetFileName(strFileName))
'WSH.Echo objFileSystemObject.GetParentFolderName(strFileName)
objFont.InvokeVerb("Install")
Set objFont = Nothing
Set objFontNameSpace = Nothing
Else
'WSH.Echo strFileName
objFolder.CopyHere strFileName
End If
nResult = 0
Else
nResult = 1
End If
Else
nResult = -1
End If
If IsObject(objCallBack) Then
objCallBack Me, strFileName, nResult
Set objCallBack = Nothing
End If
End Sub
Public Sub installFromDirectory(ByVal strDirName)
Dim objFolder, colFiles, objFile
Set objFolder = objFileSystemObject.GetFolder(strDirName)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If objFile.Size > 0 Then
installFromFile PathAddBackslash(strDirName) & objFile.Name
End If
Next
Set colFiles = Nothing
Set objFolder = Nothing
End Sub
Public Sub setDragDrop(objArgs)
' http://msdn.microsoft.com/en-us/library/c488f3e0(v=vs.84).aspx
Dim i
For i = 0 to objArgs.Count - 1
If objFileSystemObject.FileExists(objArgs(i)) Then
installFromFile objArgs(i)
ElseIf objFileSystemObject.FolderExists(objArgs(i)) Then
installFromDirectory objArgs(i)
End If
Next
End Sub
End Class
Sub ForceCScriptExecution()
' https://stackoverflow.com/questions/4692542/force-a-vbs-to-run-using-cscript-instead-of-wscript
' http://www.winhelponline.com/articles/185/1/VBScripts-and-UAC-elevation.html
Dim Arg, Str
If Not LCase( Right( WScript.FullName, 12 ) ) = "\cscript.exe" Then
For Each Arg In WScript.Arguments
If InStr( Arg, " " ) Then Arg = """" & Arg & """"
Str = Str & " " & Arg
Next
If IsVista() Then
CreateObject( "Shell.Application" ).ShellExecute _
"cscript.exe","//nologo """ & _
WScript.ScriptFullName & _
""" " & Str, "", "runas", 1
Else
CreateObject( "WScript.Shell" ).Run _
"cscript //nologo """ & _
WScript.ScriptFullName & _
""" " & Str
End If
WScript.Quit
End If
End Sub
Sub DisplayMessage(ByRef objInstaller, ByVal strFileName, ByVal nResult)
WScript.StdOut.Write "Install " & objInstaller.getBaseName(strFileName) & " ->>> "
Select Case nResult
Case 0
WScript.StdOut.Write "SUCCEEDED"
Case 1
WScript.StdOut.Write "ALREADY INSTALLED"
Case -1
WScript.StdOut.Write "FAILED (Reason: Not a Font File)"
End Select
WScript.StdOut.Write vbCrLf
End Sub
Sub Pause(strPause)
WScript.Echo (strPause)
WScript.StdIn.Read(1)
End Sub
Function VBMain(colArguments)
VBMain = 0
ForceCScriptExecution()
WSH.Echo "Easy Font Installer 1.0" & vbCrLf &_
"Written By WangYe " & vbCrLf & vbCrLf
Dim objInstaller, objFso, objDictFontFiles
Set objInstaller = New FontInstaller
objInstaller.CallBack = "DisplayMessage"
If colArguments.Count > 0 Then
objInstaller.setDragDrop colArguments
Else
Set objFso = objInstaller.FileSystemObject
Set objDictFontFiles = CreateObject("Scripting.Dictionary")
Dim objFolder, colFiles, objFile, strDirName, strExtension
strDirName = objFso.GetParentFolderName(WScript.ScriptFullName)
Set objFolder = objFso.GetFolder(strDirName)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If objFile.Size > 0 Then
strExtension = UCase(objFso.GetExtensionName(objFile.Name))
If strExtension = "TTF" Or strExtension = "TTC" Or strExtension = "OTF" Then
objDictFontFiles.Add objFile.Name, objInstaller.PathAddBackslash(strDirName) & objFile.Name
End If
End If
Next
Set colFiles = Nothing
Set objFolder = Nothing
Set objFso = Nothing
If objDictFontFiles.Count > 0 Then
If MsgBox("Current Directory has " & objDictFontFiles.Count & " Font Files." & vbCrLf &_
vbCrLf & "Click OK to continue install or Cancel to Select Directory", 1) = 1 Then
Dim i, objItems
For i = 0 To objDictFontFiles.Count-1
objItems = objDictFontFiles.Items
objInstaller.installFromFile objItems(i)
Next
Else
strDirName = GetOpenDirectory("Select Fonts Directory:")
If strDirName<>"" Then
objInstaller.installFromDirectory strDirName
Else
WScript.Echo "----- Drag Font File To This Script -----"
End If
End If
End If
objDictFontFiles.RemoveAll
Set objDictFontFiles = Nothing
End If
Set objInstaller = Nothing
Pause vbCrLf & vbCrLf & "Press Enter to continue"
End Function
WScript.Quit(VBMain(WScript.Arguments))
このスクリプトの使い方は簡単で、上記のコードをVBSファイルに保存し、インストールするフォントやフォントを含むフォルダをこのスクリプトファイルにドラッグして置くだけでいいです。また、スクリプトを直接ダブルクリックして、ヒントに従って自動的にスクリプトと同じパスのフォントファイルをインストールしたり、フォントの場所を選択してインストールしやすくする方法もあります。もう一つの注意すべき点は、既にインストールされているフォントに対してフォントリストを作成し、現在インストールされているフォントがフォントリストに存在するかどうかを判断することです。フォントリストのソースは、システムの登録名(レジストリに存在する)とインストール済みのフォントファイル名です。唯一の残念なことに、インストールフォントのファイル名がフォントリストにあるかどうかを判断することにより、フォントがインストールされているかを判断します。ここの問題は主にインストールされているフォントファイル名がフォントの名前と一致するとは限らず、フォントの本当の名前はバイナリフォントファイルを読み込む必要があります。