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

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


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