Programme mit Ziel auf Netzlaufwerk an Startleiste und Taskbar pinnen

Wir setzen bei uns auf Windows 7 in Verbindung mit Windows Server 2008 R2 Servern.

Bei der Migration zu Windows 7 hatten wir das Problem, dass wir auf keinem komfortablem Weg Programme welche auf einem Netzlaufwerk liegen den Usern an die Taskbar oder ans Startmenü zu heften. Es gibt dafür bekanntlich den manuellen Workaround, dass man zuerst ein lokales Programm pinnt und danach das Ziel anpasst. Da manuell aber keine Option ist habe ich mich daran gemacht das ganz zu automatisieren.
Im Internet stösst man auf Scripte und Tools welche helfen Programme zu pinnen. Ich habe aber keines gefunden welches meinen Ansprüchen genügt und somit machte ich mich selbst ans Werk. Als Grundlage diente mir ein Script aus dem Microsoft Technet Forum welches ich um einige Funktionen ergänzt und angepasst habe. Der Umweg sieht auch so aus als ob er bewusst noch verkompliziert wurde, allen anderen probierten Wege funktionierten allerdings nicht korrekt auf sehr langsamen Rechnern oder umgekehrt auf sehr schnellen PC's. Ich bin leider nicht wirklich ein VB Script Profi, darum bin ich froh wenn ich auch auf Verbersserungsvorschläge hingewiesen werde.

Leider gibt es keine Universallösung für alle Sprachen mittels der gescripteten Lösung. Microsoft bietet keinen besseren Weg um ein Programm zu pinnen als auf dem Weg über den Namen des Kontextmenü's, und schon gar nicht eines auf einem Netzlaufwerk. Daher kommt auch die Sprachabhängigkeit. Man kann sich zwar wia Sysprep 3 zusätzliche Items an die Taskbar pinnen. Man kann aber z.B. keine dort bereits vorhandenen Elemente entfernen. Das pinnen von Programmen funktioniert im Moment nur mit folgenden Sprachen des OS, können aber beliebig erweitert werden:

• Englisch – USA
• Deutsch – Deutschland
• Deutsch – Schweiz
• Italienisch – Italien
• Italienisch – Schweiz
• Französisch – Frankreich
• Französisch – Schweiz

Desweiteren löscht das Script alle vom Default User bekannten Standardeinträge aus den kürzlich genutzten Programmen aus der Liste, sodass jeder User sauber starten kann. Für das gibt es zwar eine GPO, aber doppelt hält besser. ;)
Bei einigen Windows 7 Versionen sind bei den kürzlich genutzten Programmen andere Einträge drin als bei anderen. Man kann diese Beliebig im Array „arrDeleteApps“ ergänzen, indem man die EXE zur Verknüpfung angibt.

Das Script ist ebenfalls in der Lage auf Installationsbedingungen einzugehen. Man kann prüfen ob eine Software installiert ist und anhand des Ergebnisses wird dann die Verknüpfung erstellt oder nicht. Geprüft wird in der Registry im Uninstall String auf den Wert „DisplayName“, dabei spielt es keine Rolle ob es sich um ein 64-Bit oder 32-Bit Betriebssystem handelt, das Script unterstützt beides. Dazu benutzt man die Funktion "IsProgramInstalled" vor der eigentlichen pin/unpin Aktion. Die Funktion gibt einen True oder Fales Wert zurück.

Das Script verfügt auch über die Möglichkeit sich selbst zu löschen, mittels dieser Funktion kann man das Script zum Beispiel im Default User Ordner einbetten und einen Registry Key setzen in HKCU\software\microsoft\windows\currentversion\runonce. Dann wird das Script für jeden neuen User ausgeführt und anschliessend auch gleich gelöscht.

Beispiel Syntax um Items zu pinnen oder zu lösen:

Pinnen einer lokalen Verknüpfung in die Taskleiste

DoVerb	PinTask,	strAllUsersProgramsPath & "Windows Media Player.lnk",	FALSE,	" "
1	2	3	4	5

