[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] 同时安装多个字体,能不能实现显示第n个字体,共50个字体?[未解决]

本帖最后由 9zhmke 于 2018-4-20 11:46 编辑

使用VBS安装字体非常方便,如下语句即可。
  1. CreateObject("Shell.Application").NameSpace("shell:fonts").CopyHere(font_filename)
复制代码
但麻烦的事情是只能安装一个文件,做文件夹遍历过后,要等显示很多个“正在安装xxxx字体,第1个字体,共1个字体”,我希望能够实现显示“正在安装xxx字体,第6个字体,共24个字体。这样的效果,尝试了把文件名字串用逗号隔开结果不行,放到数组里也不行,要怎么样才能安装多个字体文件呢?
  1. Set objFSO = CreateObject("Scripting.FileSystemObject")
  2. tmp0=Wscript.CreateObject("Wscript.Shell").SpecialFolders("fonts") & "\"'字体文件所在文件夹
  3. for each f in objFSO.getfolder(".").files '文件夹所有文件
  4.     tmp1=LCase(f.path)'完整文件名和路径
  5.     tmp2=right(tmp1,3):if left(right(tmp1,4),1)<>"." then tmp2=""       '取扩展名,扩展容错
  6.     if objFSO.FileExists(tmp0 & LCase(f.name)) then tmp2=""'判断fonts下的是否有字体,容错已安装字体
  7.     if tmp2="ttf" or tmp2="ttc" or tmp2="otf" or tmp2="fon" then
  8.           CreateObject("Shell.Application").NameSpace("shell:fonts").CopyHere(tmp1)
  9.     end if
  10. next
复制代码

本帖最后由 9zhmke 于 2017-10-8 14:33 编辑

回复 3# 窄口牛


    谢谢指点,这个还没有我写那个完善.... 这不是重点,可能我没有写清楚,我的问题想问怎么实现同时安装多个字体而不是一个一个安装,你这个程序仍然会提示安装一个总数一个,虽然使用了正则表达式但和我那个在本质上没有区别?

TOP

记得在无忧讨论过
转载
  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. ' Lame VBscript needs 4 f*ing lines instead of "if (/\.ttf$/i) " ...
  8. Set rxTTF = New RegExp
  9. rxTTF.IgnoreCase = True
  10. rxTTF.Pattern = "\.ttf$"
  11. FOR EACH FontFile IN oSource.Items()
  12.     IF rxTTF.Test(FontFile.Path) THEN   
  13.         oWinFonts.CopyHere FontFile.Path
  14.     END IF
  15. NEXT
复制代码

TOP

本帖最后由 9zhmke 于 2017-10-10 09:31 编辑

常用的方法有逗号分隔、分号分隔、回车换行分隔、放到数组,试过了这几种都不行。

TOP

返回列表