'*** v7.B *** www.dieseyer.de ******************************** ' ' Datei: kontext-pfadnachzwischenablage.vbs ' (aus kontext-unc2clipbrd.vbs) ' Autor: Peter Ackermann ' Auf: www.dieseyer.de ' ' Erweitert das Kontextmenü des WindowsExplorer um die ' Funktionalität ' "UNC Pfad in die Zwischenablage kopieren" ' '************************************************************ Option Explicit Dim Text, TextX, oIE', txt Dim WshShell, String1, String2, Instpath Set WshShell = CreateObject("WScript.Shell") TextX = "" If (WScript.Arguments).Count = 0 Then unc2clipbrdInstall ' Prozeduraufruf mit WScript.Quit ' WScript.Echo "Ohne Argumente wirds nichts" ' WScript.quit ElseIf Left((WScript.Arguments).item(0),2) = "\\" Then TextX = (WScript.Arguments).item(0) IE( TextX ) ElseIf Mid((WScript.Arguments).item(0), 2, 1) = ":" Then If Left(((CreateObject("Scripting.FileSystemObject")).getDrive(Left((WScript.Arguments).item(0),2)).ShareName), 2) = "\\" Then TextX = (CreateObject("Scripting.FileSystemObject")).getDrive(Left((WScript.Arguments).item(0),2)).ShareName & Mid((WScript.Arguments).item(0), 3) IE( TextX ) Else TextX = (WScript.Arguments).Item(0) ' WScript.Echo "Kein UNC-Pfad!" IE( TextX ) End If End If WScript.Quit Function unc2clipbrdInstall Dim TextX Dim Instpath : Instpath = "\\server\share\verzeichnis\unc2clipbrd.VBS" Instpath = "C:\Programme\dieseyer.de\unc2clipbrd.VBS" Dim RegKey1 : RegKey1 = "HKCR\*\shell\unc2clipbrd\" Dim RegKey2 : RegKey2 = RegKey1 & "Command\" Dim RegKey3 : RegKey3 = "HKCU\Software\Classes\Folder\shell\unc2clipbrd\" Dim RegKey4 : RegKey4 = RegKey3 & "Command\" Dim String1 : String1 = "UNC-Pfad in die Zwischenablage kopieren" Dim String2 : String2 = Chr(34) & "WScript" & Chr(34) & Chr(32) & Chr(34) & Instpath & Chr(34) & Chr(32) & Chr(34) & "%1" & Chr(34) TextX = "" TextX = TextX & "Soll das Skript" & vbCRLF & vbCRLF TextX = TextX & vbTab & WScript.ScriptFullName & vbCRLF & vbCRLF TextX = TextX & "installiert oder ggf. deinstalliert werden?" & vbCRLF & vbCRLF TextX = TextX & "[Ja]" & vbTab & vbTab & "Installieren" & vbCRLF TextX = TextX & "[Nein]" & vbTab & vbTab & "Deinstallieren" & vbCRLF TextX = TextX & "[Abbrechen]" & vbTab & "Nichts tun" & vbCRLF TextX = MsgBox( TextX, vbYesNoCancel ) If TextX = vbNo Then On Error Resume Next ' Falls doch nichts installiert gewesen sein sollte WshShell.RegDelete RegKey2 WshShell.RegDelete RegKey1 WshShell.RegDelete RegKey4 WshShell.RegDelete RegKey3 CreateObject("Scripting.FileSystemObject").DeleteFile Instpath, True MsgBox "Alles von """ & WScript.ScriptName & """ entfernt." WScript.Quit End If ' TextX = vbNo Then If TextX = vbYes Then WshShell.RegWrite RegKey1, String1, "REG_SZ" WshShell.RegWrite RegKey2, String2, "REG_SZ" WshShell.RegWrite RegKey3, String1, "REG_SZ" WshShell.RegWrite RegKey4, String2, "REG_SZ" CreateObject("Scripting.FileSystemObject").CopyFile WScript.ScriptFullName, Instpath, True MsgBox "Die Erweiterung des Kontextmenüs " & vbCRLF & vbCRLF & vbTab & """" & String1 & """" & vbCRLF & vbCRLF & "ist jetzt verfügbar." WScript.Quit End If ' TextX = vbYes Then MsgBox "Denn eben nicht!" : WScript.Quit End Function ' unc2clipbrdInstall Function CheckRegKey(CheckKey) Dim Wert, Fehler On Error Resume Next Wert=WshShell.RegRead(CheckKey) Fehler=Err Err.Clear On Error Goto 0 CheckRegKey=Fehler=0 End Function Sub IE( UNCPfad ) ' MsgBox "UNCPfad: " & UNCPfad Set oIE = WScript.CreateObject("InternetExplorer.Application") oIE.navigate "about:blank" oIE.visible = 0 Do While (oIE.Busy) WScript.Sleep 50 Loop ' oIE.Document.parentWindow.clipboardData.setData "text", Chr(60) & UNCPfad & Chr(62) oIE.Document.parentWindow.clipboardData.setData "text", UNCPfad ' txt = oIE.document.parentWindow.clipboarddata.getData("text") ' MsgBox txt, ,"Zwischenablage:" oIE.Quit End Sub ' IE( UNCPfad )