' -------------------------------------------------------------- ' This script searches for a specific picture in subfolders of ' all album songs and copies it into the jukebox picture database. ' (if no picture is already assigned to selected album) ' ' Written by T.G.ViRUS - 06.01.2005 ' -------------------------------------------------------------- Sub Main() Dim strAsk1, strTxt1, strTxt2, strTxt3, strTxt4 Dim strAlbumName, strRootPath Dim strPicName, strPrefix Dim lngCount, lngProcessed Dim lngFound strAsk1 = "This script searches for a specific picture in subfolders of" & vbCrLf strAsk1 = strAsk1 & "all album songs and copies it into the jukebox picture database." & vbCrLf strAsk1 = strAsk1 & "(if no picture is already assigned to selected album)" & vbCrLf & vbCrLf strAsk1 = strAsk1 & "Name of picture file to search for (i.e.: picture.jpg, folder.jpg)" strTxt1 = "Search folder picture from Song " strTxt2 = " of " strTxt3 = "Found and copied: " strTxt4 = "Search for pictures finished!" If CURRENT_ALBUM = - 1 Then MsgBox("No Album selected!") Exit Sub End If strPrefix = "A " 'Album prefix strPicName = InputBox(strAsk1, "folder.jpg") If strPicName = "" Then Exit Sub 'Loop through all album songs now... rs.Open("SELECT Album, Artist, PathOfSong from qry_Song WHERE AlbumFX=" & CURRENT_ALBUM) lngCount = rs.RecordCount lngProcessed = 0 lngFound = 0 db.StartProgressMonitor(lngCount) Do Until rs.EOF strAlbumName = NameToFile(rs.GetField("Album")) strRootPath = fs.GetParentFolderName(db.SQLToPath(rs.GetField("PathOfSong"))) If Right(strRootPath, 1) <> "\" Then strRootPath = strRootPath & "\" If CopyPicture(strPrefix & strAlbumName, strRootPath & strPicName) Then lngFound = lngFound + 1 End If lngProcessed = lngProcessed + 1 If (lngProcessed Mod 10) = 0 Then db.PrintProgressMonitor(strTxt1 & lngProcessed & strTxt2 & lngCount & vbCrLf & strTxt3 & lngFound) End If db.SetProgressMonitor(lngProcessed) rs.MoveNext Loop db.PrintProgressMonitor(strTxt3 & lngFound & vbCrLf & strTxt4) db.EndProgressMonitor db.RefreshAlbums End Sub '--------------------------------------------------------- ' Copy existing Picture to the Jukebox picture database '--------------------------------------------------------- Function CopyPicture(vstrName, vstrPicturePath) Dim strExt Dim strDestPic ' Search now for picture in folders If fs.FileExists(vstrPicturePath) Then strExt = fs.GetExtensionName(vstrPicturePath) strDestPic = App.Path & "\Pictures\" & vstrName & "." & strExt ' Don't overwrite existing pictures If Not fs.FileExists(strDestPic) Then ' Copy picture now to picture database fs.CopyFile(vstrPicturePath, strDestPic) Return True End If End If Return False End Function '--------------------------------------------------------- ' Convert Album Name to a file compatible format '--------------------------------------------------------- Function NameToFile(vstrName) Dim strNewName strNewName = Replace(vstrName, Chr(160), " ") strNewName = Replace(strNewName, "/", "_") strNewName = Replace(strNewName, "\", "_") strNewName = Replace(strNewName, ":", ";") strNewName = Replace(strNewName, "*", ".") strNewName = Replace(strNewName, "|", "!") strNewName = Replace(strNewName, "?", "!") strNewName = Replace(strNewName, """", "'") strNewName = Replace(strNewName, ">", "") strNewName = Replace(strNewName, "<", "") Return strNewName End Function