命令行字体注册工具RegFont.vbs v1.0 [2007-5-7]

运行环境：WinNT/Win2K/WinXP/Win2003
+ 使用方法：命令行输入RegFont.vbs 字体文件名回车即可。(例如：RegFont.vbs FZ.TTF)程序
会自动移动FZ.TTF到系统的FONTS目录，并对字体进行注册，完成后即可
使用该字体。也可以在windows里头直接将某个TTF托拽到REGFONT进行注册。

regfont xx.ttf 复制xx.ttf并注册
regfont xx.ttf /m 移动xx.ttf并注册
补充：
regfont xx.ttf /i 安装xx.ttf不复制，仅用快捷方式安装
regfont xx.ttf /r 安装xx.ttf，仅对本次会话有效，重启后注销。

 

Set objShell=CreateObject("Shell.Application")
Set objWSH=CreateObject("WScript.Shell")
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set argv=WScript.Arguments
set objFsoFontFile=objFSO.GetFile(argv(0))
Set objFontFile=objShell.NameSpace(CStr(objFsoFontFile.ParentFolder)).ParseName(objFsoFontFile.Name)
Set objSysFontsDir=objShell.NameSpace("shell:fonts")

If argv.Length=1 Then
    Call objSysFontsDir.CopyHere(objFontFile)
ElseIf argv(1)="/i" Then
    strFontTitle=objCurrDir.GetDetailsOf(objFontFile,21)  '这个地方调用explorer获得字体标题，非Vista可能不是21
    Call objWSH.RegWrite("HKLM/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Fonts/" & strFontTitle & " (TrueType)",objFontFile.Path)
    '需要重启才能生效，vbs无法调用API，sigh～～或许rundll32可以？
ElseIf argv(1)="/m" Then
    objSysFontsDir.MoveHere(objFontFile)
ElseIf argv(1)="/r" Then
    WScript.Echo "Not implemented"
Else
    WScript.Echo "RegFont.vbs V1.0"
End If