中文字幕免费精品_亚洲视频自拍_亚洲综合国产激情另类一区_色综合咪咪久久

這篇文章主要介紹了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.dll

IconIndex=38

CLSID={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》這個帖子，找到下面的代碼：

@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

仔細閱讀代碼后發現，這段批處理在復制字體并更新注冊表后居然要重啟電腦(汗~)，這種做法顯然對最終用戶不太友好，綜合以上我決定放棄批處理的方式安裝字體。

使用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 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","http://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文件，然后將要安裝的字體或者包含字體的文件夾拖放到這個腳本文件即可，還有個方法就是直接雙擊腳本，然后按照提示會自動安裝與腳本同路徑的字體文件或者提示選擇字體所在路徑以便于安裝。

還有一處值得注意的是：我對已經安裝的字體是采取建立字體列表，然后判斷當前安裝的字體是否存在于字體列表，字體列表的來源是已經安裝的字體在系統的注冊名（存在于注冊表中）和已經安裝的字體文件名。唯一遺憾的是我是通過比判斷安裝字體的文件名是否在字體列表中來判斷字體是否安裝，這里的問題主要是待安裝的字體文件名不一定與字體真實的名字一致，字體真實的名字是需要讀取二進制字體文件從中來獲取的，這樣腳本又復雜了，所以放棄了這種方式。