Pinnen einer lokalen EXE ans Startmenü

DoVerb	PinStart,	strProgramsPath & "Windows Defender\MSASCui.exe",	FALSE,	" "
1	2	3	4	5

Pinnen einer Netzwerk EXE ans Startmenü

DoVerb	PinStart,	"P:\Test\test.exe",	FALSE,	"Steuerprogramm"
1	2	3	4	5

Unpinnen einer Verknüpfung

DoVerb	UnpinTask,	“C:\windows\system32\calc.exe.exe”	TRUE,	" "
1	2	3	4	5

Erklärung:

1. DoVerb leiten den Pin/Unpin Vorgang ein
2. UnpinTask legt fest dass man etwas von der Taskleiste lösen will.
Alle möglichen Aktionen dafür sind:
• PinStart: Pinnt etwas ans Startmenü
• UnpinStart: Löst etwas vom Startmenü
• PinTask: Pinnt etwas an die Taskleiste
• UnpinTask: Löst etwas von der Taskleiste

3. Pfad zu Exe oder der Verknüpfung welche gepinnt werden soll. (Es ist beides möglich.)

4. Deklariert ob die Zieldatei auf einem Netzlaufwerk liegt oder nicht.
Alle möglichen Aktionen dafür sind:
• TRUE: Die Zieldatei liegt auf einem Netzlaufwerk
• FALSE: Die Zieldatei liegt NICHT auf einem Netzlaufwerk

5. Falls die Zieldatei auf dem Netzwerk liegt sollte hier der gewünschte Name eingegeben werden welcher später die Verknüpfung trägt. Bei lokalen Dateien braucht es den nicht, dort holt er sich den automatisch aus der Exe oder Verknüpfung.

ACHTUNG: Alle Felder sind Pflichtfelder!

Ich hoffe das hilft vielleicht jemandem anders ausser mir noch weiter. Für Verbesserungsvorschläge oder gar andere Lösungen ohne Script für dieses Problem bin ich euch dankbar.

Hier der Code:

'=-=-=-=-=-=-=-=-=-=-=-=-=  
'           KONSTANTEN  
'=-=-=-=-=-=-=-=-=-=-=-=-=  
Const HKEY_CLASSES_ROOT     = &H80000000
Const HKEY_CURRENT_USER     = &H80000001
Const HKEY_LOCAL_MACHINE     = &H80000002
Const HKEY_USERS             = &H80000003
Const HKEY_CURRENT_CONFIG     = &H80000005

Const CSIDL_COMMON_PROGRAMS    = &H17
Const CSIDL_PROGRAMS        = &H2
Const CSIDL_SYSTEM		= &H25 ' Windows\System32  
Const CSIDL_APPDATA		 = &H1A  ' Anwendungsdaten  
Const CSIDL_PROGRAM_FILES = &H26
Const CSIDL_PROGRAM_FILESX86 = &H2A

'=-=-=-=-=-=-=-=-=-=-=-=-=  
'          OBJEKTE  
'=-=-=-=-=-=-=-=-=-=-=-=-=  
Set objRegistry            = GetObject("winmgmts:\\.\root\default:StdRegProv")  
Set objFSO                = CreateObject("Scripting.FileSystemObject")  
Set objApplication        = CreateObject("Shell.Application")  
Set objWMIService 			= GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")  
Set objAllUsersPrograms    = objApplication.NameSpace(CSIDL_COMMON_PROGRAMS)
Set objUserPrograms        = objApplication.NameSpace(CSIDL_PROGRAMS)
Set objUserAppdata			= objApplication.NameSpace(CSIDL_APPDATA)
Set objSystem32				= objApplication.NameSpace(CSIDL_SYSTEM)
Set objShell 				= CreateObject( "WScript.Shell" )  
Set objPrograms				= objApplication.NameSpace(CSIDL_PROGRAM_FILES)
Set objProgramsx86			= objApplication.NameSpace(CSIDL_PROGRAM_FILESX86)
Set TempDir 				= objFSO.GetSpecialFolder(2)
'=-=-=-=-=-=-=-=-=-=-=-=-=  
'          VARIABELN  
'=-=-=-=-=-=-=-=-=-=-=-=-=  
Dim arrSubValues, arrDeleteApps, strAllUsersProgramsPath

