au3怎样自动安装字体
au3怎样自动安装字体 这里有个例子,用的是复制字体文件到@WindowsDir \ "fonts"目录,再刷新注册表...好像有更好的办法,等叁恨来了告诉你...
谢谢，漠北雪~狼
;
InstallFonts('F:\tools\FONT\JQ20.TTF',"金桥繁魏碑")
Func InstallFonts($sSourceFile, $sFontDescription)
Local Const $HWND_BROADCAST = 0xFFFF
Local Const $WM_FONTCHANGE = 0x1D
Local $sFontFileName = StringRegExpReplace($sSourceFile, '^.*\\', '')
If Not FileCopy($sSourceFile, @WindowsDir & "\fonts\" & $sFontFileName, 1) Then Return SetError(1, 0, 0)
Local $aRet = DllCall("gdi32.dll", "Int", "AddFontResource", "str", @WindowsDir & "\fonts\" & $sFontFileName)
If IsArray($aRet) And $aRet > 0 Then
RegWrite("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", $sFontDescription, "REG_SZ", $sFontFileName)
DllCall("user32.dll", "Int", "SendMessage", "hwnd", $HWND_BROADCAST, "int", $WM_FONTCHANGE, "int", 0, "int", 0)
Return 1
EndIf
Return SetError(2, 0, 0)
EndFunc
谢谢，漠北雪~狼,谢谢叁恨居士！！ user用户需要提权使用吗？ 不错，用得着，标记一下，好好学习了 收藏了 以后用的着 用 Au3 结合微软的 FontInst 可实现真正全自动安装字体，经本人试验已取得成功！思路是：
① 先用 Au3 搜索脚本目录是否存在 TTF/TTC/FON 这三种字体，分别用了三个 While 循环， 将搜索结果用 IniWriteSection（）函数分别写入 FontInst 需要调用的 FontInst.Inf 安装信息中；
② 用 Au3 运行一下 FontInst.exe （速度很快哦），一下子就全都安装好了，且无需重启！
本人先前也曾修改过由 VBS 版的 FontReg.Vbs 来自动安装字体，同样无需重启，安装完毕即可使用，但缺点是受已安装字体影响，安装时总提示 已安装××字体，要重新安装，请先卸载旧版本… 感觉有些不爽，而调用 Microsoft FontInst 这个微软公司自己出的字体安装组件，就彻底解除了此限制，任您反复安装也不会提示，优点是速度超快、无需重启。
附源码（本人菜鸟，没有严密的安排代码的习惯，总是乱七八糟，各位将就看吧）：#Cs ＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
AutoIt 版本: 3.3.1.0 (第一版)
脚本作者:
Email:
QQ/TM:
脚本版本: 3.3.1.0
脚本功能: 试图自动安装当前目录所有字体
#Ce ＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
;脚本开始 请在这下面添加您的代码:
;********************** 声明全局变量 **********************
Global $FontList=@ScriptDir&'\FontInst.Inf'
Global $SearChTTF = FileFindFirstFile(@ScriptDir&'\*.TTF')
Global $SearChTTC = FileFindFirstFile(@ScriptDir&'\*.TTC')
Global $SearChFon = FileFindFirstFile(@ScriptDir&'\*.FON')
Global $FontName
Global $SearChFile
;----------------------------------------------------------
;================= 判断 FontList 文件 =====================
If FileExists($FontList) Then
FileSetAttrib($FontList,'-Rsh')
FileDelete($FontList)
EndIf
;----------------------------------------------------------
;================ 第 1 个 寻找 TTF 循环 ===================
While 1
If $SearChTTF<>-1 Then
$FontName=FileFindNextFile($SearChTTF)
EndIf
If $FontName<>'' Then
IniWriteSection($FontList,'Fonts',$FontName)
Else
ExitLoop
EndIf
WEnd
;----------------------------------------------------------
;================ 第 2 个 寻找 TTC 循环 ===================
_FindTTC()
Func _FindTTC()
While 1
If $SearChTTC<>-1 Then
$FontName=FileFindNextFile($SearChTTC)
EndIf
If $FontName<>'' Then
IniWriteSection($FontList,'Fonts',$FontName)
Else
ExitLoop
EndIf
WEnd
EndFunc
;----------------------------------------------------------
;================ 第 3 个 寻找 FON 循环 ===================
_FindFON()
Func _FindFON()
While 1
If $SearChFON<>-1 Then
$FontName=FileFindNextFile($SearChFON)
EndIf
If $FontName<>'' Then
IniWriteSection($FontList,'Fonts',$FontName)
Else
ExitLoop
EndIf
WEnd
EndFunc
FileSetAttrib($FontList,'+Rsh')
;----------------------------------------------------------
;================= 定义获取字体名的变量 ===================
$FontInfo=FileRead($FontList)
;----------------------------------------------------------
;======================= 根据定制的字体名变量判断当前目录是否确实存在符合如下类型字体文件 =========================
If Not StringInStr($FontInfo,'TTF') And Not StringInStr($FontInfo,'TTC') And Not StringInStr($FontInfo,'Fon') Then
FileSetAttrib($FontList,'-Rsh')
FileDelete($FontList)
MsgBox(48 + 262144, '出错啦~~~在当前目录中找不到 TTF/TFC/FON '& _
'字体文件!', '老大, 既然您要安装字体吗, 也要把我拷到有 TTF/TFC/FON 字体的目录中噻! ',8)
Else
RunWait('FontInst'.exe)
FileSetAttrib($FontList,'-Rsh')
FileDelete($FontList)
MsgBox(64 + 262144, '当前目录的所有合格的字体已全部安装完毕!', 'ＯＫ! '& _
'当前目录的所有合格字体（不含非标准字体）均已全部安装完毕! ',5)
EndIf
;------------------------------------------------------------------------------------------------------------------ 回复 4# sanhen
学习了... ahkang 发表于 2009-10-22 12:04
用 Au3 结合微软的 FontInst 可实现真正全自动安装字体，经本人试验已取得成功！思路是：
① 先用 Au3 搜索 ...
win10不可用额。。还有什么好方法吗
页:
[1]