批量安装字体的VBS脚本Folder.CopyHere 方法中的参数问题

holley2008

现有批量安装字体的VBS脚本

1. Set ofso = CreateObject("Scripting.FileSystemObject")
   
2. SourceFolder = ofso.GetParentFolderName(Wscript.ScriptFullName)
   
3. Const FONTS = &H14&
   
4. Set objShell  = CreateObject("Shell.Application")
   
5. Set oSource   = objShell.Namespace(SourceFolder)
   
6. Set oWinFonts = objShell.Namespace(FONTS)
   
7. Set rxTTF = New RegExp
   
8. rxTTF.IgnoreCase = True
   
9. rxTTF.Pattern = "\.ttf[        DISCUZ_CODE_0        ]quot;
   
10. FOR EACH FontFile IN oSource.Items()
    
11.     IF rxTTF.Test(FontFile.Path) THEN  
    
12.         oWinFonts.CopyHere FontFile.Path,<font color="#ff0000">256</font>
    
13.     END IF
    
14. NEXT

复制代码

测试在未安装对应字体的电脑上使用正常
但如果已安装对应字体则会弹出是否覆盖的确定窗口，手动一个个点击确认太麻烦了
查了一下微软相关的方法调用：https://docs.microsoft.com/ja-jp ... ell/folder-copyhere
发现我添加的参数都未正常生效  想请教一下 是这个可选参数只能在特定环境下生效还是我的脚本错误导致这种情况


另意外发现win10 64字体文件夹里面存在：‪C:\Users\Administrator\AppData\Local\Microsoft\Windows\Fonts和常规的C:\Windows\Fonts
vbs正常复制文件用的是FileSystemObject 但操作字体居然没生效。。操作存疑？

9zhmke

ilywlm 发表于 2022-6-21 20:19
老哥，我在同目录下又放了个字体，把字体的名字写到inf文件，然后双击bat文件依然没有安装成功，如果我的 ...

建议你新开个贴把要求提出来让别人给你做个字体补丁

ilywlm

9zhmke 发表于 2022-6-21 16:25
你可以先换几个字体在里面再试试，如果还不行的话可能是管理员权限之类的安全原因造成的，如果你不知道什 ...

老哥，我在同目录下又放了个字体，把字体的名字写到inf文件，然后双击bat文件依然没有安装成功，如果我的做法没问题就应该是您说的管理员权限的问题，这个问题我确实不懂，想请教您有没有解决的办法。论坛里有提权的代码是干这个用的吗？

9zhmke

ilywlm 发表于 2022-6-20 23:02
老哥，我把您发的压缩包解压出来4个文件，应该双击bat文件就会安装“手写体千图笔锋.otf”这个字体吧，可 ...

你可以先换几个字体在里面再试试，如果还不行的话可能是管理员权限之类的安全原因造成的，如果你不知道什么是管理员权限那可能还得了解一些别的东西再来弄这个。
我也常有需要补充的字体，都是用这个方法加上去的

ilywlm

9zhmke 发表于 2022-6-20 18:33
大约是这个样子，你再自己改改吧：

老哥，我把您发的压缩包解压出来4个文件，应该双击bat文件就会安装“手写体千图笔锋.otf”这个字体吧，可是我双击bat文件只闪了下黑影，Fonts文件夹中并没有出现手写体千图笔锋这个字体，直接双击这个字体文件再点安装，Fonts文件夹中就出现这个字体，问题出在哪里了，请老哥有时间指点一下！

9zhmke

ilywlm 发表于 2022-6-20 18:13
请老哥发个全套的成品吧（双击就能运行的），我对代码一窍不通，多谢老哥！

大约是这个样子，你再自己改改吧： 静默安装本处字体.7z (2.54 MB, 下载次数: 17)

2022-6-20 18:32 上传

点击文件名下载附件
下载积分: 无忧币 -2

ilywlm

9zhmke 发表于 2022-6-20 18:07
可以的，静默安装

请老哥发个全套的成品吧（双击就能运行的），我对代码一窍不通，多谢老哥！

9zhmke

ilywlm 发表于 2022-6-20 17:57
感谢老哥回复，您现在用的这个方法可以达到系统没装再安装，系统已装就不安装的目的吗？

可以的，静默安装

ilywlm

9zhmke 发表于 2022-6-20 12:38
VBS功能太弱，如果用AU3可能要好些，但说到安装字体，这个问题也困扰我很久。所以我现在都改用了微软自己 ...