strAllUsersProgramsPath    = objAllUsersPrograms.Self.Path & "\"  
strUserProgramsPath        = objUserPrograms.Self.Path & "\"  
strUserAppdataTaskbarPath    = objUserAppdata.Self.Path & "\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar\"  
strSystem32Path        = objSystem32.Self.Path & "\"  
strTempDir			= TempDir & "\"  
strProgramsPath		= objPrograms.Self.Path  & "\"  
strProgramsx86Path		= objProgramsx86.Self.Path  & "\"  
Counter 			= 0
ShortcutCount		= 1
'MS Standardeinträge Definition  
arrDeleteApps = Array("displayswitch.lnk", "remote desktop connection.lnk", "sticky notes.lnk", "snipping tool.lnk", "calculator.lnk", "paint.lnk", "xps viewer.lnk", "windows fax and scan.lnk", "Welcome Center.lnk", "Pen Training.lnk", "Media Center.lnk", "Windows Ultimate Extras.lnk", "Windows Photo Gallery.lnk", "Windows Collaboration.lnk", "Windows Photo Gallery.lnk", "Windows Live.lnk", "backup.lnk", "Windows Media Player.lnk", "magnify.lnk")  
'Die hier angegebenen Exe Dateien liegen alle im System32 Ordner und werden für den Zwischenschritt gebraucht um Netzwerkprogramme zu pinnen  
arrLocalExe = Array("charmap.exe", "cmd.exe", "cscript.exe", "defrag.exe", "fontview.exe", "cacls.exe", "cscript.exe", "wscript.exe")  
'Speichert die Speicherort und Namen der Shortcuts zwischen welche als Netfile gekennzeichnet sind  
arrShortcuts = Array()
'Speichert den Pfad der Exe Dateien zwischen welche als Netfile gekennzeichnet sind  
arrNetfilePath = Array()
'=-=-=-=-=-=-=-=-=-=-=-=-=  
'SUPPORT FÜR VERSCHIEDENE SPRACHEN  
'=-=-=-=-=-=-=-=-=-=-=-=-=  
Select Case GetLocale()
'Englisch - USA  
        Case 1033
			PinStart = "Pin to Start Menu"  
			UnpinStart = "Unpin from Start menu"  
			PinTask = "Pin to Taskbar"  
			UnpinTask = "Unpin from Taskbar"  
'Deutsch - Deutschland  
		Case 1031
			PinStart = "An Startmenü anheften"  
			UnpinStart = "Vom Startmenü lösen"  
			PinTask = "An Taskleiste anheften"  
			UnpinTask = "Von Taskleiste lösen"  
'Deutsch - Schweiz  
		Case 2055
			PinStart = "An Startmenü anheften"  
			UnpinStart = "Vom Startmenü lösen"  
			PinTask = "An Taskleiste anheften"  
			UnpinTask = "Von Taskleiste lösen"  
'Italienisch - Italien  
		Case 1040
			PinStart = "Aggiungi al menu Start"  
			UnpinStart = "Rimuovi dal menu Start"  
			PinTask = "Aggiungi alla barra delle applicazioni"  
			UnpinTask = "Rimuovi dalla barra delle applicazioni"  
'Italienisch - Schweiz  
		Case 2064
			PinStart = "Aggiungi al menu Start"  
			UnpinStart = "Rimuovi dal menu Start"  
			PinTask = "Aggiungi alla barra delle applicazioni"  
			UnpinTask = "Rimuovi dalla barra delle applicazioni"  
'Französisch - Frankreich  
		Case 1036
			PinStart = "Épingler au menu Démarrer"  
			UnpinStart = "Détacher du menu Démarrer"  
			PinTask = "Épingler à la barre des tâches"  
			UnpinTask = "Détacher de la barre des tâches"  
