'*** v11.4 *** www.dieseyer.de *****************************
'
' Datei:  netzpfadermitteln.vbs
' Autor:  dieseyer@gmx.de
' Auf:    www.dieseyer.de
'
' Enthält zwei Prozeduren:
'
' NetzPfadVonLwErmitteln()
'	erwartet einen Laufwerksbuchstaben als Parameter
' NetzPfadVonLwErmitteln() wird verwendet in:
'	kontext-pfadinzwischenablage.vbs
'
' NetzPfadErmitteln()
'	erwartet einen Laufwerksbuchstaben oder einen Pfad
'	zu einer Datei oder einem Verzeichnis als Parameter
'
'***********************************************************

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl

Dim xxx


  xxx = "C:"
  MsgBox "NetzPfadVonLwErmitteln( """ & xxx & """ )" & vbCRLF & vbCRLF & vbTab & "ergibt:" & vbCRLF & vbCRLF & NetzPfadErmitteln( xxx ), , "026 :: " & Wscript.ScriptName

  xxx = "K:"
  MsgBox "NetzPfadVonLwErmitteln( """ & xxx & """ )" & vbCRLF & vbCRLF & vbTab & "ergibt:" & vbCRLF & vbCRLF & NetzPfadErmitteln( xxx ), , "029 :: " & Wscript.ScriptName

' WScript.Quit

  xxx = "C:"
  MsgBox "NetzPfadErmitteln( """ & xxx & """ )" & vbCRLF & vbCRLF & vbTab & "ergibt:" & vbCRLF & vbCRLF & NetzPfadErmitteln( xxx ), , "034 :: " & Wscript.ScriptName

  xxx = "K:\iRadio Lounge\brother of soul - be right there.mp3"
  MsgBox "NetzPfadErmitteln( """ & xxx & """ )" & vbCRLF & vbCRLF & vbTab & "ergibt:" & vbCRLF & vbCRLF & NetzPfadErmitteln( xxx ), , "037 :: " & Wscript.ScriptName

  xxx = "v:\123\meine.txt"
  MsgBox "NetzPfadErmitteln( """ & xxx & """ )" & vbCRLF & vbCRLF & vbTab & "ergibt:" & vbCRLF & vbCRLF & NetzPfadErmitteln( xxx ), , "040 :: " & Wscript.ScriptName

' WScript.Quit

  xxx = "http://dieseyer.de"
  MsgBox "NetzPfadErmitteln( """ & xxx & """ )" & vbCRLF & vbCRLF & vbTab & "ergibt:" & vbCRLF & vbCRLF & NetzPfadErmitteln( xxx ), , "045 :: " & Wscript.ScriptName

  xxx = "\\dieseyer\de"
  MsgBox "NetzPfadErmitteln( """ & xxx & """ )" & vbCRLF & vbCRLF & vbTab & "ergibt:" & vbCRLF & vbCRLF & NetzPfadErmitteln( xxx ), , "048 :: " & Wscript.ScriptName


WScript.Quit


'*** v11.4 *** www.dieseyer.de *****************************
Function NetzPfadErmitteln( Pfad )
'***********************************************************
  Dim WSHNet		: Set WSHNet		= WScript.CreateObject("WScript.Network")
  Dim fso		: Set fso		= WScript.CreateObject("Scripting.FileSystemObject")
  Dim oDrives		: Set oDrives		= WSHNet.EnumNetworkDrives
  Dim Lw, Verz, Tst, n


' ist übergebener Pfad bereits Netzwerkpfad?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If Left( Pfad, 2 ) = "\\" Then NetzPfadErmitteln = Pfad : Exit Function

' ist übergebener Pfad verbundenes Laufwerk?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If not Mid( Pfad, 2, 1 ) = ":" Then NetzPfadErmitteln = Pfad : Exit Function

' MsgBox "Function NetzPfadErmitteln( " & Pfad & " )", , "071 :: "

  Lw = Left( UCase( Pfad ), 1 ) ' nur der Laufwerksbuchstabe
  Pfad = Mid( Pfad, 3 ) ' alles nach dem Dioppelpunkt des Laufwerksbuchstaben
' MsgBox Lw & vbCRLF & vbCRLF & Pfad, , "075 :: "

  On Error Resume Next
  Tst = fso.GetDrive( Lw ).DriveType
'  On Error Resume Next
  Tst = Int( Tst )

' lokale Festplatte: 2 = fso.GetDrive( Pfad ).DriveType
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If 2 = Tst Then
	Tst = "\\" & WSHNet.ComputerName & "\" & Lw & "$"
	' MsgBox Tst, , "086 :: "
	If fso.FolderExists( Tst ) Then NetzPfadErmitteln = Tst : Exit Function
  End If

' verbundenes Netzlaufwerk: 3 = fso.GetDrive( Pfad ).DriveType
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If Int( 3 ) = Int( Tst ) Then
	For n = 0 to oDrives.Count - 1 Step 2
	  If InStr( oDrives.Item( n ), Lw ) = 1 Then
		NetzPfadErmitteln = oDrives.Item( n + 1 ) & Pfad
		' MsgBox oDrives.Item( n ) & vbCRLF & vbCRLF & oDrives.Item( n + 1 ) & vbCRLF & Pfad, , "096 :: " & Tst
		Exit Function
	  End If
	Next
  End If
End Function ' NetzPfadErmitteln( Pfad )


'*** v11.4 *** www.dieseyer.de *****************************
Function NetzPfadVonLwErmitteln( Lw )
'***********************************************************
  Dim WSHNet		: Set WSHNet		= WScript.CreateObject("WScript.Network")
  Dim fso		: Set fso		= WScript.CreateObject("Scripting.FileSystemObject")
  Dim oDrives		: Set oDrives		= WSHNet.EnumNetworkDrives
  Dim Tst, n


' ist übergebenes Lw ein Pfad?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If Len( Lw ) > 2 Then MsgBox Lw & vbCRLF & vbCRLF & Lw, , "115 :: "
  If Len( Lw ) > 2 Then NetzPfadVonLwErmitteln = Lw : Exit Function

' ist zweites Zeichen kein Doppelpunkt?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If Len( Lw ) = 2 Then If not ":" = Mid( Lw, 2 ) Then MsgBox Lw & vbCRLF & vbCRLF & Lw, , "120 :: "
  If Len( Lw ) = 2 Then If not ":" = Mid( Lw, 2 ) Then NetzPfadVonLwErmitteln = Lw : Exit Function

' MsgBox "Function NetzPfadVonLwErmitteln( " & Lw & " )", , "123 :: "

  Lw = Left( UCase( Lw ), 1 ) ' nur der Laufwerksbuchstabe
' MsgBox Lw & vbCRLF & vbCRLF & Lw, , "126 :: "

  On Error Resume Next
  Tst = fso.GetDrive( Lw ).DriveType
'  On Error Resume Next
  Tst = Int( Tst )

' lokale Festplatte: 2 = fso.GetDrive( Lw ).DriveType
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If 2 = Tst Then
	Tst = "\\" & WSHNet.ComputerName & "\" & Lw & "$"
	' MsgBox Tst, , "137 :: "
	If fso.FolderExists( Tst ) Then NetzPfadVonLwErmitteln = Tst : Exit Function
  End If

' verbundenes Netzlaufwerk: 3 = fso.GetDrive( Lw ).DriveType
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If Int( 3 ) = Int( Tst ) Then
	For n = 0 to oDrives.Count - 1 Step 2
	  If InStr( oDrives.Item( n ), Lw ) = 1 Then
		NetzPfadVonLwErmitteln = oDrives.Item( n + 1 )
		' MsgBox oDrives.Item( n ) & vbCRLF & vbCRLF & oDrives.Item( n + 1 ) & vbCRLF & Lw, , "147 :: " & Tst
		Exit Function
	  End If
	Next
  End If
End Function ' NetzPfadVonLwErmitteln( Lw )