winrar制作自解压，一键自动安装字体

问题：安装字体时要打开，然后点击"安装"按钮。麻烦！

提问：可否有一键安装字体的方法？

答案：有。需要用到一个vbs文件。

下面是方法：

1. 复制脚本（脚本在文章最下面），黏贴到txt文件，然后改后缀为.vbs。如：font.vbs

2. 然后把需要安装的字体放到vbs文件同一个目录下。如图：
   

3. 使用winrar自解压功能制作安装包。主要是用到了打开“常规”选项卡，勾选“压缩选项”中的“创建自解压格式压缩文件”项，形成exe文件。
   
   
   

4. 这样就可以直接运行exe文件安装了。

vbs脚本如下：

' ScriptCryptor Project Options Begin
' HasVersionInfo: No
' Companyname: 
' Productname: 
' Filedescription: 
' Copyrights: 
' Trademarks: 
' Originalname: 
' Comments: 
' Productversion:  0. 0. 0. 0
' Fileversion:  0. 0. 0. 0
' Internalname: 
' Appicon: 
' AdministratorManifest: Yes
' Embeddedfile: AdobeFangsongStd-Regular.otf
' Embeddedfile: AdobeMingStd-Light.otf
' ScriptCryptor Project Options End
'
' File Description : VBScript Windows Fonts Installer
'

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, objOperationSys