#206795 - 2013-02-25 02:44 PM
Convert from VBS not functioning as expected !
|
MACE
Starting to like KiXtart
Registered: 2004-09-07
Posts: 150
Loc: Manchester UK
|
I have ended up shelling out to a VBscrip because I can not get the $objFont.InvokeVerb("Install") to work ?
Am i missing something or is it not possible with KIX ?
If exist ($TMP+$sFile)
Dim $objShell,$objNameSpace,$objFont
$objShell = CreateObject("Shell.Application")
$objNameSpace = $objShell.Namespace($TMP)
$objFont = $objNameSpace.ParseName($TMP+$sfile)
$objFont.InvokeVerb("Install")
ReDim $objShell,$objNameSpace,$objFont
If Exist($DEST+$sfile)
? "Font "+$sfile+" Installed."
Endif
del $TMP+$sFile /c
Endif
The Full VBS reads as follows:
Option Explicit
' Installing multiple Fonts in Windows 7
Dim objShell, objFSO, wshShell
Dim strFontSourcePath, objFolder, objFont, objNameSpace, objFile, objFontsFldr, objFonts, strFonts
Const FONTS = &H14&
Set objShell = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = createobject("Scripting.Filesystemobject")
strFontSourcePath = "F:\CustomFonts\"
set objFontsFldr = objShell.Namespace(FONTS)
Set objFonts = objFontsFldr.Self
strFonts = objFonts.Path & "\"
If objFSO.FolderExists(strFontSourcePath) Then
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" Then
If objFSO.FileExists(strFonts & objFile.Name) Then
Wscript.Echo "Font already installed: " & objFile.Name
Else
Set objFont = objNameSpace.ParseName(objFile.Name)
objFont.InvokeVerb("Install")
Wscript.Echo "Installed Font: " & objFile.Name
Set objFont = Nothing
End If
End If
Next
Else
Wscript.Echo "Font Source Path does not exists"
Wscript.sleep 5000
End If
|
|
Top
|
|
|
|
|
#206798 - 2013-02-25 04:40 PM
Re: Convert from VBS not functioning as expected !
[Re: MACE]
|
Allen
KiX Supporter
Registered: 2003-04-19
Posts: 4557
Loc: USA
|
I see I completely forgot about updating the Addfont UDF. It should work in its current state for Win7, but needs to be updated for Win8 and a fix for paths. Mace, I'll see what kind of results I get with the invoke method, and let you know (although it could be a day or so before I get a minute to work on this again.)
|
|
Top
|
|
|
|
|
#206821 - 2013-02-28 02:19 AM
Re: Convert from VBS not functioning as expected !
[Re: Allen]
|
Allen
KiX Supporter
Registered: 2003-04-19
Posts: 4557
Loc: USA
|
This took far to long to fix, and I found a bug in the original addfont.
Mace, your code was all but right... it was simply this line that was off...
$objFont = $objNameSpace.ParseName($sfile)
The bug. Surprisingly, on XP the extended file properties do not work on fonts, all other files work fine. However, XP is very friendly to install fonts by simply copying the files to the font folder, and even automatically adds the registry settings.
Once you get past Vista, the original addfont requires modifying the permissions of the fonts folder and the fonts paths in the registry. Using the method Mace found, appears to avoid this.
Would someone be willing to give this a whirl and let me know what you think.
$RC=AddFont("Path\Font.ttf")
? @serror
function AddFont($font)
dim $title,$rc,$path,$fontname,$fontdescription,$objshell,$objfolder,$objfolderitem
$addfont=1
if exist($font)
$path=left($font,instrrev($font,"\"))
$fontname=right($font,-instrrev($font,"\"))
if exist('%systemroot%\fonts\' + $fontname)
exit 80
else
$objShell = CreateObject("Shell.Application")
$objFolder=$objShell.NameSpace($path)
$objFolderItem=$objFolder.ParseName($fontname)
select
case instr(@producttype,"Vista") or instr(@producttype,"Windows 7") or instr(@producttype,"Windows 8") or
instr(@producttype,"Server 2008") or instr(@producttype,"Server 2012")
$objFolderItem.InvokeVerb("Install")
$error=@error
if exist('%systemroot%\fonts\' + $fontname)
$addfont=0
else
exit $error
endif
case instr(@producttype,"2000") or instr(@producttype,"Windows XP") or instr(@producttype,"2003")
copy $font '%systemroot%\fonts\'
if not exist('%systemroot%\fonts\' + $fontname)
exit @error
else
$AddFont=0
endif
case 1
exit -1
endselect
endif
else
exit 2
endif
endfunction
|
|
Top
|
|
|
|
|
#206825 - 2013-02-28 02:29 PM
Re: Convert from VBS not functioning as expected !
[Re: MACE]
|
Arend_
MM club member
Registered: 2005-01-17
Posts: 1896
Loc: Hilversum, The Netherlands
|
Just for KiX ;-) I've translated the VBS, didn't test it though:
$=SetOption('Explicit','On')
; Installing multiple Fonts in Windows 7
Dim $objShell, $objFSO
Dim $strFontSourcePath, $objFolder, $objFont, $objNameSpace, $objFile, $objFontsFldr, $objFonts, $strFonts
$FONTS = &14&
$objShell = CreateObject("Shell.Application")
$objFSO = CreateObject("Scripting.FileSystemObject")
$strFontSourcePath = "F:\CustomFonts\"
$objFontsFldr = $objShell.Namespace($FONTS)
$objFonts = $objFontsFldr.Self
$strFonts = $objFonts.Path + "\"
If Exist($strFontSourcePath)
$objNameSpace = $objShell.Namespace($strFontSourcePath)
$objFolder = $objFSO.GetFolder($strFontSourcePath)
For Each $objFile In $objFolder.files
If LCase(right($objFile,4)) = ".ttf" OR LCase(right($objFile,4)) = ".otf"
If $objFSO.FileExists($strFonts+$objFile.Name)
? "Font already installed: "+$objFile.Name
Else
$objFont = $objNameSpace.ParseName($objFile.Name)
$objFont.InvokeVerb("Install")
? "Installed Font: "+$objFile.Name
$objFont = ""
EndIf
EndIf
Next
Else
? "Font Source Path does not exists"
sleep 5000
EndIf
|
|
Top
|
|
|
|
Moderator: Glenn Barnas, NTDOC, Arend_, Jochen, Radimus, Allen, ShaneEP, Ruud van Velsen, Mart
|
0 registered
and 323 anonymous users online.
|
|
|
