http://dieseyer.de • all rights reserved • © 2011 v11.4

'*** 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 )

http://dieseyer.de • all rights reserved • © 2011 v11.4