'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