域环境users提权调用lsrunase.exe批处理完成安装字体-创新互联

字体安装2.0
由于字体安装之前的批处理采用字体文件复制到c:\windows\fonts下再注册注册表的方式，一部分字体安装不上，重新修改了批处理方式。

一. 字体安装批处理
1.vbs脚本运行安装D:\fonts下的字体安装包，安装时fonts.vbs同时会检测C:\windows\fonts\字体名称与D:\fonts里的字体名是否一致，如果存在则忽略掉。缺点：若是表面字体名不一致，会提示重复安装，手动单击选择即可。
参考的事例：
http://blog.jasondahmen.com/2011/11/24/the-true-ultimate-font-install-for-windows-7-and-xp-vbs/
代码如下fonts.vbs
Option Explicit
' Installing multiple Fonts in Windows 7
' http://www.cloudtec.ch 2011
' Edited by Jason Dahmen

Dim objShell, objFSO, wshShell
Dim strFontSourcePath, objFolder, objFont, objNameSpace, objFile

Set objShell = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = createobject("Scripting.Filesystemobject")

strFontSourcePath = "D:\fonts\"
If objFSO.FolderExists(strFontSourcePath) Then
If objFSO.FolderExists("C:\Users\") Then
' Start Windows 7/Vista
Set objNameSpace = objShell.Namespace(strFontSourcePath)
Set objFolder = objFSO.getFolder(strFontSourcePath)
For Each objFile In objFolder.files
If LCase(right(objFile,4)) = ".ttf" OR LCase(right(objFile,4)) = ".otf" OR LCase(right(objFile,4)) = ".ttc" Then
Set objFont = objNameSpace.ParseName(objFile.Name)
If objFSO.FileExists("C:\WINDOWS\Fonts\" & objFile.Name) = False Then
objFont.InvokeVerb("Install")
Set objFont = Nothing
Else
End If
End If
Next
Else
' Start Windows XP
Set objNameSpace = objShell.Namespace(strFontSourcePath)
Set objFolder = objFSO.getFolder(strFontSourcePath)
For Each objFile In objFolder.files
If LCase(right(objFile,4)) = ".ttf" OR LCase(right(objFile,4)) = ".otf" OR LCase(right(objFile,4)) = ".ttc" Then
Set objFont = objNameSpace.ParseName(objFile.Name)
If objFSO.FileExists("C:\WINDOWS\Fonts\" & objFile.Name) = False Then
objFSO.CopyFile "D:\fonts*", "c:\windows\fonts\"
Set objFont = Nothing
Else
End If
End If
Next
End If
Else
Wscript.Echo "Font Source Path does not exists"
End IF

注意：安装只包含ttf,otf,ttc三种字体文件,可以自己在代码加字体后缀（ If LCase(right(objFile,4)) = ".ttf" OR LCase(right(objFile,4)) = ".otf" OR LCase(right(objFile,4)) = ".ttc" Then），满足95%，特殊类型的字体安装再扩展。

2. 使用vbs封装成exe文件工具，封装vbs脚本，命名可执行文件的fonts.exe。
   （bat不能直接运行VBS，水平有限直接做成了exe来执行）
   下载地址：https://download.csdn.net/download/qq_16066381/9760279

二．使用Quick_Batch_File_Compiler封装以管理员运行的批处理.批处理用到lsrunas.exe加密域管理员密码来运行fonts.exe

1. 代码：Fonts-intsall.bat
   @echo off
   if "%1"=="h" goto begin
   start mshta vbscript:createobject("wscript.shell").run("""%~nx0"" h",0)(window.close)&&exit
   :begin
   \10.10.12.201\soft\install\lsrunase\lsrunase.exe /user:administrator /password:3lp9huRP3uydxg== /domain:zzecwwmir.com /command:d:\fonts\fonts.exe /runpath:d:\fonts\
   rem 利用lsrunase调用域管理员权限来运行本地自解压文件完成软件安装rem 利用lsrunase调用域管理员权限来运行本地自解压文件完成软件安装

参考lsrunase.exe
https://www.cnblogs.com/colinliu/p/5666715.html

2.Quick_Batch_File_Compiler封装命名为 双击本软件_安装字体.exe

三．介于软件bug,做了其他辅助性的批处理来完善使用
字体提示已安装太多情况1.强制结束安装进程，2.清理fonts下已安装的字体

11强制结束_安装字体.bat
@echo off
taskkill /f /im fonts.exe
结束字体安装进程

12删除以前的文件里的字体安装文件.bat
@echo off
del /f /q /a /s D:\fonts*.otf
del /f /q /a /s D:\fonts*.ttf
del /f /q /a /s D:\fonts*.fon
del /f /q /a /s D:\fonts*.ttc
rem 删除字体

Desk.bat 删除之前的快捷方式，创建新的快捷方式，并运行完删除自己
@echo off
copy /y "D:\fonts\安装字体.lnk" c:\users\public\desktop
rem 在公共桌面创建快捷方式
ping 127.1 -n 2 >nul
del D:\fonts\安装字体.lnk
del /f /q /a /s %0
rem 删除批处理本身

四．封装自解压
自解压的封装方法百度一下。

1.解压后的Fonts.exe 属性隐藏，防止误删
2.注意命名的安装软件排在所有文件前面。字体文件很多情况下，会造成找不到

五．宣导，或者编辑安装方法文档。

另外有需要云服务器可以了解下创新互联cdcxhl.cn，海内外云服务器15元起步，三天无理由+7*72小时售后在线，公司持有idc许可证，提供“云服务器、裸金属服务器、高防服务器、香港服务器、美国服务器、虚拟主机、免备案服务器”等云主机租用服务以及企业上云的综合解决方案，具有“安全稳定、简单易用、服务可用性高、性价比高”等特点与优势，专为企业上云打造定制，能够满足用户丰富、多元化的应用场景需求。