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

帖子
187 
积分
539 
技术
4  
捐助
0  
注册时间
2009-1-24 
1楼 跳转到 » 倒序看帖
打印
tT
发表于 2017-10-7 23:55 | 只看该作者

[问题求助] 同时安装多个字体，能不能实现显示第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

帖子
187 
积分
539 
技术
4  
捐助
0  
注册时间
2009-1-24 
2楼
发表于 2017-10-8 01:00 | 只看该作者
本帖最后由 9zhmke 于 2017-10-10 09:31 编辑

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

TOP

窄口牛

Rank: 5Rank: 5

帖子
283 
积分
507 
技术
10  
捐助
0  
注册时间
2008-2-16 
3楼
发表于 2017-10-8 09:01 | 只看该作者
记得在无忧讨论过
转载
  1. Set ofso = CreateObject("Scripting.FileSystemObject")

  2. SourceFolder = ofso.GetParentFolderName(Wscript.ScriptFullName)

  3. 

  4. Const FONTS = &H14&

  5. 

  6. Set objShell  = CreateObject("Shell.Application")

  7. Set oSource   = objShell.Namespace(SourceFolder)

  8. Set oWinFonts = objShell.Namespace(FONTS)

  9. 

  10. ' Lame VBscript needs 4 f*ing lines instead of "if (/\.ttf$/i) " ...

  11. Set rxTTF = New RegExp

  12. rxTTF.IgnoreCase = True

  13. rxTTF.Pattern = "\.ttf$"

  14. 

  15. FOR EACH FontFile IN oSource.Items()

  16.     IF rxTTF.Test(FontFile.Path) THEN   

  17.         oWinFonts.CopyHere FontFile.Path

  18.     END IF

  19. NEXT
复制代码

TOP

9zhmke

帖子
187 
积分
539 
技术
4  
捐助
0  
注册时间
2009-1-24 
4楼
发表于 2017-10-8 14:15 | 只看该作者
本帖最后由 9zhmke 于 2017-10-8 14:33 编辑

回复 3# 窄口牛


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

TOP

返回列表