如何使用BAT批处理和VBScript批量安装字体脚本

这篇文章主要介绍“如何使用BAT批处理和VBScript批量安装字体脚本”，在日常操作中，相信很多人在如何使用BAT批处理和VBScript批量安装字体脚本问题上存在疑惑，小编查阅了各式资料，整理出简单好用的操作方法，希望对大家解答”如何使用BAT批处理和VBScript批量安装字体脚本”的疑惑有所帮助！接下来，请跟着小编一起来学习吧！

根据新系统要求，经常要部署一些原来系统里没有的字体，原先我为了图省事经常会要求用户手动安装字体文件，虽然Windows的易用性做得相当不错，但是仍然要照顾一些不会安装字体的人，其实把这些字体打包进安装包更为方便，不过我觉得总不能每有新字体都要搞个安装包那么麻烦吧。更重要的是仍然有人会问我字体怎么安装，以前清一色的Windows XP系统，我倒也方便，直接告知打开控制面板找到字体文件夹，把要安装的字体拖进去即可；现在有Windows 7还是Windows 8等各种版本Windows系统，对于安装字体这个小小操作我也开始分情况讨论了。

使用特殊文件夹或者DESKTOP.INI方法

使用特殊文件夹方法Windows保留了一种特殊文件夹引用，比如在Windows XP的情况下，新建一个文件夹，然后在文件夹重命名后缀.{645FF040-5081-101B-9F08-00AA002F954E}（注意以点号分隔），然后这个文件夹就变成了回收站的一个引用，当我们点击进去的时候实际上进去的是回收站。

好了我在想对于字体是不是也可以搞个文件夹引用，这样直接叫用户把要安装的字体拖进去即可，大家注意到这个成功的关键在于后面那段长长的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是{D20EA4E1-3957-11d2-A40B-0C5020524152}，但是当我新建一个文件夹并且名称以.{D20EA4E1-3957-11d2-A40B-0C5020524152}（注意点号）结尾，当我点进去时却不能进入字体文件夹，于是这个想法被验证为失败。

使用Desktop.ini方法

其实建立特殊文件夹还有一个方法就是采用文件夹的Desktop.ini，抱着试试的心态，我在文件夹内部建立了Desktop.ini，内容如下：

复制代码 代码如下:

[.ShellClassInfo]IconFile=%SystemRoot%\system32\SHELL32.dllIconIndex=38CLSID={D20EA4E1-3957-11d2-A40B-0C5020524152}

很遗憾，依然不能直达字体目录，所以这一种办法也是行不通的。

本着方便群众的想法，我决定做个小小的程序，当然我首先求助了万能的Google。原本想搞个桌面程序来着，也找到老外现成的代码FontReg – Windows Font Registration & Installation Utility。后来随着研究的深入，突然发现这玩意儿用批处理或者脚本实现更为简单。

CMD或BAT批处理安装字体

通常情况下字体文件夹位于C:\Windows\Fonts，转换为带环境变量的通用版本为%SystemRoot%\Fonts\，我们也许想当然的认为将字体复制到这个路径下就完成了安装，其实不然，系统安装字体不单单是将字体文件复制到这个路径下，其还进行了其他操作，比如更新注册表字体列表。通常情况下这个列表位于路径如下：

复制代码 代码如下:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts

于是对于批处理来说，网上安装字体流程大概分为两派，首先第一步复制到Fonts文件夹，这个是公认的，第二步则有不同：一派认为应该更新注册表；另一派则倾向于使用AddFontResource这个函数。

使用AddFontResource更新系统字体列表

什么是AddFontResource函数？这是个Win32 API函数，位于gdi32.dll动态链接库上，MSDN参考见这里。我们可以编译调用这个函数，什么？“编译”？貌似和这里讲的批处理差远了吧，别急，好在这个函数签名不复杂，其有个AddFontResourceA的ANSI版本，这样给我们直接外部通过rundll32调用提供了可能，例如下面的代码片段：

复制代码 代码如下:

rundll32.exe gdi32.dll,AddFontResourceA %SystemRoot%\Fonts\字体.ttf

具体的代码如下（来源不详，将该批处理和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》这个帖子，找到下面的代码：

