有没有懂vbs的

桑特容易额

---

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,20
    
18.     END IF
    
19. NEXT

复制代码

---

这段代码是.vbs文件，用于安装当前文件夹下的ttf字体文件的。
想问一下如何静默安装，已存在则直接覆盖。
这个CopyHere( vItem,[ vOptions ])有两个参数，每个参数我都试过了，也相加过，都不行。

(4)

不显示进度对话框。

(8)

如果已有具有目标名称的文件，则为在移动、复制或重命名操作中对新名称进行操作的文件。

(16)

对于显示的任何对话框，请响应“全部是”。

(64)

如果可能，请保留撤消信息。

(128)

桑特容易额

附件如下。

smsn

装前检测一下字体名字是否存在。

桑特容易额

smsn 发表于 2023-1-30 13:36
装前检测一下字体名字是否存在。

有另外一种脚本，不过有缺陷,基本上是判断不出来字体是否存在。

源码作者的原话：我对已经安装的字体是采取建立字体列表，然后判断当前安装的字体是否存在于字体列表，字体列表的来源是已经安装的字体在系统的注册名（存在于注册表中）和已经安装的字体文件名。唯一遗憾的是我是通过比判断安装字体的文件名是否在字体列表中来判断字体是否安装，这里的问题主要是待安装的字体文件名不一定与字体真实的名字一致，字体真实的名字是需要读取二进制字体文件从中来获取的，这样脚本又复杂了，所以放弃了这种方式。

perfect131

这样 , 可以先检查是否已安装

1. Const FOF_SILENT = &H4&
   
2. Const FOF_RENAMEONCOLLISION = &H8&
   
3. Const FOF_NOCONFIRMATION = &H10&
   
4. Const FOF_ALLOWUNDO = &H40&
   
5. Const FOF_FILESONLY = &H80&
   
6. Const FOF_SIMPLEPROGRESS = &H100&
   
7. Const FOF_NOCONFIRMMKDIR = &H200&
   
8. Const FOF_NOERRORUI = &H400&
   
9. Const FOF_NOCOPYSECURITYATTRIBS = &H800&
   
10. Const FOF_NORECURSION = &H1000&
    
11. Const FOF_NO_CONNECTED_ELEMENTS = &H2000&
    
12. Dim cFlags
    
13. ''cFlags = FOF_SILENT + FOF_NOCONFIRMATION + FOF_NOERRORUI
    
14. cFlags = FOF_SILENT
    
15. Set objFSO = CreateObject("Scripting.FileSystemObject")
    
16. Set font = CreateObject("Shell.Application").NameSpace("shell:fonts")
    
17. tmp0=Wscript.CreateObject("Wscript.Shell").SpecialFolders("fonts") & ""'字体文件所在文件夹
    
18. ''系统字体 遍历
    
19. Set Folder = objFSO.GetFolder("C:\Windows\Fonts")
    
20. set dic = CreateObject("Scripting.Dictionary")
    
21. For Each File In Folder.Files
    
22.     If instr(LCase(File.Name),".ttf") Then
    
23.         dic(LCase(File.Name))=""
    
24.     End If
    
25. Next
    
26. ''用户特定的字体 遍历
    
27. Set oShell = CreateObject("WScript.Shell")
    
28. strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%") &"\AppData\Local\Microsoft\Windows\Fonts"
    
29. Set Folder1 = objFSO.GetFolder(strHomeFolder)
    
30. For Each File1 In Folder1.Files
    
31.     If instr(LCase(File1.Name),".ttf") Then
    
32.         dic(LCase(File1.Name))=""
    
33.     End If
    
34. Next
    
35. '''.\ 当前目录
    
36. for each f in objFSO.getfolder(".").files '文件夹所有文件
    
37.     tmp1=LCase(f.path)  '''''完整文件名和路径
    
38.     tmp2=right(tmp1,3)  ''''扩展名
    
39.     tmp3=LCase(f.name) ''''文件名
    
40.     '''判断字体是否 已装
    
41.     if tmp2="ttf" and not dic.exists(tmp3) then  font.CopyHere tmp1, cFlags
    
42. next
    
43. msgbox "OK!!!!!!"
    
44. Set objFSO = nothing
    
45. Set font = nothing
    
46. Set oShell =  nothing
    
47. set dic =  nothing

复制代码

大神们赐个静默安装吧(不显示进度对话框)，上面这段不能静默, 估计 cFlags 没写对

桑特容易额

等个大佬

桑特容易额

perfect131 发表于 2023-1-30 14:01
这样

你这个运行不了哦

lss001

Set fso = CreateObject("Scripting.FileSystemObject")
SFolder = fso.GetParentFolderName(Wscript.ScriptFullName)

Set oShell = CreateObject("Shell.Application")
Set oSource = oShell.Namespace(SFolder)
Set oWinFonts = oShell.Namespace(20)
Set oUser = oShell.Namespace(28)
UserFonts = oUser.self.Path & "\Microsoft\Windows\Fonts\"

Set rxTTF = CreateObject("vbscript.RegExp")
rxTTF.IgnoreCase = True
rxTTF.Pattern = "\.ttf$"

On Error Resume Next
For Each FontFile In oSource.Items()
    If rxTTF.Test(FontFile.Path) Then
        y = fso.GetBaseName(FontFile.Path)
        Set UserFiles = fso.GetFolder(UserFonts).Files
        x = 0 '判断用户字体
        For Each f In UserFiles
            If InStr(f.Name, y) Then
               x = 1
            End If
        Next
        If x = 0 Then
            oWinFonts.CopyHere FontFile.Path
        End If
    End If
Next

桑特容易额

lss001 发表于 2023-1-30 21:50
Set ofs = CreateObject("Scripting.FileSystemObject")
SourceFolder = ofs.GetParentFolderName(Wscript ...

一样的 还是提示字体已安装，是否替换。

perfect131

桑特容易额 发表于 2023-1-30 17:10
你这个运行不了哦

楼上代码已更新，在审核