pcwMultilink.V2.VBS

' pcwMultilink.V2 dient zum bequemen Einrichten multifunktionaler Desktop-Icons.
' Sie erstellen einfach normale Links im automatisch geöffneten Ordner Links.TMP.
' Auf Basis dieser Information erstellt das Script ein einzelnes Icon, das im 
' Kontextmenü alle gewünschten Einträge erhält.
' Die Links unter Links.TMP und der Ordner selbst werden automatisch wieder gelöscht.
'
' Das Script benötigt keine Installation, kann in jedem Ordner liegen und beliebig
' verschoben oder umbenannt werden.
' Aufruf einfach per Doppelklick.
' Um einen Multilink zu löschen, verwenden Sie Drag & Drop auf das Script.
 
dim menuname(50)
dim programm(50)
dim ziel(50)
dim Parameter(50)
dim myDesktop
Set myfiles = CreateObject("Scripting.FileSystemObject")
Set myshell = CreateObject("Wscript.Shell")
Set myEnv = myShell.Environment("PROCESS")
set myArgs=wscript.arguments
mydesktop=myShell.SpecialFolders("Desktop")
tempfolder=myEnv("TEMP") & "\Links.TMP"
 
'Drag & Drop (Löschen eines Multilinks) ?
if myArgs.Count > 0 then 
        DeleteLink myArgs(0)
        wscript.quit
end if
 
on error resume next
MyFiles.CreateFolder(tempfolder)
myShell.run "explorer.exe /n," & tempfolder,1,true
wscript.sleep 1000
msgbox "Gewünschte Links bitte im geöffneten Ordner 'Links.tmp' anlegen." _
        & chr(13) & chr(13) & "Eventuell Link-Namen anpassen." _
        & chr(13) & chr(13) & "Dateiendungen wie '.EXE' werden gegebenenfalls automatisch entfernt." _
        & chr(13) & "Präfix 'Verknüpfung mit' ('Shortcut to') wird ebenfalls getilgt." _
        & chr(13) & "Ansonsten (Gross/Kleinschreibung etc.) erscheinen die Menüeinträge " _
        & chr(13) & "des Multi-Icons später genau so wie die hier abgelegten Link-Namen." _
        & chr(13) & chr(13) & "Am Ende - nach dem Sammeln aller Links - hier weiter mit 'OK' ..." _
        & chr(13) & chr(13) & "[Die temporären Links unter 'Links.tmp' werden anschließend gelöscht.]",," Neuen Multilink erstellen"
 
