This started out as a question in the software forum but, at this point I need the services of this part of the forum. I've don't most of what I set out to do but my script has a problem with files in the archive having unicode characters. Extraction works fine but when I pipe dir to the list.log nothing shows up. I was wondering if anyone can help me out. I would also like to only extract the file I need but in the end like I said the script works.
For those who don't want to read the other thread, the script goes through a directory, it will extract the archives I've set to a temp dir, list the names to a log to get the first file alphabetically, then it will rename that file and to the name of the archive it came from. All this so I can run visipics on the folder so I can find duplicates buy the cover.
So far as is the script helped me find 10G of duplicates.
Option Explicit
' Flags for the options parameter
Const BIF_returnonlyfsdirs = &H0001
Const BIF_dontgobelowdomain = &H0002
Const BIF_statustext = &H0004
Const BIF_returnfsancestors = &H0008
Const BIF_editbox = &H0010
Const BIF_validate = &H0020
Const BIF_browseforcomputer = &H1000
Const BIF_browseforprinter = &H2000
Const BIF_browseincludefiles = &H4000
Const OverwriteExisting = True
Dim folder, objFSO, objFolder, colFiles, objFile, objExtension, objShell, objLog
Dim sText, sCurPath, sTempPath, sFirstImg
sCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
sTempPath = sCurPath & "\temp"
'WScript.Echo sTempPath
folder = BrowseForFolder("Select a folder to get covers from", BIF_returnonlyfsdirs, "")
If folder = "-5" Then
WScript.Echo "Not possible to select files in root folder"
WScript.Quit
Else
If folder = "-1" Then
WScript.Echo "No object selected; Cancel clicked"
WScript.Quit
Else
'Folder path from browsforfolder
'WScript.Echo "Object: ", folder
End If
End If
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(folder)
Set objShell = CreateObject("WScript.Shell")
Set colFiles = objFolder.Files
For Each objFile in colFiles
'Wscript.Echo objFile.Name
objExtension = lcase(objFile)
'Wscript.Echo objExtension
'Wscript.Echo right(objExtension, 3)
If right(lcase(objExtension), 3) = "zip" or right(lcase(objExtension), 3) = "cbz" _
or right(lcase(objExtension), 3) = "cb7" or right(lcase(objExtension), 3) = "7z" _
or right(lcase(objExtension), 3) = "lzh" or right(lcase(objExtension), 3) = "rar" _
or right(lcase(objExtension), 3) = "cbr" or right(lcase(objExtension), 3) = "tar" _
or right(lcase(objExtension), 3) = "cbt" then
If Not objFSO.FolderExists(sTempPath) Then
objFSO.CreateFolder(sTempPath)
End If
'Wscript.Echo objFile
'list extract archive
objShell.Run "%comspec% /c" & sCurPath & "\7z.exe e " & """" & objfile _
& """ -o""" & sTempPath & """ -y", 7, true
objShell.Run "%comspec% /c dir /B " & sTempPath & " > list.log", 7, true
'dont think its doing anything
'objShell.Run "cmd /u /c dir /B " & sTempPath & " > list.log", 7, true
'log file is now unicode but opentext isn't
Set objLog = objFSO.OpenTextFile("list.log", 1)
Do While Not objLog.AtEndOfStream
sText = objLog.ReadLine
If right(lcase(sText),3) = "jpg" or right(lcase(sText),3) = "png" _
or right(lcase(sText),3) = "gif" or right(lcase(sText),3) = "tif" Then
sFirstImg = sTempPath & "\" & sText
sText = objFile.Name & "." & right(sText,3)
'WScript.Echo sFirstImg
'MsgBox(objFolder & "\" & sText)
If objFSO.FileExists (sFirstImg) then
objFSO.CopyFile sFirstImg, objFolder & "\" & sText, true
Else
'WScript.Echo sFirstImg
End If
Exit Do
End If
Loop
objLog.Close
'msgBox("Wait here")
objFSO.DeleteFile(sCurPath & "/" & "list.log")
objFSO.DeleteFolder sTempPath, 1
End If
Next
WScript.Echo "Script finished"
WScript.Quit
' Using the shell's BrowseForFolder method to
' return the full path to the selected object
' title = Text shown in the dialog box
' flag = One of the values for controlling the
' BrowseForFolder behavior
' dir = Preselected directory (can be "")
Function BrowseForFolder(title, flag, dir)
On Error Resume Next
Dim oShell, oItem, tmp
' Create WshShell object.
Set oShell = WScript.CreateObject("Shell.Application")
' Invoke Browse For Folder dialog box.
Set oItem = oShell.BrowseForFolder(&H0, title, flag, dir)
If Err.Number <> 0 Then
If Err.Number = 5 Then
BrowseForFolder= "-5"
Err.Clear
Set oShell = Nothing
Set oItem = Nothing
Exit Function
End If
End If
' Now we try to retrieve the full path.
BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path
' Handling: Cancel button and selecting a drive
If Err<> 0 Then
If Err.Number = 424 Then ' Handle Cancel button.
BrowseForFolder = "-1"
Else
Err.Clear
' Handle situation in which user selects a drive.
' Extract drive letter from the title--first search
' for a colon (:).
tmp = InStr(1, oItem.Title, ":")
If tmp > 0 Then ' A : is found; use two
' characters and add \.
BrowseForFolder = Mid(oItem.Title, (tmp - 1), 2) & "\"
End If
End If
End If
Set oShell = Nothing
Set oItem = Nothing
On Error GoTo 0
End Function
'*** End
I also want to have the script skip files Ive already have the covers for. Its probably real easy but I'm not seeing it.
Question
ChronoStriker1
This started out as a question in the software forum but, at this point I need the services of this part of the forum. I've don't most of what I set out to do but my script has a problem with files in the archive having unicode characters. Extraction works fine but when I pipe dir to the list.log nothing shows up. I was wondering if anyone can help me out. I would also like to only extract the file I need but in the end like I said the script works.
For those who don't want to read the other thread, the script goes through a directory, it will extract the archives I've set to a temp dir, list the names to a log to get the first file alphabetically, then it will rename that file and to the name of the archive it came from. All this so I can run visipics on the folder so I can find duplicates buy the cover.
So far as is the script helped me find 10G of duplicates.
Option Explicit ' Flags for the options parameter Const BIF_returnonlyfsdirs = &H0001 Const BIF_dontgobelowdomain = &H0002 Const BIF_statustext = &H0004 Const BIF_returnfsancestors = &H0008 Const BIF_editbox = &H0010 Const BIF_validate = &H0020 Const BIF_browseforcomputer = &H1000 Const BIF_browseforprinter = &H2000 Const BIF_browseincludefiles = &H4000 Const OverwriteExisting = True Dim folder, objFSO, objFolder, colFiles, objFile, objExtension, objShell, objLog Dim sText, sCurPath, sTempPath, sFirstImg sCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".") sTempPath = sCurPath & "\temp" 'WScript.Echo sTempPath folder = BrowseForFolder("Select a folder to get covers from", BIF_returnonlyfsdirs, "") If folder = "-5" Then WScript.Echo "Not possible to select files in root folder" WScript.Quit Else If folder = "-1" Then WScript.Echo "No object selected; Cancel clicked" WScript.Quit Else 'Folder path from browsforfolder 'WScript.Echo "Object: ", folder End If End If Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(folder) Set objShell = CreateObject("WScript.Shell") Set colFiles = objFolder.Files For Each objFile in colFiles 'Wscript.Echo objFile.Name objExtension = lcase(objFile) 'Wscript.Echo objExtension 'Wscript.Echo right(objExtension, 3) If right(lcase(objExtension), 3) = "zip" or right(lcase(objExtension), 3) = "cbz" _ or right(lcase(objExtension), 3) = "cb7" or right(lcase(objExtension), 3) = "7z" _ or right(lcase(objExtension), 3) = "lzh" or right(lcase(objExtension), 3) = "rar" _ or right(lcase(objExtension), 3) = "cbr" or right(lcase(objExtension), 3) = "tar" _ or right(lcase(objExtension), 3) = "cbt" then If Not objFSO.FolderExists(sTempPath) Then objFSO.CreateFolder(sTempPath) End If 'Wscript.Echo objFile 'list extract archive objShell.Run "%comspec% /c" & sCurPath & "\7z.exe e " & """" & objfile _ & """ -o""" & sTempPath & """ -y", 7, true objShell.Run "%comspec% /c dir /B " & sTempPath & " > list.log", 7, true 'dont think its doing anything 'objShell.Run "cmd /u /c dir /B " & sTempPath & " > list.log", 7, true 'log file is now unicode but opentext isn't Set objLog = objFSO.OpenTextFile("list.log", 1) Do While Not objLog.AtEndOfStream sText = objLog.ReadLine If right(lcase(sText),3) = "jpg" or right(lcase(sText),3) = "png" _ or right(lcase(sText),3) = "gif" or right(lcase(sText),3) = "tif" Then sFirstImg = sTempPath & "\" & sText sText = objFile.Name & "." & right(sText,3) 'WScript.Echo sFirstImg 'MsgBox(objFolder & "\" & sText) If objFSO.FileExists (sFirstImg) then objFSO.CopyFile sFirstImg, objFolder & "\" & sText, true Else 'WScript.Echo sFirstImg End If Exit Do End If Loop objLog.Close 'msgBox("Wait here") objFSO.DeleteFile(sCurPath & "/" & "list.log") objFSO.DeleteFolder sTempPath, 1 End If Next WScript.Echo "Script finished" WScript.Quit ' Using the shell's BrowseForFolder method to ' return the full path to the selected object ' title = Text shown in the dialog box ' flag = One of the values for controlling the ' BrowseForFolder behavior ' dir = Preselected directory (can be "") Function BrowseForFolder(title, flag, dir) On Error Resume Next Dim oShell, oItem, tmp ' Create WshShell object. Set oShell = WScript.CreateObject("Shell.Application") ' Invoke Browse For Folder dialog box. Set oItem = oShell.BrowseForFolder(&H0, title, flag, dir) If Err.Number <> 0 Then If Err.Number = 5 Then BrowseForFolder= "-5" Err.Clear Set oShell = Nothing Set oItem = Nothing Exit Function End If End If ' Now we try to retrieve the full path. BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path ' Handling: Cancel button and selecting a drive If Err<> 0 Then If Err.Number = 424 Then ' Handle Cancel button. BrowseForFolder = "-1" Else Err.Clear ' Handle situation in which user selects a drive. ' Extract drive letter from the title--first search ' for a colon (:). tmp = InStr(1, oItem.Title, ":") If tmp > 0 Then ' A : is found; use two ' characters and add \. BrowseForFolder = Mid(oItem.Title, (tmp - 1), 2) & "\" End If End If End If Set oShell = Nothing Set oItem = Nothing On Error GoTo 0 End Function '*** EndI also want to have the script skip files Ive already have the covers for. Its probably real easy but I'm not seeing it.
Link to comment
Share on other sites
3 answers to this question
Recommended Posts