Crear un archivo de script llamado InstallFonts.vbs en mi caso lo puse en C: \ PortableApps \ InstallFonts \ IN el código siguiente reemplaza "SomeUser" con el nombre de usuario de la persona que desea poder instalar las fuentes. Luego, haga la carpeta "Instalar fuentes" apropiada en su escritorio.
Set ofso = CreateObject("Scripting.FileSystemObject")
'SourceFolder = ofso.GetParentFolderName(Wscript.ScriptFullName)
SourceFolder = "C:\Users\SomeUser\Desktop\Install Fonts"
Const FONTS = &H14&
Set objShell = CreateObject("Shell.Application")
Set oSource = objShell.Namespace(SourceFolder)
Set oWinFonts = objShell.Namespace(FONTS)
' Lame VBscript needs 4 f*ing lines instead of "if (/\.ttf$/i) " ...
Set rxTTF = New RegExp
rxTTF.IgnoreCase = True
rxTTF.Pattern = "\.ttf$"
FOR EACH FontFile IN oSource.Items()
IF rxTTF.Test(FontFile.Path) THEN
oWinFonts.CopyHere FontFile.Path
END IF
NEXT
Ahora cree un acceso directo en su escritorio que sea el siguiente ...
C:\Windows\System32\runas.exe /user:Administrator /savecred "wscript C:\PortableApps\InstallFonts\InstallFonts.vbs"
Tenga en cuenta que usé "Administrador". Lo habilité y le asigné una contraseña. Supongo que podría usar cualquier cuenta de administrador para esto. La primera vez que ejecute el acceso directo, se le solicitará la contraseña de administrador ... cada vez que simplemente funcione.
Si no le solicita una contraseña, ejecute el acceso directo desde una solicitud de cmd, entonces debería solicitarla.
No puedo prometerle cuán seguro es esto, ya que podrían usarlo para ejecutar código elevado. Sin embargo, es una solución.