Windows XP Namesdarstellung von CIFS-Shares im Explorer via Registry-Änderung kürzer darstellen

' Q: [content:11041]  

' Variablen deklarieren  
Dim objNetwork, objShell,objWSH
Dim strMyName, strMyDriveLetter, strMyRemotePath

' Variablen zuweisen  
Set objNetwork = CreateObject("WScript.Network")  
Set objShell   = CreateObject("Shell.Application")  
set objWSH     = CreateObject("WScript.Shell")  

' System-Konstanten  
Const EVENT_SUCCESS = 0
Const EVENT_INFO    = 4
Const EVENT_ERROR   = 1

' Mappt ein Netzlaufwerk  
' @param strMyName        string Der Laufwerksname z.B. "Meine Daten"  
' @param strMyDriveLetter string Der Laufwerksbuchstabe z.B. "P:"  
' @param strMyRemotePath  string Der Zielpfad z.b. "\\dom.local\shares\test"  
Public Sub mapMyDrives(strMyName, strMyDriveLetter, strMyRemotePath)
	'error handling  
	On Error Resume Next
	Err.Clear
	'laufwerk verbinden  
	Call objNetwork.MapNetworkDrive(strMyDriveLetter, strMyRemotePath)
	'ging das daneben? z.B. schon verbunden.  
	If Err.Number <> 0 Then
		'der Fehler bedeutet "Laufwerk schon verbunden, das ist auch OK für uns  
		If Err.Number <> -2147024811 Then
			Call objWSH.LogEvent(EVENT_ERROR, "Error while mapping drive: <" & Err.Number & "> " & Err.Description & "[" & strMyDriveLetter & "|" & strMyRemotePath & "]")   
			Exit Sub
		End If
	End If
	'namen ändern  
	Call renameDrive(strMyName, strMyDriveLetter)
	'loggen  
	Call objWSH.LogEvent(EVENT_SUCCESS, "Mapped <" & strMyRemotePath & "> to drive <" & strMyDriveLetter & ">")  
	
End Sub

' Benennt ein Laufwerk um  
' @param strDriveName   string Der neue Name für das Laufwerk z.B. "Hans Wurst"  
' @param strDriveLetter string Der Buchstabe des Laufwerks z.B. "P:"  
Public Sub renameDrive(strDriveName, strDriveLetter)
	Call objWSH.LogEvent(EVENT_INFO, "Rename <" & strDriveLetter & "> to <" & strDriveName & ">")  
	'deklarieren  
	Dim ns
	'namespace objekt erzeugen  
	Set ns = objShell.NameSpace(strDriveLetter)
	'wenn es das objekt gibt (=Laufwerk vorhanden) können wir den namen ändern  
	If Not ns Is Nothing Then
		ns.Self.Name = strDriveName
	Else
		Call objWSH.LogEvent(EVENT_ERROR,"Tried to rename a drive that is not connected: [" & strDriveLetter & "]")  
	End If
End Sub

' Laufwerke verbinden  
Call mapMyDrives("Allgemein", "P:", "\\dom.local\...")  

' Name des Home-Laufwerk setzen  
username = objWSH.ExpandEnvironmentStrings("%USERNAME%")  
homedrive = objWSH.ExpandEnvironmentStrings("%HOMEDRIVE%")  
If Not homedrive = "C:" Then  
	Call renameDrive("Daten von " & username, homedrive)  
End If