VBS script Frage zum kopieren und installieren von Fonts

[m1k2k 10]

Hallo zusammen,

hab mir im Inet ein VBS Script gesucht dass mir aus einem Verzeichnis raus spezifische Schriftarten beim Starten des PC´s installiert.

 

Es funktioniert prinzipiell, jedoch läuft die Installation der Fonts sichtbar ab und wenn eine Schriftart auf dem PC bereits existiert, dann meckert er dieses an und wartet auf eingabe.

 

Aufgerufen wird das script über eine batch datei in der GPO :

 

cscript.exe /nologo "\\domain\netlogon\Softwareverteilung\Schriften\Schriftarteninst.vbs"

 

Was muss in diesem Fall angepasst werden?

 

Dim oFSO, oApp, oFolderCopy, oShell

Dim strFontsPath, strScriptPath

 

' Create needed Objects

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oShell = CreateObject("WScript.Shell")

Set oApp = CreateObject("Shell.Application")

 

' Get Path of this Script (i.E. C:\Scripts\ or \\server\netlogon\)

strScriptPath = WScript.ScriptFullName

strScriptPath = left(strScriptPath,instrrev(strScriptPath,"\"))

 

' Get Path of Windows Fonts directory

strFontsPath = oShell.ExpandEnvironmentStrings("%WINDIR%") & "\Fonts"

 

' Get Folder Object of Fonts directory (i.E. C:\Scripts\FontsToInstall or \\server\netlogon\FontsToInstall)

Set oFolderCopy = oApp.Namespace(strScriptPath & "FontsToInstall")

 

' Check each Font if it already is installed

For Each oFont In oFolderCopy.Items

If NOT oFSO.FileExists(strFontsPath & "\" & oFont.Name) Then

' Tell Explorer to copy the Font – this correctly installs it.

oApp.Namespace(strFontsPath).CopyHere oFont

End If

Next

 

' Cleanup Objects

Set oFolderCopy = Nothing

Set oApp = Nothing

Set oShell = Nothing

 

Danke für eure Hilfe

 

Gruss Michael

[Sunny61 773]

Entweder als Computerstartupscript laufen lassen oder den If-Teil umdrehen:

 

' Check each Font if it already is installed
For Each oFont In oFolderCopy.Items
 If oFSO.FileExists(strFontsPath & "\" & oFont.Name) Then
   next
 else
   ' Tell Explorer to copy the Font – this correctly installs it.
   oApp.Namespace(strFontsPath).CopyHere oFont
 End If
next

 

Es gibt auch eine Möglichkeit mittels MSI-Datei Schriftarten zu installieren. Eigenbau und Erstellung eines MSI Paketes am Beispiel der Fonts

[blub 115]

Probier mal cscript /B /nologo ...

 

aus

cscript /?

[NilsK 2.795]

Moin,

 

und nächstes Mal wäre es nett, wenn du deine Fundstelle auch benennst, statt den Verweis auf den Autor aus dem Code zu löschen ...

 

faq-o-matic.net Schriftarten per Skript installieren

 

Gruß, Nils

[maba100 10]

' Check each Font if it already is installed

For Each oFont In oFolderCopy.Items

If oFSO.FileExists(strFontsPath & "\" & oFont.Name) Then

next

else

' Tell Explorer to copy the Font – this correctly installs it.

oApp.Namespace(strFontsPath).CopyHere oFont

End If

next

 

Kann es sein da hier was nicht stimmt?

[Cybquest 36]

M.E. ein Next zuviel unterhalb von IF.

[Sigma 10]

Tipp die Fehlermeldung ab, der Anhang wird mit Sicherheit nicht freigeschalten.

 

Grüße,

 

Sigma

[NilsK 2.795]

Moin,

 

M.E. ein Next zuviel unterhalb von IF.

 

nö, nur wenig eleganter Stil.

 

Gruß, Nils

[maba100 10]

Morgen, habe das "next" entfernt und das Script läuft nun durch. Jedoch kommt die Meldung immer noch das die Schrift bereits installiert ist.

 

Hat jemand noch eine Idee?

[NilsK 2.795]

Moin,

 

vielleicht teilst du uns erst mal mit, was du denn eigentlich erreichen willst.

 

Bedenke, dass die Skriptvariante nur eine Krücke ist. Wenn es um Verteilung in großem Stil geht, sind andere Mechanismen sinnvoller.

 

Gruß, Nils

[Cybquest 36]

Lass Dir doch mal per Msgbox o.ä. strFontsPath & "\" & oFont.Name ausgeben. Vielleicht hat der Font ein Leerzeichen im Name o.ä.?

Dann müsste man den kpl. String erst mal mit " maskieren.

[maba100 10]

Das Ziel wäre ein Script zu haben, das alle Schriften installiert die in einem bestimmten Ordner liegen und prüft ob sie schon auf dem Client installiert sind.

 

Grüsse

[NilsK 2.795]

Moin,

 

das ist nicht das Ziel, sondern die Methode. Warum brauchst du so ein Skript?

 

Gruß, Nils

[mamamia 13]

Hier mein Script dazu:

 

' Region Description
'
' Name:		deployFonts.vbs
' Author:		mamamia
' Version:		0.2
'			0.2 | Registrierung der Schriftarten hinzugefügt
' Description:	kopiert Fonts von $Fontspath zu den Systemfonts
' 
' 
' EndRegion

Set objNetwork 	= CreateObject("WScript.Network")
Set objShellApp	= CreateObject("Shell.Application")
Set WSHShell	= CreateObject("WScript.Shell")
Set oFileSys	= CreateObject("Scripting.FileSystemObject")

Computer		= UCase(objNetwork.ComputerName)

Function deplyFonts (FontsPath)

Set objFolder 	= objShellApp.Namespace(FontsPath)
SystemFonts	= WSHShell.ExpandEnvironmentStrings("%Systemroot%") & "\Fonts\"
Set Folder 		= oFileSys.GetFolder(FontsPath)	
For Each File In objFolder.Items
	' Nur Files mit der Endung "ttf" lesen
	If UCase(Right(File.Path, 3)) = "TTF" Then
		' wenn Font auf dem System noch nicht vorhanden ist, kopieren
		If Not oFileSys.FileExists(SystemFonts & File.Name) Then
			oFileSys.CopyFile File.Path, SystemFonts, True
			' Schriftart registriern, damit diese von Programmen gefunden wird
			If (objFolder.GetDetailsOf(File, 21) <> "") Then
				WSHShell.RegWrite "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Fonts" & objFolder.GetDetailsOf(File, 21), UCase(File.Name), "REG_SZ"
			Else 
				WSHShell.RegWrite "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Fonts" & File.Name, UCase(File.Name), "REG_SZ"
			End If
			'prüfen ob eine neuere Version auf dem Server liegt	
		Else
			Set DestFile	= oFileSys.GetFile(File.Path)
			Set SourceFile 	= oFileSys.GetFile(SystemFonts & File.Name)

			If SourceFile.DateCreated <> DestFile.DateCreated Then
				oFileSys.CopyFile File.Path, SystemFonts, True
				' Schriftart registriern, damit diese von Programmen gefunden wird
				If (objFolder.GetDetailsOf(File, 21) <> "") Then
					WSHShell.RegWrite "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Fonts" & objFolder.GetDetailsOf(File, 21), UCase(File.Name), "REG_SZ"
				Else 
					WSHShell.RegWrite "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Fonts" & File.Name, UCase(File.Name), "REG_SZ"
				End If
			End If	
		End If
	End If
Next

End Function

' Allgemeine Fonts für Alle installieren
deplyFonts("\\PFAD\Fonts\ALLE")

' Fonts für KE und MA installieren (wenn KE oder MA im Rechnernamen vorhanden)
If (InStr(Computer, "KE") Or InStr(Computer, "MA")) Then
deplyFonts("\\PFAD\Fonts\KE")
End If


WScript.Quit

 

Fonts werden geprüft ob Sie installiert sind, wenn nicht, werden diese kopiert und in der Registry registriert und wenn eine neuere Version des Fonts vorhanden ist, dann wird dieser aktualisiert.

 

Zudem Möglichkeit für differenzierte Verteilung nach Kriterien!

 

Viel Spass damit!