'Französisch - Schweiz  
		Case 4108
			PinStart = "Épingler au menu Démarrer"  
			UnpinStart = "Détacher du menu Démarrer"  
			PinTask = "Épingler à la barre des tâches"  
			UnpinTask = "Détacher de la barre des tâches"  
		Case Else
			Wscript.quit
End Select


Call Main

Sub Main()
	'Entferne alle Microsoft Standardeinträge aus dem Startmenü  
    DeleteStartMenuApps HKEY_CURRENT_USER, "", arrDeleteApps  

	'Pinne oder unpinne Programme. Möglich sind: PinStart,UnpinStart,PinTask,UnpinTask  
    DoVerb UnpinTask, strAllUsersProgramsPath & "Windows Media Player.lnk", FALSE, ""  
	DoVerb UnpinStart, strAllUsersProgramsPath & "Windows Media Player.lnk", FALSE, ""  
	DoVerb UnpinStart, strUserProgramsPath & "Internet Explorer.lnk", FALSE, ""  
	DoVerb PinTask, "P:\test\test.exe", TRUE, "Steuern"  
	 DoVerb PinTask, "P:\branchenapp\branchenapp.exe", TRUE, "Brachenapp"  
	
    'Office pinnen  
	DoVerb PinTask, strAllUsersProgramsPath & "Microsoft Office\Microsoft Word 2013.lnk", FALSE, ""  
	DoVerb PinTask, strAllUsersProgramsPath & "Microsoft Office\Microsoft Excel 2013.lnk", FALSE, ""  
	DoVerb PinTask, strAllUsersProgramsPath & "Microsoft Office\Microsoft Outlook 2013.lnk", FALSE, ""  
	
	'Biegt den Pfad der Verknüpfungen um, die als Netzwerkdatei gekennzeichnet sind  
	RedefineNetShortcuts
	
	'DeleteSelf  
End Sub


'=-=-=-=-=-=-=-=-=-=-=-=-=  
'     FUNKTIONEN UND SUB PROZEDUREN  
'=-=-=-=-=-=-=-=-=-=-=-=-=  
Function DoVerb(strVerb, strPath, Netfile, strShortcutName)
    On Error Resume Next
		If Netfile = TRUE Then
			If strShortcutName = "" Then  
				strShortcutName = "Verknüpfung" & ShortcutCount  
				ShortcutCount = ShortcutCount + 1
			End If
			If objFSO.FileExists(strUserAppdataTaskbarPath & strShortcutName & ".lnk") Then  
				Exit Function
			End If
			If not objFSO.FileExists(strSystem32Path & arrLocalExe(counter)) Then
				Do Until objFSO.FileExists(strSystem32Path & arrLocalExe(counter))
					counter = counter + 1
					If z >= Ubound(arrLocalExe) Then
						Exit Function
					Else
						z = z + 1
					End If
				Loop
			End If
			Set lnkTemp = objShell.CreateShortcut(strTempDir & strShortcutName & ".lnk")  
				lnkTemp.TargetPath = strSystem32Path & arrLocalExe(counter)
				lnkTemp.Arguments = ""  
				lnkTemp.Description = ""  
				lnkTemp.WorkingDirectory = strSystem32Path
				lnkTemp.IconLocation = strPath &", 0"  
				lnkTemp.Save
			ReDim Preserve arrShortcuts(UBound(arrShortcuts) + 1)
			arrShortcuts(UBound(arrShortcuts)) = strUserAppdataTaskbarPath & strShortcutName & ".lnk"  
			ReDim Preserve arrNetfilePath(UBound(arrNetfilePath) + 1)
			arrNetfilePath(UBound(arrNetfilePath)) = strPath
			If counter = UBound(arrLocalExe) Then
				counter = 0
			Else
				counter = counter + 1
			End If
			strFolder    = objFSO.GetParentFolderName(strTempDir & strShortcutName & ".lnk")  
			strFile        = objFSO.GetFileName(strTempDir & strShortcutName & ".lnk")  
			Set objFolder        = objApplication.NameSpace(strFolder)
			Set objFolderItem    = objFolder.ParseName(strFile)
		Else
		    strFolder    = objFSO.GetParentFolderName(strPath)
			strFile        = objFSO.GetFileName(strPath)
		    Set objFolder        = objApplication.NameSpace(strFolder)
			Set objFolderItem    = objFolder.ParseName(strFile)
		End If
        For Each ItemVerb In objFolderItem.Verbs
            If StrComp(Replace(ItemVerb.Name, "&", ""), strVerb, vbTextCompare) = 0 Then  
                ItemVerb.DoIt
				If Netfile = TRUE Then
					If objFSO.FileExists(lnkTemp) Then
						objFSO.DeleteFile lnkTemp
					End If
				End If
                Exit Function
            End If
        Next
    On Error Goto 0
