问题:安装字体时要打开,然后点击"安装"按钮。麻烦!
提问:可否有一键安装字体的方法?
答案:有。需要用到一个vbs文件。
下面是方法:
-
复制脚本(脚本在文章最下面),黏贴到txt文件,然后改后缀为.vbs。如:font.vbs
-
然后把需要安装的字体放到vbs文件同一个目录下。如图:
-
使用winrar自解压功能制作安装包。主要是用到了打开“常规”选项卡,勾选“压缩选项”中的“创建自解压格式压缩文件”项,形成exe文件。
- 这样就可以直接运行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