' MagicNode Script ' Version 1.3b ' ' This Script allows the creation of new tree nodes based on user-definable masks similar to those ' Used in auto-organize (with some differences) ' ' Thanks to all the people who contributed with comments, feedback and scripts which I used to learn. ' ' This script can be freely used and modified. However, if you do something interesting with it let me know. ' This is an early release and there may be bugs. If it's causing you problems, simply delete ' it or move it out of the scripts\auto folder. ' ' This version of the script for the first time modifies the database, during drag&drop operations. ' Furthermore, this can be considered a beta release, so it is possible drag&drop will not work ' as intended. You are strongly encouraged to backup your database or abstain from using drag&drop on Magic nodes. ' ' You can cancel drag&drop functionality altogether by doing the following: look for and delete the line ' ' newNode.OnDragDrop = "CustomDragDrop" ' ' ' The rest of the script does not modify the database or registry. It only adds some lines to the ini file, ' so it shouldn't cause any lasting damage. Option Explicit '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Localized Strings '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 'This section will slowly grow to contain all localizable strings in the script. 'The next array contains all articles, such as "the" in English that should be omitted/removed if at the 'beginning of an artist name. Dim Articles(1) Articles(1) = "The" '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Global Variables and Declarations '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Dim RE ' A RegularExpression object available to help parse the mask defining the node Dim Matches ' A collection of matches for the regular expression Dim Match ' A specific Match Set RE = new RegExp RE.IgnoreCase = True RE.Global = True 'Increase this value if you plan to use more magic nodes Const MasksInIniFile = 20 '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Field Definitions '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 'Retrieve Custom Field Headings Function CF(i) CF = UCase(SDB.IniFile.StringValue("CustomFields","Fld" & i & "Name")) End Function 'In order to allow the use of a field in the mask, its properties have to be provided as items 'in the following Dictionaries Dim FieldDict Set FieldDict = CreateObject("Scripting.Dictionary") With FieldDict .Add "TITLE","Songs.SongTitle" .Add "ARTIST","Artists.Artist" .Add "ALBUM ARTIST", "Artists.Artist" .Add "ALBUM", "Albums.Album" .Add "ALBUM AND ARTIST", "Albums.Album & ' (' & Artists.Artist & ')'" .Add "ALBUM AND YEAR", "Artists.Artist & ' - ' & Albums.Album & ' (' & IIF(Songs.Year>1900, Songs.Year, '????') & ')'" .Add "GENRE","Genres.GenreName" .Add "YEAR", "Songs.Year" .Add "BITRATE", "(32*Round(Songs.Bitrate/32000))" .Add "RATING", "Songs.Rating/20" .Add CF(1), "Songs.Custom1" .Add CF(2), "Songs.Custom2" .Add CF(3), "Songs.Custom3"' .Add "COMMENT", "Memos.MemoText" .Add "PLAYLIST", "Playlists.PlaylistName" .Add "PLAYED", "Songs.PlayCounter" 'Thanks to Bex for the improved format field .Add "FORMAT", "IIf(Left(Right(songpath,3),1)='.', " & "Right(songpath,2), "& _ "IIf(Left(Right(songpath,4),1)='.', " & "Right(songpath,3), "& _ "IIf(Left(Right(songpath,5),1)='.', " & "Right(songpath,4), "& _ "IIf(Left(Right(songpath,6),1)='.', " & "Right(songpath,5), "& _ "Right([songpath],6)))))" .Add "PUBLISHER", "AddSongInfo.TextData" .Add "LYRICIST", "AddSongInfo.TextData" .Add "INVOLVED PEOPLE", "AddSongInfo.TextData" .Add "ORIGINAL ARTIST", "AddSongInfo.TextData" .Add "ORIGINAL YEAR", "AddSongInfoInt.IntData" .Add "COMPOSER", "Songs.Author" .Add "TEMPO", "Lists.TextData" .Add "MOOD", "Lists.TextData" .Add "OCCASION", "Lists.TextData" .Add "QUALITY", "Lists.TextData" .Add "LEVELING", "Int(Songs.NormalizeTrack)" .Add "LENGTH", "Int(Songs.SongLength/60000)" .Add "VBR", "Songs.VBR" .Add "BPM", "Songs.BPM" .Add "PLAY RATE", "Int(DateDiff('d',songs.dateadded, now)/songs.playCounter)" .Add "TIME SINCE LAST PLAYED", "IIF(DateDiff('n',Songs.LastTimePlayed, Now)<60, 0, " & _ "IIF(DateDiff('h',Songs.LastTimePlayed, Now)<24, 1, " & _ "IIF(DateDiff('d',Songs.LastTimePlayed, Now)<7, 2, " & _ "IIF(DateDiff('d',Songs.LastTimePlayed, Now)<30, 3, " & _ "IIF(DateDiff('d',Songs.LastTimePlayed, Now)<365, 4, " & _ " 5)))))" .Add "DRIVE TYPE", "IIF(Songs.CacheStatus=1, 'Virtual CD', " & _ "IIF(Medias.DriveType=3, 'HD', " & _ "IIF(Medias.isAudioCD=1, 'Audio CD', " & _ "IIF(Medias.DriveType=5, 'CD/DVD', " & _ "IIF(Medias.DriveType=2, 'Other removable media', " & _ "IIF(Medias.DriveType=6, 'RAM disk', " & _ "IIF(Medias.DriveType=12345, 'Network', " & _ "'Other')))))))" .Add "DAYS SINCE LAST PLAYED", "DateDiff('d', Songs.LastTimePlayed, Now)" .Add "DAYS SINCE ADDED", "DateDiff('d', Songs.DateAdded, Now)" .Add "COVER STORAGE", "IIF(Covers.CoverStorage=0, 'Tag', 'Image file')" .Add "COVER TYPE", "Covers.CoverType" .Add "DATE ADDED", "DateValue(CDate(Songs.DateAdded))" .Add "SAMPLE RATE", "Songs.SamplingFrequency/1000 & ' khz' " End With Dim IdFieldDict Set IdFieldDict = CreateObject("Scripting.Dictionary") With IdFieldDict '.Add "TITLE", "Songs.Id" .Add "ARTIST", "Songs.IdArtist" .Add "ALBUM ARTIST", "Albums.IdArtist" .Add "ALBUM", "Songs.IdAlbum" .Add "ALBUM AND ARTIST", "Songs.IdAlbum" .Add "ALBUM AND YEAR", "Songs.IdAlbum" .Add "GENRE", "Songs.Genre" .Add "PLAYLIST", "Playlists.IdPlaylist" .Add "TEMPO", "Lists.Id" .Add "MOOD", "Lists.Id" .Add "OCCASION", "Lists.Id" .Add "QUALITY", "Lists.Id" .Add "SAMPLE RATE", "Songs.SamplingFrequency" End With 'Whether the ID Field is numeric. If it's not, then it needs to be escaped when part of an SQL query Dim isNumericDict Set isNumericDict = CreateObject("Scripting.Dictionary") With isNumericDict .Add "TITLE", False .Add "ARTIST", True .Add "ALBUM ARTIST", True .Add "ALBUM", True .Add "ALBUM AND ARTIST", True .Add "ALBUM AND YEAR", True .Add "GENRE", True .Add "YEAR", True .Add "BITRATE", True .Add "RATING", True .Add CF(1), False .Add CF(2), False .Add CF(3), False .Add "COMMENT", False .Add "PLAYLIST", True .Add "PLAYED", True .Add "FORMAT", False .Add "PUBLISHER", False .Add "LYRICIST", False .Add "INVOLVED PEOPLE", False .Add "ORIGINAL ARTIST", False .Add "ORIGINAL YEAR", True .Add "COMPOSER", False .Add "TEMPO", True .Add "MOOD", True .Add "OCCASION", True .Add "QUALITY", True .Add "LEVELING", True .Add "LENGTH", True .Add "VBR", True .Add "BPM", True .Add "PLAY RATE", True .Add "TIME SINCE LAST PLAYED", True .Add "DRIVE TYPE", False .Add "DAYS SINCE LAST PLAYED", True .Add "DAYS SINCE ADDED", True .Add "COVER STORAGE", False .Add "COVER TYPE", True .Add "DATE ADDED", False .Add "SAMPLE RATE", True End With 'The next dictionary specifies which type of code should perform a drop operation. ' - 1 means the properties are changed using a SongData object. ' - 2 means the properties are changed using an UPDATE SQL query (SDB.Database.ExecSQL) ' - 3 means the properties are changed using either an INSERT or UPDATE SQL query, depending on whether ' the property is already defined for each song. 'Fields which shouldn't be targets of drag&drop operations don't define an entry in this dictionary. Dim DragDropTypeDict Set DragDropTypeDict = CreateObject("Scripting.Dictionary") With DragDropTypeDict .Add "ARTIST", 2 .Add "ALBUM ARTIST", 2 .Add "ALBUM", 2 .Add "GENRE", 2 .Add "YEAR", 1 .Add "RATING", 1 .Add CF(1), 1 .Add CF(2), 1 .Add CF(3), 1 .Add "LYRICIST", 1 .Add "INVOLVED PEOPLE", 1 .Add "ORIGINAL ARTIST", 1 .Add "ORIGINAL YEAR", 1 .Add "COMPOSER", 1 .Add "BPM", 1 End With 'The next dictionary specifies the VBscript operation performing the drop operation. 'The format used depends on the drag&drop type defined in DragDropTypeDict. 'For type 1, the value must be an assignment statement which updates the relevant field of the SongData object. 'For type 2, the value is the UPDATE query to be performed. 'Type 3 hasn't been implemented yet. 'The following special symbols are available: ' - @song denotes the SongData object being modified. ' - @idsong denotes the ID of the song being modified ' - @idvalue denotes the ID associated to the value being assigned (i.e. if the drop is on an artist node, it is the artist id) Dim DragDropDict Set DragDropDict = CreateObject("Scripting.Dictionary") With DragDropDict .Add "ARTIST", "UPDATE Songs SET idArtist = @idvalue WHERE Id = @idsong" .Add "ALBUM ARTIST", "UPDATE Albums, Songs SET Albums.idArtist = @idvalue WHERE Songs.Id = @idsong and Songs.idAlbum = Albums.id" .Add "ALBUM", "UPDATE Songs SET idAlbum = @idvalue WHERE Id = @idsong" .Add "GENRE", "UPDATE Songs SET genre = @idvalue WHERE Id = @idsong" .Add "YEAR", "@song.Year = @idvalue" .Add "RATING", "@song.Rating = 20 * @idvalue" .Add CF(1), "@song.custom1 = @idvalue" .Add CF(2), "@song.custom2 = @idvalue" .Add CF(3), "@song.custom3 = @idvalue" .Add "LYRICIST", "@song.lyricist = @idvalue" .Add "INVOLVED PEOPLE", "@song.involvedpeople = @idvalue" .Add "ORIGINAL ARTIST", "@song.originalartist = @idvalue" .Add "ORIGINAL YEAR", "@song.originalyear = @idvalue" .Add "COMPOSER", "@song.author = @idvalue" .Add "BPM", "@song.BPM = @idvalue" End With 'When the result of a drop operation isn't totally obvious, a prompt should be displayed explaining 'the operation and giving the chance to cancel. The appropriate prompt is defined in the following dictionary. 'In future versions, the user will have the option of selecting "Don't show this message again". Dim DragDropPromptDict Set DragDropPromptDict = CreateObject("Scripting.Dictionary") With DragDropPromptDict .Add "ALBUM ARTIST", "Since Album Artists are associated to ALBUM AND YEARs, rather than Songs, the Album Artist " _ & "will be updated for all Albums containing the selected tracks, not the tracks themselves. Are you sure you want to continue? " End With ' When ordering some fields any leading articles such as "The" should be ignored. ' The fields that are keys of this dictionary will behave in this way. Dim IgnoreArticleDict Set IgnoreArticleDict = CreateObject("Scripting.Dictionary") With IgnoreArticleDict .Add "ARTIST", True .Add "ALBUM ARTIST", True .Add "ORIGINAL ARTIST", True End with 'Some fields need to be formatted for presentation. For those fields, the following dictionary 'defines the function which does the formatting. This function takes an argument, the actual 'value of the record. Dim FormattingDict Set FormattingDict = CreateObject("Scripting.Dictionary") With FormattingDict .Add "RATING", "FormatRating" .Add "LEVELING", "FormatLeveling" .Add "LENGTH", "FormatLength" .Add "VBR", "FormatVBR" .Add "PLAY RATE", "FormatPlayRate" .Add "TIME SINCE LAST PLAYED", "FormatTimeSinceLastPlayed" .Add "COVER TYPE", "FormatCoverType" End With Dim IconDict Set IconDict = CreateObject("Scripting.Dictionary") With IconDict .Add "TITLE", 14 .Add "ARTIST", 0 .Add "ALBUM ARTIST", 0 .Add "ALBUM AND ARTIST", 16 .Add "ALBUM AND YEAR", 16 .Add "ALBUM", 16 .Add "YEAR", 2 .Add "BITRATE", 3 .Add "GENRE", 7 .Add "RATING", 33 .Add CF(1), 11 .Add CF(2), 11 .Add CF(3), 11 .Add "COMMENT", 23 .Add "PLAYLIST", 4 .Add "PLAYED", 8 .Add "FORMAT", 25 .Add "PUBLISHER", 44 .Add "LYRICIST", 0 .Add "INVOLVED PEOPLE", 0 .Add "ORIGINAL ARTIST", 0 .Add "ORIGINAL YEAR", 2 .Add "COMPOSER", 0 .Add "TEMPO", 29 .Add "MOOD", 30 .Add "OCCASION", 31 .Add "QUALITY", 32 .Add "LEVELING", 3 .Add "LENGTH", 3 .Add "VBR", 3 .Add "BPM", 3 .Add "PLAY RATE", 18 .Add "TIME SINCE LAST PLAYED", 18 .Add "DRIVE TYPE", 43 .Add "DAYS SINCE LAST PLAYED", 18 .Add "DAYS SINCE ADDED", 18 .Add "COVER STORAGE", 55 .Add "COVER TYPE", 55 .Add "DATE ADDED", 18 .Add "SAMPLE RATE", 3 End With 'The following dictionary allows fields to declare 'when to interpret them as known/uknown Dim knownTypeDict Set knownTypeDict = CreateObject("Scripting.Dictionary") Const ktAlwaysKnown = 0 Const ktKnownIfPositive = 1 Const ktKnownIfNonNegative = 2 Const ktKnownIfNonEmpty = 3 Const ktKnownIfLinked = 4 Const ktKnownIfNotNull = 5 Const ktKnownIfNotHuge = 6 ' "Huge" treshold is 10,000 in absolute value With knownTypeDict .Add "TITLE", ktAlwaysKnown .Add "ARTIST", ktKnownIfPositive .Add "ALBUM ARTIST", ktKnownIfPositive .Add "ALBUM", ktKnownIfPositive .Add "ALBUM AND ARTIST", ktKnownIfPositive .Add "ALBUM AND YEAR", ktKnownIfPositive .Add "GENRE", ktKnownIfNonNegative .Add "YEAR", ktKnownIfPositive .Add "BITRATE", ktKnownIfPositive .Add "RATING", ktKnownIfNonNegative .Add CF(1), ktKnownIfNonempty .Add CF(2), ktKnownIfNonempty .Add CF(3), ktKnownIfNonempty .Add "COMMENT", ktKnownIfLinked .Add "PLAYLIST", ktAlwaysKnown .Add "PLAYED", ktAlwaysKnown .Add "FORMAT", ktAlwaysKnown .Add "PUBLISHER", ktKnownIfLinked .Add "LYRICIST", ktKnownIfLinked .Add "INVOLVED PEOPLE", ktKnownIfLinked .Add "ORIGINAL ARTIST", ktKnownIfLinked .Add "ORIGINAL YEAR", ktKnownIfLinked .Add "COMPOSER", ktKnownIfNonEmpty .Add "TEMPO", ktKnownIfLinked .Add "MOOD", ktKnownIfLinked .Add "OCCASION", ktKnownIfLinked .Add "QUALITY", ktKnownIfLinked .Add "LEVELING", ktKnownIfNotHuge .Add "LENGTH", ktKnownIfNonNegative .Add "VBR", ktAlwaysKnown .Add "BPM", ktKnownIfNonNegative .Add "PLAY RATE", ktAlwaysKnown .Add "TIME SINCE LAST PLAYED", ktAlwaysKnown .Add "DRIVE TYPE", ktAlwaysKnown .Add "DAYS SINCE LAST PLAYED", ktKnownIfNotHuge .Add "DAYS SINCE ADDED", ktAlwaysKnown .Add "COVER STORAGE", ktKnownIfLinked .Add "COVER TYPE", ktKnownIfPositive .Add "DATE ADDED", ktAlwaysKnown .Add "SAMPLE RATE", ktKnownIfPositive End With 'The next dictionary stores the SortGroup to be associated to each field by Default Dim SortGroupDict Set SortGroupDict = CreateObject("Scripting.Dictionary") Const sgNone = 0 Const sgArtist = 1 Const sgAlbum = 2 Const sgLocation = 3 Const sgTitle = 4 Const sgGenre = 5 Const sgYear = 6 Const sgRating = 7 Const sgClassification = 8 Const sgMyComputer = 9 Const sgAudioCD = 10 With SortGroupDict .Add "TITLE", sgTitle .Add "ARTIST", sgArtist .Add "ALBUM ARTIST", sgArtist .Add "ALBUM", sgAlbum .Add "ALBUM AND ARTIST", sgAlbum .Add "ALBUM AND YEAR", sgAlbum .Add "GENRE", sgGenre .Add "YEAR", sgYear .Add "BITRATE", sgNone .Add "RATING", sgRating .Add CF(1), sgNone .Add CF(2), sgNone .Add CF(3), sgNone .Add "COMMENT", sgNone .Add "PLAYLIST", sgNone .Add "PLAYED", sgNone .Add "FORMAT", sgNone .Add "PUBLISHER", sgArtist .Add "LYRICIST", sgArtist .Add "INVOLVED PEOPLE", sgArtist .Add "ORIGINAL ARTIST", sgArtist .Add "ORIGINAL YEAR", sgYear .Add "COMPOSER", sgArtist .Add "TEMPO", sgClassification .Add "MOOD", sgClassification .Add "OCCASION", sgClassification .Add "QUALITY", sgClassification .Add "LEVELING", sgNone .Add "LENGTH", sgNone .Add "VBR", sgNone .Add "BPM", sgNone .Add "PLAY RATE", sgNone .Add "TIME SINCE LAST PLAYED", sgNone .Add "DRIVE TYPE", sgNone .Add "DAYS SINCE LAST PLAYED", sgNone .Add "DAYS SINCE ADDED", sgNone .Add "COVER STORAGE", sgNone .Add "COVER TYPE", sgNone .Add "DATE ADDED", sgNone .Add "SAMPLE RATE", sgNone End With 'This dictionary specifies relations that need to be defined in order for the field to work as intended Dim SQLLinkDict Set SQLLinkDict = CreateObject("Scripting.Dictionary") With SQLLinkDict .Add "ARTIST", " Artists.ID = Songs.IdArtist " .Add "ALBUM ARTIST", " Artists.Id = Albums.IdArtist And Albums.ID = Songs.IdAlbum " .Add "ALBUM", " Songs.IdAlbum = Albums.ID " .Add "ALBUM AND ARTIST", " Artists.Id = Albums.IdArtist And Albums.ID = Songs.IdAlbum " .Add "ALBUM AND YEAR", "Artists.Id = Albums.IdArtist And Albums.Id = Songs.IdAlbum " .Add "GENRE", " Songs.Genre = Genres.IdGenre " .Add "COMMENT", " Songs.Id = Memos.IdSong AND Memos.MemoType = 20001 " .Add "PLAYLIST", " Songs.Id = PlayListSongs.idSong AND PlayLists.idPlayList = PlayListSongs.idPlayList " .Add "PUBLISHER", " Songs.Id = AddSongInfo.IdSong AND AddSongInfo.DataType = 101 " .Add "LYRICIST", " Songs.Id = AddSongInfo.IdSong AND AddSongInfo.DataType = 200 " .Add "INVOLVED PEOPLE", " Songs.Id = AddSongInfo.IdSong AND AddSongInfo.DataType = 204 " .Add "ORIGINAL ARTIST", " Songs.Id = AddSongInfo.IdSong AND AddSongInfo.DataType = 301 " .Add "ORIGINAL YEAR", " Songs.Id = AddSongInfoInt.IdSong AND AddSongInfoInt.DataType = 10000 " .Add "TEMPO", " Lists.idListType = 1 AND Lists.Id = AddSongInfoInt.intData AND Songs.Id = AddSongInfoInt.idSong " .Add "MOOD", " Lists.idListType = 2 AND Lists.Id = AddSongInfoInt.intData AND Songs.Id = AddSongInfoInt.idSong " .Add "OCCASION", " Lists.idListType = 3 AND Lists.Id = AddSongInfoInt.intData AND Songs.Id = AddSongInfoInt.idSong " .Add "QUALITY", " Lists.idListType = 4 AND Lists.Id = AddSongInfoInt.intData AND Songs.Id = AddSongInfoInt.idSong " .Add "PLAY RATE", " DateDiff('d',Songs.DateAdded,Now)>7 AND Songs.playCounter>0 " .Add "DRIVE TYPE", "Songs.IdMedia = Medias.idMedia" .Add "COVER STORAGE", "Covers.IDSong = Songs.ID" .Add "COVER TYPE", "Covers.IDSong = Songs.ID" .Add "COVER COUNT", "Covers.IDSong = Songs.ID" End With 'Fields which use tables that reference songs via their ID should declare the table 'in the IdSongTableDict Dictionary Dim IdSongTableDict Set IdSongTableDict = CreateObject("Scripting.Dictionary") With IdSongTableDict .Add "COMMENT", "Memos" .Add "PLAYLIST", "PlaylistSongs" .Add "PUBLISHER", "AddSongInfo" .Add "LYRICIST", "AddSongInfo" .Add "INVOLVED PEOPLE", "AddSongInfo" .Add "ORIGINAL ARTIST", "AddSongInfo" .Add "ORIGINAL YEAR", "AddSongInfoInt" .Add "TEMPO", "AddSongInfoInt" .Add "MOOD", "AddSongInfoInt" .Add "OCCASION", "AddSongInfoInt" .Add "QUALITY", "AddSongInfoInt" .Add "COVER STORAGE", "Covers" .Add "COVER TYPE", "Covers" End With 'The keys of the following dictionary are the fields that can be used as sorting fields 'The items are the number of decimals to use when averaging values Dim DecimalsDict Set DecimalsDict = CreateObject("Scripting.Dictionary") DecimalsDict.Add "YEAR", 0 DecimalsDict.Add "BITRATE", 0 DecimalsDict.Add "RATING", 2 DecimalsDict.Add "PLAYED", 1 DecimalsDict.Add "DAYS SINCE LAST PLAYED", 0 DecimalsDict.Add "DAYS SINCE ADDED", 0 '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Enrico's Code for Artist/Album Artist '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% const forFillTracks = 0 const forFillNodes = 1 Function SQLLinkingArtist(byVal Node, byVal SQLLinking, ByVal Mode) Dim fullMask Dim curLevelMask Dim Level Dim intTemp const AlbumArtist = " UBound(fullmask) then Level = UBound(fullmask) curLevelMask = fullMask(Level) 'What was relevant last? artist or album artist for intTemp = Level to 0 step -1 if (LCase(Left(FullMask(intTemp), Len(AlbumArtist)))=AlbumArtist) or (LCase(Left(FullMask(intTemp), Len(Artist)))=Artist) then curLevelMask = FullMask(intTemp) exit for end if next 'Remove irrelevant Relations between Tables if Left(curLevelMask, Len(AlbumArtist)) = AlbumArtist then SQLLinking=Replace(SQLLinking, "Artists.ID = Songs.IdArtist", "", 1, -1, 1) if Left(curLevelMask, Len(Artist)) = Artist then SQLLinking=Replace(SQLLinking, "Artists.Id = Albums.IdArtist", "", 1, -1, 1) 'Remove wrong syntax while InStr(SQLLinking, " ") SQLLinking = Replace(SQLLinking, " ", " ", 1, -1, 1) Wend while InStr(UCase(SQLLinking), "AND AND") SQLLinking = Replace(SQLLinking, "AND AND", "AND", 1, -1, 1) Wend SQLLinking = Trim(SQLLinking) if UCase(Left(SQLLinking, 4)) = "AND " then SQLLinking = Mid(SQLLinking, 4) SQLLinking = Trim(SQLLinking) 'Result SQLLinkingArtist = SQLLinking end Function '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Format Functions '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 'The built-in FormatNumber is localized. This is a replacemenet that assumes 'the dot is the decimal separator Function FormatNumberInt(n, decimals) Dim pos pos = InStr(n,".") If pos = 0 Then FormatNumberInt = n & "." & String(decimals,"0") Else Dim oldDecimals oldDecimals = Len(n) - pos If decimals > oldDecimals Then FormatNumberInt = n & String(decimals-oldDecimals,"0") Else FormatNumberInt = Left(n,pos+decimals) End If End If End Function Function FormatRating(rating) FormatRating = FormatNumberInt(rating,1) & " stars" End Function Function FormatLeveling(leveling) FormatLeveling = Cond(leveling>0,"+","") & leveling & " db" End Function Function FormatLength(length) FormatLength = length & " to " & (length+1) & " minutes" End Function Function FormatVBR(VBR) If VBR + 1 = 0 Then FormatVBR = "N/A" Elseif VBR = 0 Then FormatVBR = "CBR" Elseif VBR = 1 Then FormatVBR = "VBR" End If End Function Function FormatPlayRate(Playrate) FormatPlayRate = Playrate & " to " & (Playrate+1) & " days" End Function Function FormatTimeSinceLastPlayed(timeCode) Dim retValue If timeCode = 0 Then retValue = "Less than an hour" ElseIf timeCode = 1 Then retValue = "Between an hour and a day" Elseif timeCode = 2 Then retValue = "Between a day and a week" Elseif timeCode = 3 Then retValue = "Between a week and a month" Elseif timeCode = 4 Then retValue = "Between a month and a year" Elseif timeCode = 5 Then retValue = "Over a year or never played" End If FormatTimeSinceLastPlayed = retValue End Function Function FormatCoverType(CoverType) Dim CoverTypeDict Set CoverTypeDict = CreateObject("Scripting.Dictionary") With CoverTypeDict .Add 0, SDB.Localize("Not specified") .Add 1, SDB.Localize("PNG file icon") .Add 2, SDB.Localize("File icon") .Add 3, SDB.Localize("Cover (front)") .Add 4, SDB.Localize("Cover (back)") .Add 5, SDB.Localize("Leaflet Page") .Add 6, SDB.Localize("Media Label") .Add 7, SDB.Localize("Lead Artist") .Add 8, SDB.Localize("Artist") .Add 9, SDB.Localize("Conductor") .Add 10, SDB.Localize("Band") .Add 11, SDB.Localize("Composer") .Add 12, SDB.Localize("Lyricist") .Add 13, SDB.Localize("Recording Location") .Add 14, SDB.Localize("During Recording") .Add 15, SDB.Localize("During Performance") .Add 16, SDB.Localize("Video Screen Capture") .Add 17, SDB.Localize("A bright coloured fish") .Add 18, SDB.Localize("Illustration") .Add 19, SDB.Localize("Band Logotype") .Add 20, SDB.Localize("Publisher Logotype") end with FormatCoverType = CoverTypeDict.Item(Int(CoverType)) Set CoverTypeDict = Nothing End Function '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' String Manipulation and Regular expressions '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Function Cond(test, a, b) ' Returns a if test evaluates to true, b otherwise If test Then Cond = a Else Cond = b End If End Function Function IsEmptyStr(value) IsEmptyStr = Cond(Trim(value)="",True,False) End Function Function JoinNonEmpty(arrayToJoin, Joiner) ' Like Join, but it ignores empty words Dim i, b, retValue b = False retValue = "" For i=0 to UBound(arrayToJoin) If Trim(arrayToJoin(i))<>"" Then If b Then retValue = retValue & Joiner retValue = retValue & arrayToJoin(i) b = True End If Next JoinNonEmpty = retValue End Function Function SortFields() Dim srtFlds srtFlds = DecimalsDict.Keys SortFields = Join(srtFlds,"|") End Function Dim QualifierMasks 'Stores a collection of regular expression masks for all possible node qualifiers QualifierMasks = Array("\|all:(yes|no)", _ "\|unknown:(yes|no)", _ "\|trim:-?\d*", _ "\|left of:.*", _ "\|right of:.*", _ "\|sort by:(sum|max|min|avg|first|last|count)\((" & SortFields() & ")\)", _ "\|sort order:(asc|desc)", _ "\|top:\d*( percent)?", _ "\|min tracks:\d*", _ "\|max tracks:\d*", _ "\|show tracks:(yes|no)") Dim GlobalQualifierMasks 'Stores a collection of regular expression masks for all possible global (root) qualifiers GlobalQualifierMasks = Array("\|shortcut:.*", _ "\|child of:(magic|album|artist|library|playlists|location|year|genre|classification|rating)", _ "\|icon:(standard|top level|bottom level)", _ "\|SQL filter:.*", _ "\|filter:.*", _ "\|show tracks:(yes|no)") Function RegExpRoot() RegExpRoot = "(" & Join(GlobalQualifierMasks,"|") & ")+" End Function 'This function returns a pattern for for use in regular expressions 'It is used in the CheckMask function, which checks whether a mask is conforming Function RegExpField() Dim i, fieldList, fieldRegExps() fieldList = fieldDict.Keys ReDim fieldRegExps(FieldDict.Count) For i = 0 to FieldDict.Count - 1 fieldRegExps(i) = fieldList(i) & "(" & Join(QualifierMasks,"|") & ")*" Next RegExpField = "<(" & Join(fieldRegExps, "|") & ")>" End Function 'Returns whether or not the argument is a valid mask Function CheckMask(mask) Dim fields, rootQualifs, i fields = Split(mask,"\") Re.Pattern = "\|" If Re.Test(fields(0)) Then Re.Pattern = RegExpRoot() If Not Re.Test("|" & Split(fields(0),"|",2)(1)) Then CheckMask = False Exit Function End If End If Re.Pattern = RegExpField() For i=1 to UBound(fields) If Not Re.Test(fields(i)) Then CheckMask = False Exit Function End If Next CheckMask = True End Function 'Returns whether Mask contains the field fld as a defining field Function TestStrForField(fld, Mask) RE.Pattern = "<" & fld & "(\||>)?" TestStrForField = RE.Test(Mask) End Function Function getQualifierValue(mask, qualifier, default, global) RE.Pattern = "\|" & qualifier & Cond(global, ":[^\|\\]*(\||\\)", ":[^\|\\>]*(\||>|\\)") Set Matches = Re.Execute(mask) If Matches.Count = 0 Then getQualifierValue = UCase(default) Exit Function End If Set Match = Matches.Item(0) getQualifierValue = UCase(Mid(Match,Len(qualifier)+3,Match.Length-Len(Qualifier)-3)) End Function 'Translate the user specified sort condition into a string that can be used in an SQL statement Function getSQLSortFieldCondition(srtFld) Dim userFields, i userFields = DecimalsDict.Keys For i=0 to UBound(userFields) If InStr(srtFld, userFields(i)) Then getSQLSortFieldCondition = Replace(srtFld,userFields(i),FieldDict.item(userFields(i))) Exit Function End If Next End Function 'Get the user sort field out of the sort condition (for example, Max(year) -> year) Function getSortField(srtFld) Re.Pattern = sortFields() getSortField = RE.Execute(srtFld).item(0).value End Function 'Get the database order field out of the sort condition (for example, Max(year) -> songs.year) Function getSQLSortField(srtFld) Re.Pattern = sortFields() getSQLSortField = FieldDict.Item(RE.Execute(srtFld).item(0).value) End Function Function convertFilterIntoSQL(filterString) Dim fieldList, i, retStr retStr = filterString ' First, replace user fields by SQL fields fieldList = FieldDict.Keys For i = 0 To FieldDict.Count - 1 retStr = Replace(retStr, fieldList(i), FieldDict.Item(fieldList(i))) Next ' Now, add the required links between tables fieldList = SQLLinkDict.Keys For i = 0 To SQLLinkDict.Count - 1 RE.Pattern = fieldList(i) If RE.Test(filterString) Then retStr = retStr & " AND " & SQLLinkDict.Item(fieldList(i)) End if Next convertFilterIntoSQL = "(" & retStr & ")" End Function '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Assorted Auxiliary Functions '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 'A procedure that does nothing Sub DummyFunct(Argument) End Sub 'Returns a numeric value for the current version of MM Function CurrentVersion CurrentVersion = 100 * SDB.VersionHi + SDB.VersionLo End Function 'Creates a piece of SQL code specifying the needed relations between tables Function BuildSQLLinking(Mask, known) Dim RetStr, Keys, i, b Keys = SQLLinkDict.Keys b = False RetStr = "" For i = 0 to SQLLinkDict.Count - 1 If Known Or KnownTypeDict.item(Keys(i)) <> ktKnownIfLinked Then If TestStrForField(Keys(i), Mask) Then If b Then RetStr = RetStr & " AND " End If RetStr = RetStr & SQLLinkDict.item(Keys(i)) b = True End If End If Next BuildSQLLinking = RetStr End Function 'Creates a pice of SQL code which comes immediately after the FROM clause (i.e. which tables to query) Function BuildSQLTables(SQLLinking) Dim RetStr, tables, i tables = Array("Artists", "Albums", "Genres", "Memos", "AddSongInfo", "AddSongInfoInt", "Played", "PlayLists", "PlayListSongs", "Lists", "Medias", "Covers") RetStr = " Songs " For i = 0 To UBound(tables) RE.Pattern = tables(i) & "\." If RE.Test(SQLLinking) Then RetStr = RetStr & ", " & tables(i) End If Next BuildSQLTables = RetStr End Function Sub ResetCustomNodeRoot Dim i SDB.Objects("CustomNodeRoot").Expanded = False SDB.Objects("CustomNodeRoot").Expanded = True For i=1 to MasksInIniFile If getIniMask(i) <> "" And getQualifierValue(getIniMask(i),"child of","MAGIC", True)="MAGIC" Then SDB.Objects("CustomNodeRoot").Visible = True Exit Sub End if Next SDB.Objects("CustomNodeRoot").Visible = False End Sub Function getParentString(i) getParentString = getQualifierValue(Split(getIniMask(i),"\")(0),"child of", "MAGIC", True) End Function Sub expandCustomNode(i) ' Expand the parent node first If getParentString(i) = "MAGIC" Then SDB.Objects("CustomNodeRoot").expanded = True Else SDB.MainTree.Node_Library.expanded = True End if SDB.Objects("CN" & i).expanded = True If CurrentVersion() >= 203 Then SDB.MainTree.CurrentNode = SDB.Objects("CN" & i) End Sub Function getField(mask) Re.Pattern = "\||>" Set Matches = Re.Execute(mask) getField = UCase(Mid(mask,2, Matches.Item(0).FirstIndex-1)) End Function Function getIniMask(i) getIniMask = SDB.IniFile.StringValue("CustomNodeMasks","Mask"&i) End Function Sub SetIniMask(i, mask) SDB.IniFile.StringValue("CustomNodeMasks","Mask"&i) = mask End Sub Sub ShowRestartMsg SDB.MessageBox "You need to restart MediaMonkey to complete this operation", mtWarning, Array(mbOk) End Sub '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Creation of Node Hierarchy '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 'Whether the given mask defines a node that is a child of the Magic Nodes Function isMagicChild (mask) isMagicChild = Cond(mask <>"" And getQualifierValue(mask,"child of","MAGIC", True) = "MAGIC", True, False) End Function Sub FillRootCustomNode(Node) Node.hasChildren = False Node.hasChildren = True Dim CurrentMask, i For i=1 to masksInIniFile CurrentMask = getIniMask(i) If isMagicChild(CurrentMask) Then Node.Visible = True CreateCustomNode Node, 3, CurrentMask, i End If Next End Sub Sub CreateExternalNodes Dim i, currentMask, parentNode For i=1 to masksInIniFile CurrentMask = getIniMask(i) parentNode = getQualifierValue(currentMask,"child of","MAGIC", True) If (CurrentMask <> "") And (parentNode <> "MAGIC") Then CreateCustomNode Eval("SDB.MainTree.Node_" & parentNode), 1, CurrentMask, i End If Next End Sub Sub UpdateCustomNode(CustomNode, Mask, Id) Dim iconType ' type of icon to be used Dim iconIndex ' Index of icon Dim SQLFilter ' SQL Filter specified by user (if any) Dim Filter ' Filter specified by user (if any) Dim SplitMask Dim SQLLinking, SQLTables Dim TopLevelField, BottomLevelField Dim noChildren SplitMask = Split(Mask,"\") noChildren = Cond(UBound(SplitMask)=0, True, False) 'Convert filter into SQL code and combine with SQLFilter SQLFilter = getQualifierValue(Mask, "SQL filter","", True) filter = getQualifierValue(Mask, "filter","", True) If filter <> "" Then SQLFilter = JoinNonEmpty(Array(SQLFilter, ConvertFilterIntoSQL(filter))," AND ") SQLLinking = BuildSQLLinking(Mask, True) SQLTables = BuildSQLTables(SQLLinking & " " & SQLFilter) If UBound(SplitMask)>0 Then TopLevelField = getField(SplitMask(1)) BottomLevelField = getField(splitMask(UBound(splitMask))) Else TopLevelField = Null BottomLevelField = Null End If iconType = getQualifierValue(mask,"icon", "STANDARD", True) If iconType = "STANDARD" Or noChildren Then iconIndex = 20 ElseIf iconType = "TOP LEVEL" Then iconIndex = iconDict.item(TopLevelField) ElseIf iconType = "BOTTOM LEVEL" Then iconIndex = iconDict.item(BottomLevelField) End If CustomNode.Caption = Split(SplitMask(0),"|")(0) CustomNode.IconIndex = iconIndex CustomNode.UseScript = Script.ScriptPath CustomNode.SortGroup = Cond(isNull(topLevelField), sgNone, SortGroupDict.Item(TopLevelField)) CustomNode.onFillChildren = Cond(UBound(SplitMask)=0,"DummyFunct","FillCustomNode") CustomNode.onEdited = "EditCustomNodeRoot" If getQualifierValue(SplitMask(0) & "|","show tracks","YES",True) = "YES" Or noChildren Then CustomNode.OnFillTracksFunct = "FillCustomLeaf" Else CustomNode.OnFillTracksFunct = "DummyFunct" End If CustomNode.customData = SQLFilter & " @@" & SQLLinking & "@@" & SQLTables CustomNode.customNodeId = Id CustomNode.customDataId = 0 End Sub Sub CreateCustomNode(ParentNode, AddPosition, Mask, Id) Dim Tree ' The main tree Dim CustomNode ' The Node to be added Set Tree = SDB.MainTree Set CustomNode = Tree.CreateNode UpdateCustomNode CustomNode, Mask, Id CustomNode.hasChildren = False Tree.AddNode ParentNode, CustomNode, AddPosition CustomNode.hasChildren = Cond(UBound(Split(mask,"\"))=0, False, True) SDB.Objects("CN" & Id) = CustomNode End Sub Sub FillStandardProperties(parentNode, childNode, fldTxt) With childNode .CustomNodeId = parentNode.CustomNodeId .CustomDataId = parentNode.CustomDataId + 1 .SortGroup = SortGroupDict.Item(fldTxt) .UseScript = Script.ScriptPath End With End Sub Const otOrderByField = 0 Const otOrderByAggregate = 1 Const otOrderByIgnoreArticle = 2 Sub FillCustomNode(Node) Dim SplitCustomData ' Auxiliary Array used to collect the pieces of Node.CustomData Dim SQLLinking ' Piece of SQL Code (WHERE statement) defining the relations between tables Dim SQLTables ' Part of FROM clause indicating which tables to query Dim SQLCondition ' String containing the part of the WHERE statement coming from the ancestor nodes Dim fullMask, curLevelMask Dim Tree, newNode, nextIsLeaf Dim FldTxt ' Text identifying the field by which the created nodes will be filtered Dim Field, IdField, OrderField ' Fields to be queried Dim OrderType ' Variables that store qualifier values and related expressions Dim SortQualifier ' Whether the user specified a sort by: qualifier in the mask Dim trimValue, leftOfValue, rightOfValue, trimField Dim TopQualifier, TopClause, SortCondition, minTracks, maxTracks, doFormatting, duplicates Dim ContentIndex ' An index to the field to be displayed Dim SELECT_Clause, FROM_Clause, WHERE_Clause, GROUP_BY_Clause, ORDER_BY_Clause, HAVING_Clause Dim SQLStatement ' SQL query to the database Dim CaptionPrefix ' Used to modify the caption when a sorting has been specified Dim EscapedId ' Used to escape a text value in the database to be used as a test Dim idArgument ' The first argument submitted to the Format function Dim Iter ' SDBD Iterator obtained by running the SQL query to get the nodes SplitCustomData = Split(Node.CustomData,"@@") SQLCondition = SplitCustomData(0) SQLLinking = SplitCustomData(1) SQLTables = SplitCustomData(2) RE.Pattern = "\\" fullMask = Split(getIniMask(Node.customNodeId),"\") curLevelMask = fullMask(Node.CustomDataId+1) nextIsLeaf = Cond(UBound(fullmask)=Node.customDataId+1, True, False) SQLLinking = SQLLinkingArtist(Node, SQLLinking, forFillNodes) ' Enrico's artist/album artist fix RE.Pattern = "\||>" Set Matches = Re.Execute(curLevelMask) FldTxt = getField(curLevelMask) doFormatting = FormattingDict.Exists(FldTxt) ' Deal with the qualifiers that trim the field TrimValue = getQualifierValue(curLevelMask,"trim",0, False) LeftOfValue = getQualifierValue(curLevelMask,"left of","", False) RightOfValue = getQualifierValue(curLevelMask,"right of","", False) TrimField = Cond(trimValue=0 And leftOfValue="" And rightOfValue="", False, True) Field = FieldDict.Item(FldTxt) If Not TrimField Then ' Do nothing ElseIf TrimValue > 0 Then Field = "Left(" & Field & "," & TrimValue & ")" Elseif trimValue < 0 Then Field = "Right(" & Field & "," & (-TrimValue) & ")" Elseif leftOfValue <> "" Then Field = "Left(" & Field & ", InStr(" & Field & ", '" & leftOfValue & "'))" Elseif rightOfValue <> "" Then Field = "Right(" & Field & ", Len(" & Field & ")-InStr(" & Field & ", '" & rightOfValue & "'))" End If ' Set several parameters according to whether an index field has been defined If IdFieldDict.Exists(FldTxt) And Not trimField Then idField = iDFieldDict.Item(FldTxt) ContentIndex = 1 Else IdField = Field ContentIndex = 0 End If ' Deal with the sort field specified by the user SortCondition = getQualifierValue(curLevelMask,"sort by","", False) 'Determine how to order type If SortCondition <> "" Then OrderType = otOrderByAggregate Elseif IgnoreArticleDict.Exists(FldTxt) Then OrderType = otOrderByIgnoreArticle Else OrderType = otOrderByField End If If OrderType = otOrderByField Then OrderField = Field Elseif OrderType = otOrderByIgnoreArticle Then OrderField = "IIF(Left(" & Field & ", 3)='The', Right(" & Field & ", Len(" & Field & ") - 4)," & Field & ")" Elseif OrderType = otOrderByAggregate Then OrderField = " IIF(Min(" & getSQLSortField(SortCondition) & ")<0, -1, " & getSQLSortFieldCondition(SortCondition) & ") " End If ORDER_BY_Clause = " ORDER BY " & OrderField & " " & getQualifierValue(curLevelMask,"sort order","ASC", False) _ & Cond(OrderType<>otOrderByField, ", " & Field, "") 'Deal with known/unknown fields Dim knownType, SQLKnown, SQLUnknown knownType = KnownTypeDict.item(FldTxt) If trimField Then SQLKnown = "" ElseIf knownType = ktKnownIfPositive Then SQLKnown = idField & " > 0 " ElseIf knownType = ktKnownIfNonnegative Then SQLKnown = idField & " >= 0 " ElseIf knownType = ktKnownIfNonempty Then SQLKnown = idField & " <> '' " ElseIf knownType = ktKnownIfNotNull Then SQLKnown = " NOT ISNULL(" & idField & ")" ElseIf knownType = ktKnownIfLinked Then SQLKnown = "" ElseIf knownType = ktAlwaysKnown Then SQLKnown = "" ElseIf knownType = ktKnownIfNotHuge Then SQLKnown = " ABS(" & idField & ") < 10000 " End If Set Tree = SDB.MainTree Node.HasChildren = false ' To delete all old children ' Create All node, if that option has been enabled If getQualifierValue(curLevelMask,"All","NO", False) = "YES" And Node.CustomDataId > 0 Then Set newNode = Tree.CreateNode newNode.Caption = "All" 'newNode.CustomData = SQLCondition & "@@" & SQLLinking & "@@" & SQLTables newNode.CustomData = SQLCondition & "@@" & SplitCustomData(1) & "@@" & SQLTables 'Enrico's Artist/Album Artist fix FillStandardProperties Node, newNode, FldTxt newNode.iconIndex = 13 newNode.OnFillTracksFunct = "FillCustomLeaf" Tree.AddNode Node, NewNode, 3 newNode.hasChildren = False End If ' Create Unknown node, if that option has been enabled If KnownType <> ktAlwaysKnown And getQualifierValue(curLevelMask, "Unkown", "YES", False) = "YES" And Not TrimField Then SQLUnknown = " NOT " & SQLKnown If knownType <> ktKnownIfLinked Then 'SELECT_Clause = " SELECT COUNT(" & IdField & ") AS Count_Unknown" SELECT_Clause = " SELECT " & IdField 'Enrico's Count bug fix FROM_Clause = " FROM " & SQLTables WHERE_Clause = " WHERE " & JoinNonEmpty(Array(SQLCondition, SQLUnknown, SQLLinking)," AND ") Else Dim OtherSQLLinking, OtherSQLTables, SQLNotLinked, LinkedTable OtherSQLLinking = BuildSQLLinking(getIniMask(Node.CustomNodeId),False) OtherSQLTables = BuildSQLTables(OtherSQLLinking) LinkedTable = IdSongTableDict.item(FldTxt) SQLNotLinked = " Songs.Id NOT IN (Select Songs.Id FROM Songs INNER JOIN " & LinkedTable & " ON Songs.Id = " & LinkedTable & ".IdSong) " 'SELECT_Clause = " SELECT COUNT(Songs.Id) AS Count_Unknown " SELECT_Clause = " SELECT Songs.Id" 'Enrico's Count bug fix FROM_Clause = " FROM " & OtherSQLTables WHERE_Clause = " WHERE " & JoinNonEmpty(Array(SQLCondition,OtherSQLLinking, SQLNotLinked)," AND ") End If 'SQLStatement = SELECT_Clause & FROM_Clause & WHERE_Clause SQLStatement = "Select Count(*) as Count_Unknown FROM (" & SELECT_Clause & FROM_Clause & WHERE_Clause & ")" 'Enrico's Count bug fix 'MsgBox SQLStatement Set Iter = SDB.Database.OpenSQL(SQLStatement) If Err <> 0 Then SDB.MessageBox "The mask defining this Magic Node produced an error. Edit the mask and try again." & _ vbNewLine & "(The error probably resides in the filter: or SQL filter: qualifiers)" , _ mtError, Array(mbOk) Exit Sub End If On Error GoTo 0 Dim Count_Unknown : Count_Unknown = Iter.StringByName("Count_Unknown") If Count_Unknown <> 0 Then ' There's at least one unknown record Set newNode = Tree.CreateNode newNode.Caption = SDB.Localize("Unknown") & " (" & Count_Unknown & ")" 'Localized by Enno If knownType <> ktKnownIfLinked Then 'newNode.CustomData = JoinNonEmpty(Array(SQLCondition, SQLUnknown)," AND ") & "@@" & SQLLinking & "@@" & SQLTables newNode.CustomData = JoinNonEmpty(Array(SQLCondition, SQLUnknown)," AND ") & "@@" & SplitCustomData(1) & "@@" & SQLTables ' Enrico's Artist/Album artist fix Else newNode.CustomData = JoinNonEmpty(Array(SQLCondition, SQLNotLinked)," AND ") & "@@" & OtherSQLLinking & "@@" & OtherSQLTables End If FillStandardProperties node,newNode,FldTxt newNode.iconIndex = 15 If nextIsLeaf Or getQualifierValue(curLevelMask,"show tracks","YES", False)="YES" Then newNode.OnFillTracksFunct = "FillCustomLeaf" If Not nextIsLeaf Then newNode.onFillChildren = "FillCustomNode" Tree.AddNode Node, NewNode, 3 newNode.hasChildren = Not nextIsLeaf End If End If ' Deal with the TOP statement if specified by the user TopQualifier = getQualifierValue(curLevelMask, "top", "", False) TopClause = Cond(TopQualifier="","", "TOP " & TopQualifier) minTracks = getQualifierValue(curLevelMask,"min tracks",0, False) maxTracks = getQualifierValue(curLevelMask,"max tracks",0, False) Dim SelectFields, GroupFields, Distinct SelectFields = IdField GroupFields = "" Distinct = " DISTINCT " If IdField <> Field Then SelectFields = SelectFields & ", " & Field If OrderType = otOrderByAggregate Or minTracks + maxTracks > 0 Then GroupFields = SelectFields Distinct = "" End if If OrderType <> otOrderByField Then SelectFields = SelectFields & ", " & OrderField End If SELECT_Clause = " SELECT " & Distinct & TopClause & " " & SelectFields FROM_Clause = " FROM " & SQLTables WHERE_Clause = Cond(Trim(SQLLinking & SQLKnown & SQLCondition)="","", _ " WHERE " & JoinNonEmpty(Array(SQLLinking,SQLKnown,SQLCondition), " AND ")) GROUP_BY_Clause = Cond(GroupFields="",""," GROUP BY " & GroupFields) If minTracks > 0 and maxTracks > 0 Then HAVING_Clause = " HAVING Count(*) BETWEEN " & minTracks & " AND " & maxTracks Elseif minTracks > 0 Then ' maxTracks = 0 HAVING_Clause = " HAVING Count(*) >= " & minTracks Elseif maxTracks > 0 Then ' minTracks = 0 HAVING_Clause = " HAVING Count(*) <= " & maxTracks Else ' maxTracks = minTracks = 0 HAVING_Clause = "" End If SQLStatement = SELECT_Clause & FROM_Clause & WHERE_Clause & GROUP_BY_Clause & HAVING_Clause & ORDER_BY_Clause ' Fill regular subnodes 'MsgBox SQLStatement Set Iter = SDB.Database.OpenSQL(SQLStatement) While Not Iter.EOF Set newNode = Tree.CreateNode If doFormatting Then NewNode.Caption = Eval(FormattingDict.Item(FldTxt) & "(""" & Iter.StringByIndex(ContentIndex) & """)") Else NewNode.Caption = Trim(Iter.StringByIndex(ContentIndex)) If leftOfValue <> "" And NewNode.Caption <> "" Then NewNode.Caption = Left(NewNode.Caption,Len(NewNode.Caption)-1) End if NewNode.iconIndex = IconDict.Item(FldTxt) 'If SortCondition <> "" Then If OrderType = otOrderByAggregate Then If Iter.StringByIndex(contentIndex+1) >= 0 Then CaptionPrefix = Iter.StringByIndex(contentIndex+1) RE.Pattern = "AVG" If RE.Test(SortCondition) Then CaptionPrefix = FormatNumberInt(CaptionPrefix, DecimalsDict.Item(getSortField(SortCondition))) End If NewNode.Caption = CaptionPrefix & " - " & NewNode.Caption End If End If escapedId = Cond(isNumericDict(FldTxt) and Not TrimField, Iter.StringByIndex(0), _ "'" & Replace(Iter.StringByIndex(0),"'","''") & "'") 'newNode.CustomData = JoinNonEmpty(Array(SQLCondition, SQLKnown, IdField & "=" & escapedId), " AND ") & _ '"@@" & SQLLinking & "@@" & SQLTables & "@@" & escapedId newNode.CustomData = JoinNonEmpty(Array(SQLCondition, SQLKnown, IdField & "=" & escapedId), " AND ") & _ "@@" & SplitCustomData(1) & "@@" & SQLTables & "@@" & EscapedId 'Enrico's Artist/Album Artist fix FillStandardProperties node,newNode, FldTxt If CurrentVersion() >= 204 And newNode.CustomDataID = 1 And DragDropTypeDict.Exists(FldTxt) = True And Not TrimField Then newNode.OnDragDrop = "CustomDragDrop" End if If nextIsLeaf Then newNode.onFillTracksFunct = "FillCustomLeaf" If getQualifierValue(curLevelMask,"show tracks","YES", False)="YES" Then newNode.onFillTracksFunct = "FillCustomLeaf" If Not nextIsLeaf Then newNode.onFillChildren = "FillCustomNode" Tree.AddNode Node, NewNode, 3 newNode.hasChildren = Not nextIsLeaf Iter.Next Wend End Sub Sub FillCustomLeaf(Node) Dim Tracks, SplitCustomData, Iter Dim SQLCondition, SQLLinking, SQLTables Dim SELECT_Clause, FROM_Clause, WHERE_Clause SplitCustomData = Split(Node.CustomData,"@@") SQLCondition = SplitCustomData(0) SQLLinking = SplitCustomData(1) SQLTables = SplitCustomData(2) SQLLinking = SQLLinkingArtist(Node, SQLLinking, forFillTracks) ' Enrico's Artist/Album Artist fix SELECT_Clause = " SELECT Songs.Id " FROM_Clause = " FROM " & SQLTables WHERE_Clause = Cond( isEmptyStr(SQLLinking & SQLCondition), _ "", " WHERE " & JoinNonEmpty(Array(SQLLinking,SQLCondition)," AND ")) Set Tracks = SDB.MainTracksWindow Tracks.AddTracksFromQuery("AND Songs.ID IN (" & SELECT_Clause & FROM_Clause & WHERE_Clause & ")") Tracks.FinishAdding End Sub Function CustomDragDrop(destNode, srcNode, SongList, DropType, Test) If Test Then CustomDragDrop = 2 ' Move operation Else Dim Mask, Fld, IdFld, IdValue, itmProp, Prompt Mask = split(getIniMask(destNode.CustomNodeId),"\")(1) Fld = getField(Mask) If DragDropPromptDict.Exists(Fld) Then Prompt = SDB.MessageBox(DragDropPromptDict.Item(Fld), mtWarning, Array(mbYes,mbNo)) If Prompt = mrNo Then SDB.MainTracksWindow.Refresh Exit Function End if End If If IdFieldDict.Exists(Fld) Then IdFld = IdFieldDict.Item(Fld) Else IdFld = FieldDict.Item(Fld) End If itmProp = DragDropDict.Item(Fld) idValue = Split(DestNode.CustomData,"@@")(3) IdValue = Replace(IdValue,"'","""") itmProp = Replace(itmProp, "@idvalue", IdValue) itmProp = Replace(itmProp, "@song", "itm") Dim i, itm, track For i=0 To SongList.Count-1 Set itm = SongList.Item(i) itmProp = Replace(itmProp, "@idsong", itm.Id) If DragDropTypeDict.Item(Fld) = 1 Then 'MsgBox itmProp Execute(itmProp) itm.UpdateDB Elseif DragDropTypeDict.Item(Fld) = 2 Then SDB.Database.ExecSQL(itmProp) Set track = SDB.Database.QuerySongs("AND Songs.ID=" & itm.Id) track.Item.writeTags End If Next SDB.MainTracksWindow.Refresh End If End Function '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' User interface '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Function SkinnedInputBox(text, caption, input) Dim Form, Label, Edt, btnOk, btnCancel, modalResult ' Create the window to be shown Set Form = SDB.UI.NewForm Form.Common.SetRect 100, 100, 360, 130 Form.BorderStyle = 2 ' Resizable Form.FormPosition = 4 ' Screen Center Form.SavePositionName = "Remember position" Form.Caption = caption ' Create a button that closes the window Set Label = SDB.UI.NewLabel(Form) Label.Caption = text Label.Common.Left = 5 Label.Common.Top = 10 Set Edt = SDB.UI.NewEdit(Form) Edt.Common.Left = Label.Common.Left Edt.Common.Top = Label.Common.Top + Label.Common.Height + 5 Edt.Common.Width = Form.Common.Width - 20 Edt.Common.ControlName = "Edit1" Edt.Common.Anchors = 1+2+4 'Left+Top+Right Edt.Text = Input ' Create a button that closes the window Set BtnOk = SDB.UI.NewButton(Form) BtnOk.Caption = "&OK" BtnOk.Common.Top = Edt.Common.Top + Edt.Common.Height + 10 BtnOk.Common.Hint = "OK" BtnOk.Common.Anchors = 4 ' Right BtnOk.UseScript = Script.ScriptPath If currentVersion() >= 204 Then BtnOk.Default = True BtnOk.ModalResult = 1 Set BtnCancel = SDB.UI.NewButton(Form) BtnCancel.Caption = "&Cancel" BtnCancel.Common.Left = Form.Common.Width - BtnCancel.Common.Width - 15 BtnOK.Common.Left = BtnCancel.Common.Left - BtnOK.Common.Width - 10 BtnCancel.Common.Top = BtnOK.Common.Top BtnCancel.Common.Hint = "Cancel" BtnCancel.Common.Anchors = 4 ' Right BtnCancel.UseScript = Script.ScriptPath If currentVersion() >= 204 Then BtnCancel.Cancel = True BtnCancel.ModalResult = 2 modalResult = Form.showModal SkinnedInputBox = Cond(modalResult=1, Edt.Text, "") End Function Sub ResetEditDeleteMenus Dim i, iniMask For i=1 to masksInIniFile iniMask = getIniMask(i) SDB.Objects("submnu_edit" & i).caption = iniMask SDB.Objects("submnu_delete" & i).caption = iniMask SDB.Objects("submnu_edit" & i).visible = Cond(iniMask="",False,True) SDB.Objects("submnu_delete" & i).visible = Cond(iniMask="",False,True) SDB.Objects("mnu_shortcut" & i).shortcut = getQualifierValue(iniMask,"shortcut","", True) Next End Sub Sub EditCustomNodeRoot(node, text) If Trim(text) = "" Then SetIniMask node.CustomNodeId, "" ResetEditDeleteMenus ResetCustomNodeRoot Else RE.Pattern = "(\||\\)" If Re.Test(text) Then SDB.MessageBox "The caption cannot contain the characters | or \.", mtError, Array(mbOk) Exit Sub End If 'Write the new mask to the ini file Dim splitMask : splitMask = Split(getIniMask(node.CustomNodeId),"\",2) SetIniMask node.CustomNodeId, Trim(text) & Right(splitMask(0), Len(SplitMask(0))-Len(node.Caption)) & "\" & splitMask(1) ResetEditDeleteMenus node.Caption = Trim(text) End If End Sub Sub CreateNode(Item) Dim userMask, iniMask, i, wellFormedMask, singleLineMask userMask = SkinnedInputBox("Enter a mask for the new Magic Node", "Create Magic Node", getIniMask(0)) If userMask = "" Then Exit Sub wellFormedMask = CheckMask(userMask) singleLineMask = Cond(InStr(userMask,vbCr) = 0, True, False) If wellFormedMask And singleLineMask Then For i=1 to masksInIniFile iniMask = getIniMask(i) If iniMask = "" Then setIniMask i, userMask setIniMask 0, userMask ' mask0 is used as a default/temporary mask ResetEditDeleteMenus Dim pn : pn = getQualifierValue(userMask,"child of","MAGIC", True) If pn = "MAGIC" Then ResetCustomNodeRoot Else CreateCustomNode Eval("SDB.MainTree.Node_" & pn), 1, userMask, i End If ExpandCustomNode(i) Exit Sub End If Next Else SetIniMask 0, Cond(wellFormedMask, Left(userMask, InStr(userMask, vbCr)), userMask) SDB.MessageBox Cond(wellFormedMask, _ "The mask you entered spans several lines. Masks must fit in one line in order to be valid.", _ "The mask you entered is not valid. Please try again."), mtError, Array(mbOk) CreateNode(Item) Exit Sub End If SDB.MessageBox "You have exceeded the allowed limit of Magic Nodes. You can increase this limit by modifying the constant" & _ " masksInIniFile in the script source and restarting MediaMonkey.", mtError, Array(mbOK) End Sub Sub DeleteAllNodes(Item) Dim reallyDelete, i, showAlert reallyDelete = SDB.MessageBox("Are you sure you want to delete all Magic Nodes?", mtConfirmation, Array(mbYes,mbNo)) If reallyDelete = MrYes Then showAlert = False For i=1 to masksInIniFile If getQualifierValue(getIniMask(i),"child of","MAGIC", True)<>"MAGIC" Then showAlert = True setIniMask i,"" Next ResetCustomNodeRoot End If ResetEditDeleteMenus If showAlert Then ShowRestartMsg End Sub Sub DeleteNode(Item) Dim reallyDelete, i reallyDelete = Sdb.MessageBox("Are you sure you want to delete the Magic Node " & vbNewLine & _ Item.caption & " ?", mtConfirmation, Array(mbYes,mbNo)) If reallyDelete = mrYes Then For i=1 to masksInIniFile If getIniMask(i) = Item.caption Then setIniMask i, "" SDB.objects("submnu_edit" & i).visible = False SDB.objects("submnu_delete" & i).visible = False If getQualifierValue(Item.Caption,"child of","MAGIC", True)<>"MAGIC" Then ShowRestartMsg Else ResetCustomNodeRoot End If Exit Sub End If Next End If End Sub Sub EditNodeWithStartMask(Item, startMask) Dim userMask, iniMask, i userMask = SkinnedInputBox("Edit the mask defining the Magic Node", "Edit Magic Node", startMask) If userMask = "" or userMask = Item.caption Then Exit Sub If CheckMask(userMask) Then For i=1 to masksInIniFile iniMask = getIniMask(i) If iniMask = Item.caption Then Dim oldParent, newParent oldParent = getQualifierValue(iniMask,"child of","MAGIC", True) newParent = getQualifierValue(userMask,"child of","MAGIC", True) If oldParent <> newParent And oldParent <> "MAGIC" Then ShowRestartMsg setIniMask i, userMask setIniMask 0, userMask ' mask0 is used as a default/temporary mask SDB.objects("submnu_edit" & i).Caption = userMask SDB.objects("submnu_delete" & i).Caption = userMask SDB.objects("mnu_shortcut" & i).Shortcut = getQualifierValue(userMask,"shortcut","", True) If oldParent <> newParent And newParent <> "MAGIC" Then CreateCustomNode Eval("SDB.MainTree.Node_" & newParent), 1, userMask, i ResetCustomNodeRoot ElseIf newParent = "MAGIC" Then ResetCustomNodeRoot Else UpdateCustomNode SDB.Objects("CN" & i), userMask, i End If ExpandCustomNode(i) Exit Sub End If Next Else SDB.MessageBox "The mask you entered is not valid. Please try again.", mtError, Array(mbOk) EditNodeWithStartMask Item, userMask End If End Sub Sub EditNode(Item) EditNodeWithStartMask Item, Item.Caption End Sub Sub ExpandFromMenu(item) ExpandCustomNode(Item.caption) End Sub Sub CreateMaskMenu Dim mnu_sep, mnu_Create,mnu_deleteAll, mnu_edit, mnu_delete, submnu_edit(), submnu_delete(), mnu_shortcut(), i Set mnu_sep = SDB.UI.AddMenuItemSep(SDB.UI.Menu_Edit,0,0) Set mnu_create = SDB.UI.AddMenuItem(SDB.UI.Menu_Edit,0,0) mnu_create.caption = "Create Magic Node" mnu_create.IconIndex = 33 mnu_create.OnClickFunc = "CreateNode" mnu_create.Shortcut = "Ctrl+9" mnu_create.Hint = "Create a Magic Node by specifying a mask" mnu_create.useScript = Script.ScriptPath Set mnu_edit = SDB.UI.addMenuItemSub(SDB.UI.Menu_Edit,0,0) mnu_edit.caption = "Edit Magic Node" mnu_edit.IconIndex = 10 mnu_edit.useScript = Script.ScriptPath ReDim submnu_edit(masksInIniFile) For i=0 to masksInIniFile-1 Set submnu_edit(i) = SDB.UI.addMenuItem(mnu_edit,0,0) submnu_edit(i).OnClickFunc = "EditNode" submnu_edit(i).Caption = getIniMask(i+1) submnu_edit(i).IconIndex = 10 submnu_edit(i).Hint = "Edit the node associated to this magic mask" submnu_edit(i).UseScript = Script.ScriptPath submnu_edit(i).visible = Cond(Trim(getIniMask(i+1))="",False,True) SDB.Objects("submnu_edit" & (i+1) ) = submnu_edit(i) Next Set mnu_delete = SDB.UI.addMenuItemSub(SDB.UI.Menu_Edit,0,0) mnu_delete.caption = "Delete Magic Node" mnu_delete.IconIndex = 8 mnu_delete.useScript = Script.ScriptPath ReDim submnu_delete(masksInIniFile) For i=0 to masksInIniFile-1 Set submnu_delete(i) = SDB.UI.addMenuItem(mnu_delete,0,0) submnu_delete(i).OnClickFunc = "DeleteNode" submnu_delete(i).Caption = getIniMask(i+1) submnu_delete(i).iconIndex = 8 submnu_delete(i).Hint = "Delete the node associated to this magic mask" submnu_delete(i).UseScript = Script.ScriptPath submnu_delete(i).visible = Cond(Trim(getIniMask(i+1))="",False,True) SDB.Objects("submnu_delete" & (i+1) ) = submnu_delete(i) Next ReDim mnu_shortcut(masksInIniFile) For i=0 to masksInIniFile-1 Set mnu_shortcut(i) = SDB.UI.AddmenuItem(mnu_edit,0,0) mnu_shortcut(i).onClickFunc = "ExpandFromMenu" mnu_shortcut(i).caption = (i+1) mnu_shortcut(i).visible = False mnu_shortcut(i).useScript = Script.ScriptPath mnu_shortcut(i).shortcut = getQualifierValue(getIniMask(i+1),"shortcut","", True) SDB.Objects("mnu_shortcut" & (i+1) ) = mnu_shortcut(i) Next Set mnu_deleteAll = SDB.UI.AddMenuItem(SDB.UI.Menu_Edit,0,0) mnu_deleteAll.caption = "Delete All Magic Nodes" mnu_deleteAll.IconIndex = 20 mnu_deleteAll.OnClickFunc = "DeleteAllNodes" mnu_deleteAll.Hint = "Delete all available Magic Nodes" mnu_deleteAll.useScript = Script.ScriptPath End Sub '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Startup Function '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Sub onStartUp If CurrentVersion() <= 202 Then SDB.MessageBox "Magic Nodes is only compatible with MediaMonkey 2.2 and up. Please download the latest version of MediaMonkey in order to use this script", mtWarning, Array(mbOk) Exit Sub End If Dim Tree, CustomNodeRoot Set Tree = Sdb.MainTree Set CustomNodeRoot = Tree.CreateNode CustomNodeRoot.Caption = "Magic Nodes" CustomNodeRoot.IconIndex = 13 CustomNodeRoot.UseScript = Script.ScriptPath CustomNodeRoot.onFillChildren = "FillRootCustomNode" Tree.AddNode Tree.Node_Library, CustomNodeRoot, 1 CustomNodeRoot.hasChildren = True ' Create the nodes which are not children of the custom nodes root CreateExternalNodes 'Store CustomNodeRoot so it's available for manipulation later SDB.Objects("CustomNodeRoot") = CustomNodeRoot ResetCustomNodeRoot CreateMaskMenu End Sub