set lnkfolder=MyFiles.Getfolder(tempfolder)
set linkfiles=lnkfolder.Files
for each link in linkfiles
        check=ucase(right(link.name,4))
        if check=".LNK" Or check=".PIF" then
                clink=clink+1
                menuname(clink)=link.name
                i=instr(menuname(clink),".")
                menuname(clink)=left(menuname(clink),i-1)
                menuname(clink)=replace(menuname(clink),"Verknüpfung mit ","")
                menuname(clink)=replace(menuname(clink),"Shortcut to ","")
 
                set multilink=MyShell.CreateShortcut(link.path)
                Ziel(clink)=multilink.Targetpath
                Ziel(clink)=replace(Ziel(clink),chr(34),"")
                Parameter(clink)=multilink.Arguments
                if myFiles.FolderExists(Ziel(clink)) then
                        ziel(clink)="explorer.exe /n," & chr(34) & ziel(clink) & chr(34)
                        Programm(clink)="explorer.exe"
                else
                        temp=lcase(right(ziel(clink),4))
                        if temp=".exe" or temp=".com" or temp=".bat" then
                                Programm(clink)=Ziel(clink)
                                Ziel(clink)=chr(34) & Ziel(clink) & chr(34) & " " & parameter(clink)
                        else
                                ftype=myShell.regread("HKCR\" & temp & "\")
                                programm(clink)=myShell.regread("HKCR\" & ftype & "\shell\open\command\")
                                programm(clink)=replace(programm(clink),chr(34),"")
                                i=instr(lcase(programm(clink)),".exe")
                                if i=0 then i=instr(lcase(programm(clink)),".com")
                                if i=0 then i=instr(lcase(programm(clink)),".bat")
                                programm(clink)=left(programm(clink),i+3)
                                ziel(clink)=chr(34) & programm(clink) & chr(34) & " " & chr(34) & ziel(clink) & chr(34)
                        end if
                        ziel(clink)=replace(ziel(clink),"%SystemRoot%",myEnv("SYSTEMROOT"))
                        ziel(clink)=replace(ziel(clink),"%ProgramFiles%",myEnv("PROGRAMFILES"))
                        programm(clink)=replace(programm(clink),"%SystemRoot%",myEnv("SYSTEMROOT"))
                        programm(clink)=replace(programm(clink),"%ProgramFiles%",myEnv("PROGRAMFILES"))
                end if        
        Ziel(clink)=inputbox("Bitte prüfen Sie den Link..."," Multilink erstellen",Ziel(clink))
        end if
next
 
if clink=0 then
        msgbox "Keine Links unter " & tempfolder & " gefunden.",," Multilink"
        myFiles.DeleteFolder tempfolder,True
        wscript.quit
end if
 
for temp=1 to clink
        allmenus=allmenus & "(" & temp & ") " & menuname(temp) & chr(13)
next
 
'Hauptjob auswählen
mainjob=inputbox(clink & " Links gefunden. Hauptlink auswählen:" & chr(13) & chr(13) & allmenus," Multilink erstellen")
for temp=1 to clink
        if mainjob = cstr(temp) then mainok=1
next
 
if mainok=0 then 
        msgbox "Es wurde kein Hauptlink ausgewählt.",,"Abbruch"
        myFiles.DeleteFolder tempfolder,True
        wscript.quit
end if
 
'Der Hauptjob ist Drag & Drop-fähig (sofern das gewählte Programm dies unterstützt)
if Parameter(mainjob)="" then
        MainCommand=ziel(mainjob) & " %*"
else
        MainCommand=ziel(mainjob) & " " & Parameter(mainjob) & " %*"
end if
 
'Registry abfragen, was schon da ist (mit '089')
do
        count=count + 1
        regkey="HKCR\.089" & count & "\" 
        err.clear
        tmp=myshell.regRead(regkey)
loop while err.number=0
 
Dateityp=".089" & count
datei=mydesktop & "\" & menuname(mainjob) & Dateityp
 
'Symbol einrichten
if programm(mainjob)="explorer.exe" then
        symbol="Shell32.dll,3"
else
msgbox programm(mainjob)
        if ucase(right(programm(mainjob),4))=".EXE" then 
                symbol=programm(mainjob) & ",0"
        else
                symbol="pifmgr.dll," & count                
        end if
end if
 
'künstlichen Dateityp in die Registry eintragen
myshell.regwrite("HKCR\" & Dateityp & "\"),""
myshell.regwrite("HKCR\" & Dateityp & "\NeverShowExt"),""
myshell.regwrite("HKCR\" & Dateityp & "\DefaultIcon\"),symbol
myshell.regwrite("HKCR\" & Dateityp & "\ScriptEngine\"),"VBScript"
myshell.regwrite("HKCR\" & Dateityp & "\Shell\"),""
myshell.regwrite("HKCR\" & Dateityp & "\Shell\Open\"),menuname(mainjob)
myshell.regwrite("HKCR\" & Dateityp & "\Shell\Open\Command\"),maincommand
myshell.regwrite("HKCR\" & Dateityp & "\ShellEx\"),""
myshell.regwrite("HKCR\" & Dateityp & "\ShellEx\DropHandler\"),"{60254CA5-953B-11CF-8C96-00AA00B8708C}"
myshell.regwrite("HKCR\" & Dateityp & "\Shell\{Notizen}\"),""
myshell.regwrite("HKCR\" & Dateityp & "\Shell\{Notizen}\Command\"),"notepad.exe " & datei
 
for temp=1 to clink
        if cstr(temp) <> cstr(mainjob) then 
                myshell.regwrite("HKCR\" & Dateityp & "\Shell\" & menuname(temp) & "\"),""
                myshell.regwrite("HKCR\" & Dateityp & "\Shell\" & menuname(temp) & "\Command\"),ziel(temp) & " " & parameter(temp)
        end if
next
 
'Datei am Desktop anlegen
set multilink=myFiles.CreateTextFile(datei)
multilink.writeline ".LOG   ---  NOTIZEN  ---  NOTIZEN  ---  NOTIZEN ---"
multilink.close
myFiles.DeleteFolder tempfolder,True
 
'------------------------------------------------------------------------------
Sub DeleteLink (ByVal Datei)
Erweiterung=myFiles.GetExtensionName(datei)
if left(erweiterung,3)<>"089" then
        msgbox "Das gedroppte Objekt ist kein Multilink...",," Multilink löschen"
        wscript.quit
end if
tmp=msgbox(datei & chr(13) & "entfernen und den Dateityp " & Erweiterung _
        & " aus der Registry löschen?",4," Multilink löschen")
if tmp=7 then wscript.quit
tmp=myFiles.DeleteFile(datei,TRUE)
Import=myDesktop & "\pcwtemp.reg"
set myImport=myFiles.CreateTextFile(Import)
myImport.writeline "REGEDIT4"
myImport.writeline ""
myImport.writeline "[-HKEY_CLASSES_ROOT\." & erweiterung & "]"
myImport.close
wscript.sleep 500
myShell.run "regedit.exe /s " & chr(34) & Import & chr(34),,TRUE
wscript.sleep 500
tmp=myFiles.DeleteFile(import,TRUE)
end sub