感谢老哥回复，您现在用的这个方法可以达到系统没装再安装，系统已装就不安装的目的吗？或者不管系统中有没有这个字体直接覆盖安装也行。（我讨厌安装系统中已有的字体时弹出是否覆盖的确定窗口），如果可以达到这个目的的话，请老哥发个成品吧，我对代码一窍不通啊，多谢老哥！

9zhmke

ilywlm 发表于 2022-6-20 10:21
9zhmke老哥，您好：我经常双击简易字体安装脚本1.0（链接：https://www.52pojie.cn/thread-1248764-1-1.h ...

VBS功能太弱，如果用AU3可能要好些，但说到安装字体，这个问题也困扰我很久。所以我现在都改用了微软自己的软件“fontinst.exe”来安装，只需要把文件做一个列表到fontinst.inf即可，而这个生成的过程，可以直接由批处理来完成：>fontinst.inf  dir *.otf *.ttf /b

ilywlm

9zhmke 发表于 2021-12-16 18:48
先检测是否有这个字体，没有字体再安装，例：

9zhmke老哥，您好：我经常双击简易字体安装脚本1.0（链接：https://www.52pojie.cn/thread-1248764-1-1.html）安装同目录下的字体，想把您这个检测代码与脚本1.0整合到一起，达到系统没装再安装，系统已装就不安装的目的，我的代码水平是负数，直接把您这段代码粘贴到脚本1.0文件的前面，改了好几个地方也没有成功，烦请老哥有时间给看一下，最好弄个成品出来，多谢老哥！（假设要安装的字体是a.ttf和b.ttf）

ilywlm

老哥您好，我也在为弹出是否覆盖的确定窗口而烦恼，请问这个问题您解决了吗？

窄口牛

9zhmke 发表于 2021-12-19 11:20
出现这个重复提示是因为字体名未统一，如果已安装的和未安装的是同一文件名的字体应该不会出现这个情况， ...

这就不是一般的难度了。

9zhmke

holley2008 发表于 2021-12-16 20:19
多谢指点，，我这边win10 64 测试了一下tmp1、tmp2获取正常。tmp3一直为46 导致还是会重复安装并弹出已安 ...

出现这个重复提示是因为字体名未统一，如果已安装的和未安装的是同一文件名的字体应该不会出现这个情况，其实通过检测系统已安装字体是能判断已安装字体的，但还需要对未安装的字体是什么字体进行对比，这个可能要再分析一下字体文件的结构了，应该还是可以做到。

nttwqz

chishingchan 发表于 2021-12-17 09:23
安装字体不是直接拷贝文件到FONTS目录就行了吗？

xp可以

holley2008

chishingchan 发表于 2021-12-17 09:23
安装字体不是直接拷贝文件到FONTS目录就行了吗？

win10以后的好像在脚本上用这招没啥用

chishingchan

安装字体不是直接拷贝文件到FONTS目录就行了吗？

holley2008

9zhmke 发表于 2021-12-16 18:48
先检测是否有这个字体，没有字体再安装，例：

多谢指点，，我这边win10 64 测试了一下tmp1、tmp2获取正常。tmp3一直为46 导致还是会重复安装并弹出已安装提示。

9zhmke

先检测是否有这个字体，没有字体再安装，例：

1. 
   
2. Set objFSO = CreateObject("Scripting.FileSystemObject")
   
3. Set font = CreateObject("Shell.Application").NameSpace("shell:fonts")
   
4. tmp0=Wscript.CreateObject("Wscript.Shell").SpecialFolders("fonts") & ""'字体文件所在文件夹
   
5. for each f in objFSO.getfolder(".").files '文件夹所有文件
   
6.     tmp1=LCase(f.path)'完整文件名和路径
   
7.     tmp2=right(tmp1,3)'扩展名
   
8.     tmp3=asc(left(right(tmp1,4),1)):if tmp3=49 then tmp3=46 '我也不知道为什么取出来居然不是"."，只知和系统有关
   
9.     if tmp3<>46 or objFSO.FileExists(tmp0 & LCase(f.name)) then tmp2="" '扩展名容错或容错fonts下已装字体
   
10.     if tmp2="ttf" or tmp2="ttc" or tmp2="otf" or tmp2="fon" then  font.CopyHere(tmp1)
    
11. next
    
12. 
    

复制代码

holley2008

bfgxp 发表于 2021-12-16 15:42
那就再写个脚本来点覆盖的对话框

测试了一下 管理员方式 发送enter或esc不生效啊

bfgxp

那就再写个脚本来点覆盖的对话框

magicgenius

你也没生成vbs啊……