End Function

Sub RedefineNetShortcuts
	For n = 0 To Ubound(arrShortcuts)
		strFolder    = objFSO.GetParentFolderName(arrNetfilePath(n))
		Set lnkFinal = objShell.CreateShortcut(arrShortcuts(n))
			lnkFinal.TargetPath = arrNetfilePath(n)
			lnkFinal.Arguments = ""  
			lnkFinal.Description = ""  
			lnkFinal.IconLocation = arrNetfilePath(n) &", 0"  
			lnkFinal.WorkingDirectory = strFolder & "\"  
			lnkFinal.Save
	Next
End Sub

Sub DeleteStartMenuApps(hDefKey, sSubKeyUser, arrDeleteApps)
    If Len(sSubKeyUser) > 0 Then
        sSubKeyName = sSubKeyUser & "\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist"  
    Else
        sSubKeyName = "Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist"  
    End If   
   
    objRegistry.EnumKey hDefKey, sSubKeyName, arrSubKeys
   
    If IsArray(arrSubKeys) Then
        For i = 0 to UBound(arrSubKeys)
            sTempSubKeyName = sSubKeyName & "\" & arrSubKeys(i) & "\Count"  
            objRegistry.EnumValues hDefKey, sTempSubKeyName, arrSubValues
        
            If IsArray(arrSubValues) Then
                For m = 0 to UBound(arrSubValues)
                    For n = 0 to UBound(arrDeleteApps)
                        If InStr(UCase(RunROT13(arrSubValues(m))), UCase(arrDeleteApps(n))) > 0 Then
                            objRegistry.DeleteValue hDefKey, sTempSubKeyName, arrSubValues(m)
                        End If
                    Next
                Next
            End If
        Next
    End If
End Sub

'Entschlüssle ROT13 Einträge der Registry  
Function RunROT13(strInput)
    For i = 1 to Len(strInput)
        iChr = Asc(Mid(strInput, i, 1))
        If (iChr >= 65 and iChr <= 77) Or (iChr >= 97 and iChr <= 109) Then
            strOutput = strOutput & Chr(iChr +13)
        ElseIf (iChr >= 78 and iChr <= 90) Or (iChr >= 110 and iChr <= 122) Then
            strOutput = strOutput & Chr(iChr -13)
        Else
            strOutput = strOutput & Chr(iChr)
        End If
    Next
    RunROT13 = strOutput
End Function

