'Irfanview bucket v1.81 'Setup include_subs = True 'set to True to include subfolders, False if not to strImages= "JPG|JPEG|GIF|BMP|DIB|TIF|TIFF|PNG|TXT" strTextfiles = "TXT|LST" Set objFSO = CreateObject("Scripting.FileSystemObject") Set objShell = CreateObject("WScript.Shell") strVBS = Wscript.ScriptFullName strDesktop= objShell.SpecialFolders("Desktop") strTempfile= strDesktop & "\Bucket list.txt" : lastsize = 0 strShortcut= strDesktop & "\" & Replace(Wscript.Scriptname,".vbs",".lnk",1,1,1) strApp= Relocate(":\Irfanview\i_view32.exe", strVBS) If NOT objFSO.FileExists(strApp) then set f1=objFSO.GetFile(strVBS) Msgbox "Irfanview not found in" &vbCrLf& f1.Parentfolder,48,"NO PROGRAM" WScript.quit End If 'Main Program If NOT objFSO.FileExists(strShortcut) then Make_link strApp = chr(34) & strApp & chr(34) Set f1 = objFSO.OpenTextFile(strTempfile, 8, True) If WScript.Arguments.Count >0 then For n=0 to Wscript.Arguments.Count -1 strArg = Wscript.Arguments(n) If objFSO.Folderexists(strArg)then Set objFldr = objFso.GetFolder(StrArg) Unpack objFldr Set objFolder = Nothing ElseIf IsWanted(strArg, strTextfiles) then set fList = objFSO.OpenTextFile(strArg,1) If strArg = strTempfile then f1.WriteLine(strFile) Else Do while fList.AtEndofStream=False strFile = fList.ReadLine strFile = Relocate(strFile,strArg) If IsWanted(strFile,strImages) then f1.WriteLine(strFile) Loop End If Set fList = Nothing Else If IsWanted(strArg, strImages) then f1.WriteLine(strArg) End If Next End If Set f1 = objFSO.GetFile(strTempfile) If lastsize <> -1 then lastsize = f1.size objShell.Run strApp &" /killmesoftly", 1, true objShell.Run strApp &" /filelist=" & strTempfile, 1, true If objFSO.FileExists(strtempfile) then If f1.size = lastsize then objFSO.Deletefile(strtempfile) End If If lastsize= 0 then clear_desk Set f1 = Nothing Set objShell = Nothing Set objFSO = Nothing WScript.Quit 'Function to filter which filetypes you want to include Function IsWanted(filename,filter) If len(filter)<2 then IsWanted=True : Exit function filetype ="|" & UCase(objFSO.GetExtensionName(filename)) & "|" filter = "|" & filter & "|" If Instr(1,filter,filetype,1)=0 then IsWanted=False else IsWanted=True End Function 'Special function to repair incorrect paths by relocating files Function Relocate(filename, guide) If objFSO.FileExists(filename) then Relocate = filename :Exit Function usplit =instr(guide, ":") Do uslash=instr(usplit+1,guide,"\",1) If uslash > 0 then look_for = mid(guide,usplit,uslash-usplit) & "\" usplit = uslash fsplit = instr(1,filename,look_for,1)+len(look_for) If fsplit >len(look_for) then Relocate = left(guide,usplit) & mid(filename,fsplit) If objFSO.FileExists(Relocate) then Exit Do End If Else Relocate = Left(guide,usplit)& Mid(filename,InstrRev(filename,"\")+1) If objFSO.FileExists(Relocate) then Exit Do Relocate = filename : Exit Do End If Loop End Function 'Function to unpack folder and subfolders recursively Sub Unpack(fldr) Set Colln = fldr.files For each strFile in Colln If IsWanted(strFile,strImages) then f1.WriteLine(strFile) Next If include_subs = true then For Each subfldr in fldr.Subfolders Unpack subfldr Next End If Set Colln = Nothing End Sub 'Subroutine to create a shortcut to Irfanview on the desktop Sub Make_link set objShellLink = objShell.CreateShortcut(strShortcut) objShellLink.TargetPath = strVBS objShellLink.WindowStyle = 1 objShellLink.IconLocation = Replace (strApp,".exe",".ico",1,1,1) objShellLink.Description = "Shortcut to script" objShellLink.WorkingDirectory = strApp objShellLink.Save lastsize = -1 End Sub Sub Clear_desk Ask="HAVE YOU FINISHED?" Info="Press OK to close the session and clear the Desktop" & vbCrLf Info=Info & vbCrLf & "or Cancel to continue using Irfanview Bucket" Button = Msgbox (Info, 4096+32+1, Ask) Select Case Button Case vbCancel 'No action Case vbOK If objFSO.FileExists(strShortcut) then objFSO.deletefile(strShortcut) If objFSO.FileExists(strTempfile) then objFSO.deletefile(strTempfile) objShell.Run strApp &" /killmesoftly", 1, true End Select End Sub