¡Instalación de fuentes por lotes de VB!
'Si la copia falla en win7, modifique los permisos de seguridad del nombre de usuario de inicio de sesión. Se puede configurar en la opción más baja (disponible en la configuración del usuario)?Explícito
¿Privado?Declarar. ?Función?AddFontResource?Lib ?"gdi32"?Alias?"AddFontResourceA"?(ByVal?lpFileName?As?String)?As?Long
Privado?Declarar?Función?RemoveFontResource?Lib?"gdi32" ?Alias?"RemoveFontResourceA" ?(ByVal?lpFileName?As?String)?As?Long
¿Privado?Declarar?Función?GetWindowsDirectory?Lib?"kernel32"?Alias?"GetWindowsDirectoryA"?(ByVal? lpBuffer?As?String, ?ByVal?nSize?As?Long)?As?Long
Dim?WinPath?As?String
Dim?Fname?As?String
¿Privado?Sub?Form_Load()
Dim?WinPathTmp?As?String, ?i, ?arr(), ?flag
WinPathTmp?=?Space(25 )
GetWindowsDirectory?WinPathTmp,?Len(WinPathTmp)
WinPath?=?Left(Trim(WinPathTmp),?Len(Trim(WinPathTmp))?-?1)
marca ?=?getfilename("d:\desk\font\font\font\",?arr,?".ttf")
List1.Clear
Si?flag?Entonces
Para?i?=?LBound(arr)?To?UBound(arr)
List1.AddItem?arr(i)
Siguiente
¿Fin?Si
Fin?Sub
¿Privado?Sub?Command1_Click()
Atenuar?i
¿Para? i?=?0?To?List1.ListCount?-?1
Fname?=?"d:\desk\font\font\font\"?amp;?List1 .List(i)
FileCopy?Fname,?WinPath?amp;?"\fonts\"?amp;?List1.List(i)
AddFontResource?Fname
Siguiente
If?List1.ListCount?gt;?0?Then?MsgBox?"Felicitaciones, ¡la fuente se instaló correctamente! ",?vbOKOnly? ?vbInformation,?"El sistema indica "?'El sistema escribirá automáticamente en el registro después de reiniciar
Fin?Sub
Función?getfilename(pathname?As? Cadena,?temp,?marca)?Como?Booleano
<p>Dim?f,?n?As?Long
nombre de ruta?=?nombre de ruta?amp;?IIf(Right(nombre de ruta,?1)?=?"\",?"",?" \")
f?=?Dir(nombre de ruta,?vbDirectorio)
Si?Len(f)?=?0?Entonces
¿Salir?Función
¿Fin?Si
¿Hacer?Mientras?f?lt;gt;?""
Si?f?lt;gt;?"."? Y?f?lt;gt;?".."?Entonces
If?LCase(Right(pathname?amp;?f,?4))?=?LCase(mark)?Then p>
n?=?n?1
ReDim?Preserve?temp(1?To?n)
temp(n)?=?f
¿Fin?Si
Fin?Si
f?=?Dir()
Bucle
Si? n? gt;?0?Entonces?getfilename?=?True
¿Fin?Función