@ECHOOFF
TITLEAddingFonts..
REMFilename:ADD_Fonts.cmd
REMScripttoADDTrueTypeandOpenTypeFontsforWindows
REMByIslamAdel
REM2012-01-16

REMHowtouse:
REMPlacethebatchfileinsidethefolderofthefontfilesOR:
REMOptionalAddsourcefolderasparameterwithendingbackslashanddontusequotes,spacesareallowed
REMexample"ADD_fonts.cmd"C:\Folder1\Folder2\

IFNOT"%*"==""SETSRC=%*
ECHO.
ECHOAddingFonts..
ECHO.
FOR/F%%iin('dir/b"%SRC%*.*tf"')DOCALL:FONT%%i
REMOPTIONALREBOOT
REMshutdown-r-f-t10-c"RebootrequiredforFontsinstallation"
ECHO.
ECHODone!
PAUSE
EXIT

:FONT
ECHO.
REMECHOFILE=%~f1
SETFFILE=%~n1%~x1
SETFNAME=%~n1
SETFNAME=%FNAME:-=%
IF"%~x1"==".otf"SETFTYPE=(OpenType)
IF"%~x1"==".ttf"SETFTYPE=(TrueType)

ECHOFILE=%FFILE%
ECHONAME=%FNAME%
ECHOTYPE=%FTYPE%

COPY/Y"%SRC%%~n1%~x1""%SystemRoot%\Fonts\"
regadd"HKLM\SOFTWARE\Microsoft\WindowsNT\CurrentVersion\Fonts"/v"%FNAME%%FTYPE%"/tREG_SZ/d"%FFILE%"/f
GOTO:EOF

仔细阅读代码后发现，这段批处理在复制字体并更新注册表后居然要重启电脑(汗~)，这种做法显然对最终用户不太友好，综合以上我决定放弃批处理的方式安装字体。

使用VBSCRIPT安装字体

最后我还是干回老本行，使用VBScript脚本来实现这个功能。脚本的重点是采用Shell.ApplicationActiveX/COM对象实现复制到系统特殊文件夹下，实际上这个操作和用户手动复制到字体文件夹下一样，系统会自动为我们安装字体而不需要我们顾及注册表更新的问题，对于Vista及更高版本的系统来说，我参考了《The true ultimate font install for Windows 7 and XP vbs》的做法，使用.InvokeVerb("Install")直接调用字体文件对象的安装命令。

详细的代码如下（请复制的朋友手下留情，保留版权信息，谢谢）：

复制代码 代码如下:

'' 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 ExplicitConst FONTS = &H14&Const HKEY_LOCAL_MACHINE = &H80000002Const strComputer = "." Const SHELL_MY_COMPUTER = &H11Const SHELL_WINDOW_HANDLE = 0Const SHELL_OPTIONS = 0Function 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 = NothingEnd FunctionFunction 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 = NothingEnd FunctionClass 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 SubEnd ClassSub 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 IfEnd SubSub 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 vbCrLfEnd SubSub Pause(strPause) WScript.Echo (strPause) WScript.StdIn.Read(1)End SubFunction 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 FunctionWScript.Quit(VBMain(WScript.Arguments))

这个脚本的使用方法很简单，将上述代码保存为VBS文件，然后将要安装的字体或者包含字体的文件夹拖放到这个脚本文件即可，还有个方法就是直接双击脚本，然后按照提示会自动安装与脚本同路径的字体文件或者提示选择字体所在路径以便于安装。

还有一处值得注意的是：我对已经安装的字体是采取建立字体列表，然后判断当前安装的字体是否存在于字体列表，字体列表的来源是已经安装的字体在系统的注册名（存在于注册表中）和已经安装的字体文件名。唯一遗憾的是我是通过比判断安装字体的文件名是否在字体列表中来判断字体是否安装，这里的问题主要是待安装的字体文件名不一定与字体真实的名字一致，字体真实的名字是需要读取二进制字体文件从中来获取的，这样脚本又复杂了，所以放弃了这种方式。

到此，关于“如何使用BAT批处理和VBScript批量安装字体脚本”的学习就结束了，希望能够解决大家的疑惑。理论与实践的搭配能更好的帮助大家学习，快去试试吧！若想继续学习更多相关知识，请继续关注恰卡编程网网站，小编会继续努力为大家带来更多实用的文章！