' © Wim Gielis - wim.gielis@gmail.com - Oct/2012 ' Basis of the skeleton of the script: ' Bill James - http://www.billsway.com/vbspage/ShowScript.asp?tgt=txtfiles/NewFolder.txt ' Zip de file en delete de file nadien automatisch. ' In het context menu dat je krijgt bij een rechtermuisklik op een bestand, komt een extra menu. ' Dit geldt enkel voor individuele bestanden (niet voor drives en mappen) ' Gebruiksaanwijzing: dubbelklik op dit .vbs bestand om te installeren. ' Om te desinstalleren; dubbelklik hierop nogmaals ' Er wordt een entry in het register bijgeschreven en verwijderd ' Code vereist WSH 2.0 + Option Explicit Const vRegPath="HKCR\*\shell\ZipAndDelete\" Dim fso, ws, Args, Titel, s7zLocation, sArchiveName, sFile, p Set fso = CreateObject("Scripting.FileSystemObject") Set ws = CreateObject("Wscript.Shell") Set Args = WScript.Arguments Titel = "Zip and delete" 'Kijk of de juiste versie aanwezig is om dit script uit te voeren If WScript.Version < 5.1 Then ws.Popup "Je hebt Windows Script Host 2.0 + nodig om dit script uit te voeren.", , Titel, 0 + 48 + 4096 Call Cleanup End If 'Als het script rechtstreeks benaderd werd (niet via rechtermuisklik), voer setup uit en installeer/desinstalleer If Args.Count = 0 Then Call Setup 'Zorg ervoor dat meerdere keren drag en drop niet toegelaten is If Args.Count > 1 Then Call Cleanup Call ZipAndDelete Call Cleanup Sub ZipAndDelete 'main code: zip and delete s7zLocation = "C:\Program Files\7-Zip\" sArchiveName = fso.GetParentFolderName(Args(0)) & "\" & fso.GetBaseName(Args(0)) & ".zip" sFile = Args(0) If lcase(fso.GetExtensionName(sFile)) <> "zip" Then If fso.FileExists(sArchiveName) Then fso.DeleteFile sArchiveName, True End If ws.Run """" & s7zLocation & "7z"" a -tzip -y " & chr(34) & sArchiveName & chr(34) & " " & chr(34) & sFile & chr(34), 0, True If lcase(fso.GetExtensionName(sFile)) <> "zip" Then fso.DeleteFile sFile, True End Sub Sub Setup 'Pas het register aan indien het pad niet bestaat of ongeldig is. On Error Resume Next p = ws.RegRead(vRegPath & "command\") p = Mid(p, 10, Len(p) - 15) Err.Clear:On Error GoTo 0 If Not fso.FileExists(p) Then If ws.Popup("Wil je het item voor het rechtermuismenu installeren?", , Titel, 4 + 32 + 4096) <> 6 Then Call Cleanup End If ws.RegWrite vRegPath, "&" & Titel ws.RegWrite vRegPath & "command\", "WScript " & chr(34) & WScript.ScriptFullName & chr(34) & " " & chr(34) & "%1" & chr(34) ws.Popup "Het item werd toegevoegd. Doe een rechtermuisklik op een file, drive of map in de Windows Verkenner en selecteer de optie " & chr(34) & Titel & chr(34) & "." & vbcrlf & vbcrlf & _ "Om de optie te verwijderen, voer het script opnieuw uit" & vbCrLf & "(dubbelklik op dit bestand).", , Titel, 64 + 4096 Else If ws.Popup("Wil je het item voor het rechtermuismenu verwijderen?", , Titel, 4 + 32 + 4096) <> 6 Then Call Cleanup End If ws.RegDelete vRegPath & "command\" ws.RegDelete vRegPath ws.Popup "Het item werd verwijderd.", , Titel, 64 + 4096 End If Call Cleanup End Sub Sub Cleanup Set ws = Nothing Set fso = Nothing Set Args = Nothing WScript.Quit End Sub