'Suche installiertes Programm nach dem "DisplayName"  
Function IsProgramInstalled(objRegistry, strProgramDisplayName)
    intRegistryHive    = HKEY_LOCAL_MACHINE
	If objShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%") = "x86" Then  
		strRegistryKey    = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"  
	Else
		strRegistryKey    = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"  
	End If
   
    objRegistry.EnumKey intRegistryHive, strRegistryKey, arrSubkeys
   
    IsProgramInstalled = FALSE
   
    For Each strSubkey In arrSubkeys
        strDisplayName = ReadRegistryValue(objRegistry, "STRING", intRegistryHive, strRegistryKey & "\" & strSubkey, "DisplayName")  
       
        If UCase(strDisplayName) = UCase(strProgramDisplayName) Then
            IsProgramInstalled = TRUE
            Exit For
        End If
    Next
	If not objShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%") = "x86" Then  
		strRegistryKey    = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"  
		
		objRegistry.EnumKey intRegistryHive, strRegistryKey, arrSubkeys
	   
		IsProgramInstalled = FALSE
	   
		For Each strSubkey In arrSubkeys
			strDisplayName = ReadRegistryValue(objRegistry, "STRING", intRegistryHive, strRegistryKey & "\" & strSubkey, "DisplayName")  
		   
			If UCase(strDisplayName) = UCase(strProgramDisplayName) Then
				IsProgramInstalled = TRUE
				Exit For
			End If
		Next
	End If
End Function

'Funktion um Registrywerte auszulesen und zurückzugeben  
Function ReadRegistryValue(objRegistry, strType, intRegistryHive, strSubKeyName, sValueName)
    Select Case UCase(strType)
        Case "DWORD"  
            objRegistry.GetDWORDValue intRegistryHive, strSubKeyName, sValueName, strValue
        Case "EXPANDEDSTRING"  
            objRegistry.GetExpandedStringValue intRegistryHive, strSubKeyName, sValueName, strValue
        Case "MULTISTRING"  
            objRegistry.GetMultiStringValue intRegistryHive, strSubKeyName, sValueName, strValue
        Case "STRING"  
            objRegistry.GetStringValue intRegistryHive, strSubKeyName, sValueName, strValue
		Case "QWORD"  
            objRegistry.GetQWORDValue intRegistryHive, strSubKeyName, sValueName, strValue

    End Select
   
    ReadRegistryValue = strValue
End Function

'Löscht das Script selbst  
Sub DeleteSelf()
        'Löscht das aktuell ausgeführte Script  
        objFSO.DeleteFile WScript.ScriptFullName
End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 211310

Url: https://administrator.de/contentid/211310

Ausgedruckt am: 26.11.2024 um 00:11 Uhr

2 Kommentare

Neuester Kommentar

Hallo @gilldex,

auch wenn für dich die manuelle Variante keine Option ist / war, hier trotzdem kurz das Vorgehen ...
... evtl. ist es ja für manche in Zukunft hilfreich und IMHO geht diese Variante ein wenig schneller

Neues Textdokument erstellen auf dem Desktop
Umbenennen in Datei.exe (wichtig - Dateiendung muss EXE sein)
Rechte Maustaste auf die soeben erstellte Datei - an Taskleiste anheften (Datei auf dem Desktop kann gelöscht werden)
Rechte Maustaste auf das Symbol in der Taskleiste und Eigenschaften öffnen
In der Registerkarte Verknüpfung das Ziel anpassen (ist noch die EXE vom Desktop hinterleg)
Übernehmen und OK (evtl. noch Symbol anpassen) und das war es ...

Geht mit normalen Pfadangabe - Netzlaufwerk\Speicherort aber auch mit UNC Pfad

Gruß
@kontext

Hallo kontext

Finde ich gut dass es du noch ergänzt für die, welche es so machen wollen. Wie gesagt, bei mir ging es um ein Deployment von mehreren Stationen. Da kann man den Usern nicht gut die manuelle Anleitung in die Hand drücken und sagen: "Mach da mal die nötigen Programme selbst an die Taskbar oder Taskleist". ;)
Da lohnt sich der einmalige Aufwand für das Script also schon sehr wenn man bedenkt dass Microsoft bewusst keine Lösung für diese Situation bereit hat. (3 Objekte in der Taskbar und 5 in im Startpanel ist das Maximum was Microsoft für ein Deployment bereit hält.)

Einen schönen Abend wünsche ich dir!

Gruss

gilldex

Anleitung Microsoft Windows 7

Mehr von gilldex

TCP Segmente zusammenfügengilldex - 10 Kommentare

3 Switch - kaskadieren oder nicht?gilldex - 6 Kommentare

Klasse nicht registriert wenn die Anwendung als Dienst läuftgilldex - 2 Kommentare

Domänen Default User Profil wird nicht geladen bei neuen Usern und erster Anmeldunggilldex - 2 Kommentare

Heiß diskutiert