http://dieseyer.de • all rights reserved • © 2011 v11.4
'v2.6*****************************************************
' File: netzverb-zu-server.vbs
' Autor: dieseyer@gmx.de
' dieseyer.de
'
' Netzlaufwerk verbinden mit einem anderen UserName, als
' der, der am System (Domain) gerade angemeldet ist.
'*********************************************************
Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl
DIM WSHShell, WSHNetzWerk, WSHLaufWerk, FSO, AllDrives
DIM Titel, Fehler, FehlerNr
DIM LogonName, LogonPwd, Server, ServerIP, ServerDomain
DIM FileIn, FileOut
DIM TmpTxt, TextX, i, LW, FGN, IPadr, EndIPadr
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set WSHNetzWerk = WScript.CreateObject("WScript.NetWork")
Set WSHLaufWerk = WSHNetzWerk.EnumNetworkDrives()
Set FSO = CreateObject("Scripting.FileSystemObject")
ServerDomain = "ALLIANZ\SERVER-"
LogonName = "Maier"
LogonName = WSHNetzWerk.UserName
TmpTxt = "~tmp~.tmp"
Titel = WScript.ScriptName
Server = "ServerXYZ" ' Ziel-Server
LW = "W:" ' LaufWerksBuchstaben, die verwendet werden sollen
FGN = "C$" ' FreiGabeName auf dem Ziel-Server
FGN = "IPC$" ' FreiGabeName auf dem Ziel-Server
FGN = "d$" ' FreiGabeName auf dem Ziel-Server
LogDatei vbCRLF & now() ' LogDatei SUB-Aufruf
' Server erfragen
' ~~~~~~~~~~~~~~~
TextX = "An welchen Server wollen Sie sich an anmelden?"
Server = InputBox (TextX, Titel, Server)
Server = UCase(Server)
If Server = "" then
WSHShell.Popup (". . . denn eben nicht!"), 3, Titel, 64
WScript.Quit
End If
ServerIP = ""
ServerTesten ' ServerTesten SUB-Aufrufen
' ~~~~~~~~~~~~~~~ ' ermittelt IPadr. aus DNS-Name
' Die Verbindung von Netzlaufwerken klappt m.E. per IP-Adresse besser bzw. fast immer
If ServerIP = "" Then
TextX = Server & vbCRLF & vbCRLF & "ist nicht per PING erreichbar!"
LogDatei TextX
MsgBox TextX, , Titel
WScript.Quit
End If
' FGN erfragen
' ~~~~~~~~~~~~
TextX = "Welcher Freigabenamen auf " & vbCRLF & vbCRLF & """ \\" & UCase(Server) & "\ "" soll verwendet werden?"
FGN = InputBox (TextX, Titel, FGN)
If FGN = "" then
WSHShell.Popup (". . . denn eben nicht!"), 3, Titel, 64
WScript.Quit
End If
' LW erfragen
' ~~~~~~~~~~~
LW = ""
If not UCase(FGN) = "IPC$" then
TextX = "Welchen Laufwerksbuchstaben soll die Verbindung zu " & vbCRLF & vbCRLF & """ \\" & UCase(Server) & "\" & FGN & """ verwenden?"
TextX = TextX & vbCRLF & vbCRLF & "( "
For i = 0 To WSHLaufWerk.Count -1 Step 2
if WSHLaufWerk.Item(i) <> "" Then
TextX = TextX & WSHLaufWerk.Item(i) & " "
End If
Next
TextX = TextX & vbCRLF & "werden bereits verwendet.) " & vbCRLF
LW = "W:"
LW = InputBox (TextX, Titel, LW)
If LW = "" then
WSHShell.Popup (". . . denn eben nicht!"), 3, Titel, 64
WScript.Quit
End If
End If
' LogonName erfragen
' ~~~~~~~~~~~~~~~~~~
TextX = "Das Ganze funktioniert nur, wenn die Passwörter synchron sind!" & vbCRLF & vbCRLF
TextX = TextX & "Mit welchem Namen wollen Sie sich an " & Server & " bzw. " & ServerIP & " anmelden?"
' Domäne\UserName
LogonName = InputBox (TextX, Titel, ServerDomain & LogonName)
LogonName = UCase(LogonName)
If LogonName = "" then
WSHShell.Popup (". . . denn eben nicht!"), 3, Titel, 64
WScript.Quit
End If
' Trennen
' ~~~~~~~
LWtrennen FGN ' LWtrennen SUB-Aufruf
' Verbinden
' ~~~~~~~~~
LWverbinden LW, FGN ' LWverbinden SUB-Aufruf
WSHShell.Popup (". . . erledigt!"), 3, Titel, 64
WScript.Quit
'*********************************
Function LWtrennen(LW)
'*********************************
if FSO.DriveExists(LW) then ' LaufWerk vorhanden?
if FSO.GetDrive(LW).DriveType = 3 then ' ist es NetzLaufWerk?
For i = 2 To WSHLaufWerk.Count -1 Step 2
If WSHLaufWerk.Item(i) = LW Then TextX = fso.getDrive(WSHLaufWerk.Item(i)).ShareName
Next
TextX = LW & " ist mit " & TextX & " verbunden " & vbCRLF & vbCRLF
TextX = TextX & "und wird jetzt getrennt - stimmt's ? "
i = MsgBox(TextX, 4+32+256, Titel)
if i = 6 then WSHNetzWerk.RemoveNetWorkDrive LW ' NetzLaufWerk trennen
End If
End If
End Function ' LWtrennen(LW)
'*********************************
Function LWverbinden(LW, FGN)
'*********************************
On Error Resume Next ' fals es nicht klappt
Err.Number = ""
Err.Description = ""
Fehler = Err.Description
FehlerNr = Err.Number
WSHNetzWerk.RemoveNetworkDrive "\\" & ServerIP, true '
FehlerNr = Err.Number
Fehler = Err.Description
' MsgBox FehlerNr & vbTab & Fehler & vbTab & "\\" & ServerIP
LogDatei ":" & FehlerNr & vbTab & Fehler & vbCRLF & vbTab & vbTab & "nach WSHNetzWerk.RemoveNetworkDrive \\" & ServerIP
Err.Number = ""
Err.Description = ""
Fehler = Err.Description
FehlerNr = Err.Number
WSHNetzWerk.RemoveNetworkDrive "\\" & Server, true '
FehlerNr = Err.Number
Fehler = Err.Description
' MsgBox FehlerNr & vbTab & Fehler & vbTab & "\\" & Server
LogDatei ":" & FehlerNr & vbTab & Fehler & vbCRLF & vbTab & vbTab & "nach WSHNetzWerk.RemoveNetworkDrive \\" & Server
Err.Number = ""
Err.Description = ""
Fehler = Err.Description
FehlerNr = Err.Number
WSHNetzWerk.MapNetWorkDrive LW, "\\" & Server & "\" & FGN, , LogonName
FehlerNr = Err.Number
Fehler = Err.Description
' MsgBox FehlerNr & vbTab & Fehler & vbTab & "\\" & Server & "\" & FGN
LogDatei ":" & FehlerNr & vbTab & Fehler & vbCRLF & vbTab & vbTab & "nach WSHNetzWerk.MapNetWorkDrive LW, \\" & Server & "\" & FGN & " " & LogonName
If FehlerNr = 13 then
WSHShell.Popup "Verbinden mit " & "\\" & Server & "\" & FGN & " war erfolgreich (UserName: " & LogonName & ")", 3, Titel, 64
End If
If not FehlerNr = 13 then
WSHShell.Popup Fehler & vbCRLF & ". . . beim Verbinden mit " & "\\" & Server & "\" & FGN & " (UserName: " & LogonName & ")" & vbCRLF & vbCRLF & "Es wird jetzt über IP versucht!", 3, Titel, 64
Err.Number = ""
Err.Description = ""
Fehler = Err.Description
FehlerNr = Err.Number
WSHNetzWerk.MapNetWorkDrive LW, "\\" & ServerIP & "\" & FGN, , LogonName
Fehler = Err.Description
FehlerNr = Err.Number
' MsgBox FehlerNr & vbTab & Fehler & vbTab & "\\" & ServerIP & "\" & FGN
LogDatei ":" & FehlerNr & vbTab & Fehler & vbCRLF & vbTab & vbTab & "nach WSHNetzWerk.MapNetWorkDrive LW, \\" & ServerIP & "\" & FGN & " " & LogonName
End If
On Error GoTo 0
If not FehlerNr = 13 then
WSHShell.Popup Fehler & vbCRLF & ". . . beim Verbinden mit " & "\\" & ServerIP & "\" & FGN & " (UserName: " & LogonName & ")" , , WScript.ScriptName
End If
If FehlerNr = 13 then
WSHShell.Popup "Verbinden mit " & "\\" & ServerIP & "\" & FGN & " war erfolgreich (UserName: " & LogonName & ")", 3, Titel, 64
End If
' If not Fehler = "" then MsgBox Fehler & vbCRLF & ". . . beim Verbinden mit " & FGN & " (UserName: " & LogonName & ")", , WScript.ScriptName
' If Fehler = "" then WSHShell.Popup ("Verbinden mit " & FGN & " war erfolgreich (UserName: " & LogonName & ")"), 3, Titel, 64
End Function ' LWverbinden
'*********************************
Sub ServerTesten
'*********************************
if fso.FileExists(TmpTxt) Then fso.DeleteFile(TmpTxt), True ' Datei löschen
if fso.FileExists(TmpTxt) Then wshshell.Popup "Bitte nicht OK drücken!!!" , 3, " Nach 3sek bin ich weg!", vbExclamation
if fso.FileExists(TmpTxt) Then MsgBox TmpTxt & " konnte nicht gelöscht werden - ABBRUCH", , Titel
if fso.FileExists(TmpTxt) Then WScript.Quit
WSHShell.run ("%comspec% /c Ping " & Server & " -n 1 -w 500 > " & TmpTxt), 0, True ' Ping nur einmal ausführen
Set FileIn = fso.OpenTextFile(TmpTxt, 1 ) ' Datei zum Lesen öffnen
TextX = FileIn.ReadAll ' alles lesen
FileIn.Close
Set FileIn = nothing
if fso.FileExists(TmpTxt) Then fso.DeleteFile(TmpTxt), True ' Datei löschen
TextX = Split(TextX, vbCRLF) ' alles gelesene in Zeilen aufteilen
for i = 0 to ubound(TextX) ' jede Zeile überprüfen
If InStr(UCase(TextX(i)), "TTL=") Then ' ob TTL= enthalten ist, wenn ja (PING war erfolgreich)
' Bei der Ping-Ausgabe befindet sich hinter der IP-Adresse ein ":" - was links vom ":" steht, ist interessant
ServerIP = Mid(TextX(i), 1, InStr(UCase(TextX(i)), ":") -1 )
' Bei der Ping-Ausgabe befindet sich vor der IP-Adresse ein " " - was rechst vom " " steht, ist die IP-Adr.
ServerIP = Mid(ServerIP, InStrRev(ServerIP, " ") +1 )
End If
next
End Sub ' ServerTesten
'*********************************
Sub LogDatei (LogTxt)
'*********************************
Set FileOut = fso.OpenTextFile(WScript.ScriptName & ".log", 8, true)
FileOut.WriteLine (LogTxt)
FileOut.Close
Set FileOut = Nothing
End Sub ' LogDatei
http://dieseyer.de • all rights reserved • © 2011 v11.4