找回密码
 加入
搜索
查看: 4291|回复: 10

[系统综合] au3怎样自动安装字体

[复制链接]
发表于 2008-5-24 20:30:05 | 显示全部楼层 |阅读模式
au3怎样自动安装字体
发表于 2008-5-24 20:40:28 | 显示全部楼层
这里有个例子,用的是复制字体文件到@WindowsDir \ "fonts"目录,再刷新注册表...
好像有更好的办法,等叁恨来了告诉你...

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?加入

×
 楼主| 发表于 2008-5-24 20:56:27 | 显示全部楼层
谢谢,漠北雪~狼
发表于 2008-5-25 02:13:46 | 显示全部楼层

;
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] > 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
 楼主| 发表于 2008-5-25 09:38:51 | 显示全部楼层
谢谢,漠北雪~狼,谢谢叁恨居士!!
发表于 2008-5-25 20:42:45 | 显示全部楼层
user用户需要提权使用吗?
发表于 2008-5-26 08:01:06 | 显示全部楼层
不错,用得着,标记一下,好好学习了
发表于 2009-6-25 13:38:39 | 显示全部楼层
收藏了 以后用的着
发表于 2009-10-22 12:04:33 | 显示全部楼层
用 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, '当前目录的所有合格的字体已全部安装完毕!', 'OK! '& _
        '当前目录的所有合格字体(不含非标准字体)均已全部安装完毕! ',5)
EndIf
;------------------------------------------------------------------------------------------------------------------

评分

参与人数 1金钱 +25 收起 理由
holley + 25 赞一个!

查看全部评分

发表于 2010-3-2 00:45:55 | 显示全部楼层
回复 4# sanhen


    学习了...
发表于 2024-7-16 19:22:29 | 显示全部楼层
ahkang 发表于 2009-10-22 12:04
用 Au3 结合微软的 FontInst 可实现真正全自动安装字体,经本人试验已取得成功!思路是:
① 先用 Au3 搜索 ...

win10不可用额。。还有什么好方法吗
您需要登录后才可以回帖 登录 | 加入

本版积分规则

QQ|手机版|小黑屋|AUTOIT CN ( 鲁ICP备19019924号-1 )谷歌 百度

GMT+8, 2024-12-22 10:59 , Processed in 0.095726 second(s), 30 queries .

Powered by Discuz! X3.5 Licensed

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表