The obvious difference is that my version works similar to my other node scripts in the sense that there is a report which runs in the background to populate the list. This is because it works for the whole library and therefore takes more time.
You can download it from my website. As always - feedback is appreciated!
Code: Select all
'
' MediaMonkey Script
'
' NAME: UnAutoOrganised 3.0
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 30/10/2009
'
' NOTE: This script is based on MoDementia's NeedsAutoOrganise script
'
' INSTALL: Copy to Scripts\Auto directory and add the following to Scripts.ini
' Don't forget to remove comments (') and set the order appropriately
'
' [UnAutoOrganised]
' FileName=Auto\UnAutoOrganised.vbs
' ProcName=UnAutoOrganised
' Order=10
' DisplayName=UnAutoOrganised
' Description=Populates UnAutoOrganised node
' Language=VBScript
' ScriptType=1
'
' FIXES: Fixed problems with Folder, Filename and Extension
' Fixed errors when brackets at beginning of mask
' Fixed $USE function not accepted as valid
' Fixed file mappings now includes folder delimiter
' Fixed blank track number not behaving correctly
' Fixed @ wasn't ignoring prefix strings
'
Option Explicit
Dim Debug : Debug = False
Dim IgnoreCase : IgnoreCase = False
Sub onStartUp
'default settings
Dim ini : Set ini = SDB.IniFile
If ini.StringValue("UnAutoOrganised","Debug") = "" Then
ini.BoolValue("UnAutoOrganised","Debug") = Debug
End If
If ini.StringValue("UnAutoOrganised","ICase") = "" Then
ini.BoolValue("UnAutoOrganised","ICase") = IgnoreCase
End If
'create node and add to tree
Dim tree : Set tree = SDB.MainTree
Dim node : Set node = SDB.Objects("UnAutoOrganisedNode")
If node Is Nothing Then
Set node = tree.CreateNode
node.Caption = "UnAutoOrganised"
node.IconIndex = 46
node.UseScript = Script.ScriptPath
node.OnFillTracksFunct = "ShowUnAutoOrganised"
node.SortCriteria = 2
tree.AddNode tree.Node_FilestoEdit,node,3
Set SDB.Objects("UnAutoOrganisedNode") = node
'add option sheet
Call SDB.UI.AddOptionSheet("UnAutoOrganised Settings",Script.ScriptPath,"InitSheet","SaveSheet",-3)
End If
'create exclusion list menu items
Dim itm1 : Set itm1 = SDB.Objects("UnAutoOrganisedMenu1")
If itm1 Is Nothing Then
Set itm1 = SDB.UI.AddMenuItem(SDB.UI.Menu_Pop_NP_SendTo,0,0)
itm1.Caption = "UnAutoOrganised"
itm1.OnClickFunc = "ItmClick"
itm1.UseScript = Script.ScriptPath
itm1.IconIndex = 8
Set SDB.Objects("UnAutoOrganisedMenu1") = itm1
Dim itm2 : Set itm2 = SDB.UI.AddMenuItem(SDB.UI.Menu_Pop_TrackList_SendTo,0,0)
itm2.Caption = "UnAutoOrganised"
itm2.OnClickFunc = "ItmClick"
itm2.UseScript = Script.ScriptPath
itm2.IconIndex = 8
Set SDB.Objects("UnAutoOrganisedMenu2") = itm2
End If
End Sub
Sub ShowUnAutoOrganised(node)
'check for list
Dim list : Set list = SDB.Objects("UnAutoOrganisedList")
If list Is Nothing Then
'warn node not yet populated
Call SDB.MessageBox("UnAutoOrganised: You need to select 'File|Create Reports|UnAutoOrganised' from the menu before this node will be populated.",mtInformation,Array(mbOk))
Else
'add list to main window
Dim trax : Set trax = SDB.MainTracksWindow
Dim i : i = 0
For i = 0 To list.Count-1
trax.AddTrack(list.Item(i))
Next
'finish off
trax.FinishAdding
End If
End Sub
Sub UnAutoOrganised
'initialise
Set SDB.Objects("UnAutoOrganisedList") = Nothing
Dim list : Set list = SDB.NewSongList
Dim tags : tags = "ABCEFGJKLMOPRSTUVWY"
Dim tagz : tagz = "ABCDEFGHIJKLMNO"
Dim alph : alph = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim spec : spec = "@Z"
Dim ini : Set ini = SDB.IniFile
Dim mask1 : mask1 = ini.StringValue("RenameMasks","Mask1")
IgnoreCase = ini.BoolValue("UnAutoOrganised","ICase")
Debug = ini.BoolValue("UnAutoOrganised","Debug")
If Debug Then
Call clear()
Call out("mask="&mask1)
End If
Dim var : Set var = CreateObject("Scripting.Dictionary")
Set SDB.Objects("UnAutoOrganisedVars") = var
'create progress bar
Dim prog : Set prog = SDB.Progress
prog.Value = 0
Dim iter : Set iter = SDB.Database.OpenSQL("SELECT Count(*) AS SongCount FROM Songs WHERE SongPath NOT LIKE 'http://%'")
prog.MaxValue = iter.ValueByName("SongCount")
prog.Text = "UnAutoOrganised: Initialising..."
'get character mappings
Dim i,j,s,t,u
Dim map : Set map = CreateObject("Scripting.Dictionary")
Dim keys : Set keys = ini.Keys("FilenameMappings")
For i = 0 To keys.Count-1
s = keys.Item(i)
j = InStr(s,"=")
If j > 0 Then
t = HexToChr(Left(s,j-1))
If Not (t = "") ANd Not (t = "\") Then
u = HexToChr(Mid(s,j+1))
map.Item(t) = u
End If
End If
Next
'read excluded files
Dim exc : Set exc = CreateObject("Scripting.Dictionary")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim dat : Set dat = Nothing
If fso.FileExists(Script.ScriptPath&".dat") Then
Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",1,False)
If Not (dat Is Nothing) Then
While Not (dat.AtEndOfStream)
exc.Item(dat.ReadLine) = ""
WEnd
dat.Close
End If
End If
Dim lst : lst = exc.Keys
'loop through tracks
i = 0
Set iter = SDB.Database.QuerySongs("AND Songs.SongPath NOT LIKE 'http://%'")
Do While Not iter.EOF
'update progress bar
prog.Increase
prog.Text = "UnAutoOrganised: Checking track "&prog.Value&"/"&prog.MaxValue&" (found: "&i&")..."
SDB.ProcessMessages
'calculate path
Dim song : Set song = iter.Item
Dim orig : orig = song.Path
Dim mask : mask = mask1
Dim perc : perc = False
Dim asat : asat = False
Dim text : text = False
Dim zedd : zedd = False
Dim path : path = ""
Dim temp : temp = ""
Dim atmp : atmp = ""
Dim char,k,l,m,n
'logfile
Dim mess : mess = ""
If Debug Then mess = vbcrlf&"song="&song.ID&" - "&song.Title&vbcrlf&"mask="&mask&vbcrlf
'process if statements
While InStr(UCase(mask),"$IF") > 0
Dim arr : arr = SplitIf(mask)
If Debug Then mess = mess&mask&"arr(0)="&arr(0)&vbcrlf&"arr(1)="&arr(1)&vbcrlf&"arr(2)="&arr(2)&vbcrlf&"arr(3)="&arr(3)&vbcrlf&"arr(4)="&arr(4)&vbcrlf&"arr(5)="&arr(5)&vbcrlf&"arr(6)="&arr(6)&vbcrlf
mask = ""
If Not (arr(0) = "") Then
temp = arr(0)
Call SplitTag(temp,arr(0),k)
Call Translate(song,arr(0),text,k,temp,False)
If arr(5) = "" Then
If Debug Then mess = mess&"temp="&temp&vbcrlf
If temp = "" Then
mask = arr(2)
Else
If (temp = Zeros(k)) And (arr(0) = "%T" Or arr(0) = "%Y") Then
mask = arr(2)
Else
mask = arr(1)
End If
End If
Else
atmp = arr(5)
Call SplitTag(atmp,arr(5),k)
Call Translate(song,arr(5),text,k,atmp,False)
If Debug Then mess = mess&temp&"="&atmp&vbcrlf
If Condition(temp,arr(6),atmp) Then
mask = arr(1)
Else
mask = arr(2)
End If
End If
End If
mask = arr(3)&mask&arr(4)
If Debug Then mess = mess&"mask="&mask&vbcrlf
WEnd
'translate tags
temp = ""
text = False
For j = 1 To Len(mask)
char = Mid(mask,j,1)
If perc Then
If InStr(spec,char) > 0 Then
Select Case char
Case "Z"
zedd = True
Case "@"
asat = True
End Select
Else
If zedd Then
atmp = tagz
Else
atmp = tags
End If
If InStr(atmp,char) > 0 Then
If IsNumeric(temp) Then
k = CInt(temp)
Else
k = 0
End If
If zedd Then
atmp = "%Z"&char
Else
atmp = "%"&char
End If
Call Translate(song,atmp,text,k,temp,asat)
If (temp = "") And Not (atmp = "%ZM") Then
temp = SDB.Localize("Unknown")
End If
path = path&temp
temp = ""
perc = False
asat = False
text = False
zedd = False
Else
If (zedd = False) And ((char = "N") Or (char = "D")) Then
If IsNumeric(temp) Then
k = CInt(temp)
Else
If char = "N" Then
k = 4
End If
If char = "D" Then
k = 3
End If
End If
path = path&Skip(k)
temp = ""
perc = False
asat = False
text = False
zedd = False
Else
temp = temp&char
End If
End If
End If
Else
If char = "%" Then
perc = True
Else
path = path&char
End If
End If
Next
'correct filename
While (InStr(path,".\") > 0)
path = Replace(path,".\","\")
WEnd
If Left(path,2) = "\\" Then
s = "\"
Else
s = ""
End If
While (InStr(path,"\\") > 0)
path = Replace(path,"\\","\")
WEnd
path = Replace(Replace(s&path,"$)",")"),"$,",",")
If Mid(path,2,1) = ":" Then
path = Left(path,2)&CorrectPath(map,Mid(path,3))
Else
path = CorrectPath(map,path)
End If
'process functions
Dim goes : goes = 0
Dim dpos : dpos = 1
Dim back : back = path
While (InStr(dpos,path,"$") > 0 And goes < 100)
Call Func(path,dpos)
goes = goes+1
WEnd
If goes = 100 Then
If Debug Then
Call out("[Error processing functions]")
End If
path = back
End If
'check path against mask
If Left(mask,2) = ".\" Then
orig = Mid(orig,InStrRev(orig,"\"))
End If
path = path&Mid(orig,InStrRev(orig,"."))
If IgnoreCase Then
orig = UCase(orig)
path = UCase(path)
End If
If Not(orig = path) And (Len(orig) = Len(path)) And (InStr(path,Chr(0)) > 0) Then
Dim b : b = True
For n = 1 To Len(orig)
char = Mid(path,n,1)
If Not (char = Chr(0)) And Not(char = Mid(orig,n,1)) Then
b = False
Exit For
End If
Next
If b Then
path = orig
End If
End If
If Not (orig = path) Then
If NotInList(song.Path,lst) Then
list.Add(song)
i = i + 1
If Debug Then
Call out(mess&"orig="&orig&vbcrlf&"path="&path)
End If
End If
End If
'check next track
If prog.Terminate Then
Exit Do
Else
iter.Next
End If
Loop
'finish off
Set prog = Nothing
Set SDB.Objects("UnAutoOrganisedList") = list
Set SDB.Objects("UnAutoOrganisedVars") = Nothing
j = SDB.MessageBox("UnAutoOrganised: Do you want to see the "&i&" results now?",mtConfirmation,Array(mbYes,mbNo))
If j = mrYes Then
'show node
Dim node : Set node = SDB.Objects("UnAutoOrganisedNode")
If Not (node Is Nothing) Then
Dim tree : Set tree = SDB.MainTree
tree.CurrentNode = tree.Node_Library
tree.Node_Library.Expanded = True
tree.CurrentNode = tree.Node_FilestoEdit
tree.Node_FilestoEdit.Expanded = True
tree.CurrentNode = node
End If
End If
End Sub
Function Zeros(i)
Zeros = ""
While (i > 0)
Zeros = Zeros&"0"
i = i-1
WEnd
End Function
Function Condition(a,op,b)
Condition = False
On Error Resume Next
Execute("If a "&op&" b Then Condition = True")
If Err.Number <> 0 Then
Call out("cond="&a&" "&op&" "&b&" ["&Err.Number&"]")
Err.Clear
End If
On Error Goto 0
End Function
Sub Func(path,dpos)
Dim pos : pos = InStr(dpos,path,"$")
Dim str1 : str1 = Left(path,pos-1)
Dim temp : temp = Mid(path,pos+1)
dpos = pos+1
pos = InStr(temp,"(")
If pos = 0 Then
Exit Sub
End If
'check mode
Dim mode : mode = UCase(Left(temp,pos-1))
Select Case mode
Case "LEFT"
Case "RIGHT"
Case "MID"
Case "TRIM"
Case "UPPER"
Case "LOWER"
Case "FIRST"
Case "REMOVEPREFIX"
Case "MOVEPREFIX"
Case "GROUP"
Case "REPLACE"
Case "ASSIGN"
Case "USE"
Case "LEN"
Case Else
Exit Sub
End Select
'find closing bracket
temp = Mid(temp,pos+1)
If InStr(temp,")") = 1 Then
path = str1&Mid(temp,2)
Exit Sub
End If
pos = 1
Dim opn : opn = 1
While (InStr(pos,temp,"(") > 0)
opn = opn+1
pos = InStr(pos,temp,"(")+1
WEnd
While ((opn > 0) And (pos > 1))
opn = opn-1
pos = InStr(pos,temp,")")+1
WEnd
If pos = 1 Then
pos = InStr(temp,")")+1
End If
'perform function
Dim str2 : str2 = Mid(temp,pos)
temp = Left(temp,pos-2)
Select Case mode
Case "LEFT"
temp = FuncLeft(temp)
Case "RIGHT"
temp = FuncRight(temp)
Case "MID"
temp = FuncMid(temp)
Case "TRIM"
temp = Trim(temp)
Case "UPPER"
temp = UCase(temp)
Case "LOWER"
temp = LCase(temp)
Case "FIRST"
temp = FuncFirst(temp)
Case "REMOVEPREFIX"
temp = FuncRemovePrefix(temp)
Case "MOVEPREFIX"
temp = FuncMovePrefix(temp)
Case "GROUP"
temp = FuncGroup(temp)
Case "REPLACE"
temp = FuncReplace(temp)
Case "ASSIGN"
temp = FuncAssign(temp)
Case "USE"
temp = FuncUse(temp)
Case "LEN"
temp = Length(temp)
End Select
path = str1&temp&str2
End Sub
Function FuncLeft(temp)
FuncLeft = temp
Dim p : p = InStrRev(temp,",")
If p > 0 Then
Dim n : n = Mid(temp,p+1)
If IsNumeric(n) Then
Dim s : s = Left(temp,p-1)
FuncLeft = Left(s,n)
End If
End If
End Function
Function FuncRight(temp)
FuncRight = temp
Dim p : p = InStrRev(temp,",")
If p > 0 Then
Dim n : n = Mid(temp,p+1)
If IsNumeric(n) Then
Dim s : s = Left(temp,p-1)
FuncRight = Right(s,n)
End If
End If
End Function
Function FuncMid(temp)
FuncMid = temp
Dim p : p = InStrRev(temp,",")
If p > 0 Then
Dim i : i = Mid(temp,p+1)
If IsNumeric(i) Then
Dim s : s = Left(temp,p-1)
p = InStrRev(s,",")
If p > 0 Then
Dim n : n = Mid(s,p+1)
If IsNumeric(n) Then
s = Left(s,p-1)
FuncMid = Mid(s,i,n)
Else
FuncMid = Mid(s,i)
End If
Else
FuncMid = Mid(s,i)
End If
End If
End If
End Function
Function FuncFirst(temp)
FuncFirst = temp
Dim p : p = InStrRev(temp,",")
If p > 0 Then
Dim m : m = "0"
Dim n : n = Mid(temp,p+1)
If IsNumeric(n) Then
Dim s : s = Left(temp,p-1)
p = InStrRev(s,",")
If p > 0 Then
m = Mid(s,p+1)
If IsNumeric(m) Then
s = Left(s,p-1)
Else
m = "0"
End If
End If
Dim a : a = Split(s,";")
If Int(n) >= (UBound(a)+1) Then
FuncFirst = s
Else
FuncFirst = Trim(a(Int(m)))
For p = 1 To n-1
FuncFirst = FuncFirst&"; "&Trim(a(Int(m)+p))
Next
End If
End If
End If
End Function
Function FuncRemovePrefix(temp)
FuncRemovePrefix = temp
If Not (SDB.IniFile.BoolValue("Options", "IgnoreTHEs")) Then
Exit Function
End If
Dim i : i = 0
Dim str : str = SDB.IniFile.StringValue("Options", "IgnoreTHEStrings")
Dim arr : arr = Split(str,",")
For i = 0 To UBound(arr)
str = UCase(Trim(arr(i)))&" "
If Left(temp,Len(str)) = str Then
FuncRemovePrefix = Mid(temp,Len(str)+1)
Exit For
End If
Next
End Function
Function FuncMovePrefix(temp)
FuncMovePrefix = SDB.Tools.StringForSorting(temp)
End Function
Function FuncGroup(temp)
FuncGroup = temp
Dim p : p = InStrRev(temp,",")
If p > 0 Then
Dim n : n = Mid(temp,p+1)
If IsNumeric(n) Then
Dim a : a = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim c : c = Left(temp,1)
Dim k : k = 1
FuncGroup = "0-9"
temp = Mid(a,k,n)
While Not (temp = "")
If InStr(temp,c) > 0 Then
FuncGroup = temp
temp = ""
Else
k = k + l
temp = Mid(a,k,n)
End If
WEnd
End If
End If
End Function
Function FuncReplace(temp)
FuncReplace = temp
Dim p : p = InStrRev(temp,",")
If p > 0 Then
Dim s : s = Left(temp,p-1)
Dim t : t = Mid(temp,p+1)
p = InStrRev(s,",")
If p > 0 Then
Dim u : u = Mid(s,p+1)
s = Left(s,p-1)
FuncReplace = Mid(s,t,u)
End If
End If
End Function
Function FuncAssign(temp)
FuncAssign = ""
Dim var : Set var = SDB.Objects("UnAutoOrganisedVars")
If var Is Nothing Then
Set var = CreateObject("Scripting.Dictionary")
End If
Dim p : p = InStr(temp,",")
If p > 0 Then
Dim s : s = Left(temp,p-1)
Dim t : t = Mid(temp,p+1)
var.Item(s) = t
End If
Set SDB.Objects("UnAutoOrganisedVars") = var
End Function
Function FuncUse(temp)
FuncUse = ""
Dim var : Set var = SDB.Objects("UnAutoOrganisedVars")
If Not (var Is Nothing) Then
FuncUse = var.Item(temp)
End If
End Function
Function Skip(k)
Skip = ""
Dim i : i = 0
For i = 1 To k
Skip = Skip&Chr(0)
Next
End Function
Function SplitIf(str)
'pre
Dim mess : mess = ""
Dim i : i = 0
Dim j : j = 0
Dim ope : ope = Array("<=",">=","<>","=","<",">")
Dim arr : arr = Array("","","","","","","")
Dim pos : pos = InStr(UCase(str),"$IF")
If pos > 2 Then
arr(3) = Left(str,pos-1)
End If
str = Mid(str,pos+4)
'post
pos = 0
If InStr(str,")") > 1 Then
While (pos = 0 And i<Len(str))
i = i + 1
Select Case Mid(str,i,1)
Case "("
Call CheckFunctions(i,j,str)
Case ")"
If Not (Mid(str,i-1,1) = "$") Then
If j = 0 Then
pos = i
Else
j = j - 1
End If
End If
End Select
WEnd
If pos > 1 Then
If pos < Len(str) Then
arr(4) = Mid(str,pos+1)
End If
str = Left(str,pos-1)
Else
str = ""
End If
Else
str = ""
End If
'if
pos = InStr(str,",")
If pos > 1 Then
arr(0) = Left(str,pos-1)
str = Mid(str,pos+1)
For i = 0 To UBound(ope)
pos = InStr(arr(0),ope(i))
If pos > 0 Then
Dim tstr : tstr = arr(0)
If pos > 1 Then
arr(0) = Left(tstr,pos-1)
If pos < Len(tstr) Then
arr(5) = Mid(tstr,pos+1)
End If
Else
arr(0) = ""
End If
arr(6) = ope(i)
Exit For
End If
Next
Else
str = ""
End If
'then
pos = 0
If InStr(str,",") > 0 Then
i = 0
j = 0
While (pos = 0 And i<Len(str))
i = i + 1
Select Case Mid(str,i,1)
Case "("
Call CheckFunctions(i,j,str)
Case ")"
If Not (Mid(str,i-1,1) = "$") Then
j = j - 1
End If
Case ","
If j = 0 Then
If i = 1 Then
pos = 1
Else
If Not (Mid(str,i-1,1) = "$") Then
pos = i
End If
End If
End If
End Select
WEnd
If pos > 0 Then
If pos > 1 Then
arr(1) = Left(str,pos-1)
End If
arr(2) = Mid(str,pos+1)
Else
arr(0) = ""
End If
Else
arr(0) = ""
End If
str = mess
SplitIf = arr
End Function
Sub CheckFunctions(i,j,str)
Dim s : s = UCase(str)
If i < 4 Then
Exit Sub
End If
Select Case Mid(s,i-3,3)
Case "$IF"
j = j + 1
Case "EFT"
If i > 5 Then
If Mid(s,i-5,5) = "$LEFT" Then
j = j + 1
End If
End If
Case "GHT"
If i > 6 Then
If Mid(s,i-6,6) = "$RIGHT" Then
j = j + 1
End If
End If
Case "MID"
If i > 4 Then
If Mid(s,i-4,4) = "$MID" Then
j = j + 1
End If
End If
Case "RIM"
If i > 5 Then
If Mid(s,i-5,5) = "$TRIM" Then
j = j + 1
End If
End If
Case "PER"
If i > 6 Then
If Mid(s,i-6,6) = "$UPPER" Then
j = j + 1
End If
End If
Case "WER"
If i > 6 Then
If Mid(s,i-6,6) = "$LOWER" Then
j = j + 1
End If
End If
Case "RST"
If i > 6 Then
If Mid(s,i-6,6) = "$FIRST" Then
j = j + 1
End If
End If
Case "FIX"
If i > 11 Then
If Mid(s,i-11,11) = "$MOVEPREFIX" Then
j = j + 1
Else
If i > 13 Then
If Mid(s,i-13,13) = "$REMOVEPREFIX" Then
j = j + 1
End If
End If
End If
End If
Case "OUP"
If i > 6 Then
If Mid(s,i-6,6) = "$GROUP" Then
j = j + 1
End If
End If
Case "RST"
If i > 8 Then
If Mid(s,i-8,8) = "$REPLACE" Then
j = j + 1
End If
End If
Case "IGN"
If i > 7 Then
If Mid(s,i-7,7) = "$ASSIGN" Then
j = j + 1
End If
End If
Case "LEN"
If i > 4 Then
If Mid(s,i-4,4) = "$LEN" Then
j = j + 1
End If
End If
End Select
End Sub
Sub SplitTag(str,tag,num)
tag = str
num = 0
If Left(str,1) = "%" Then
Dim i : i = 0
Dim t : t = "0"
Dim v : v = "0123456789"
For i = 2 To Len(str)
Dim c : c = Mid(str,i,1)
If InStr(v,c) = 0 Then
Exit For
Else
t = t&c
End If
Next
tag = "%"&Mid(str,i)
num = Int(t)
End If
End Sub
Sub Translate(itm,tag,text,k,tout,asat)
tout = tag
text = False
Dim i : i = 0
Select Case tag
Case "%A"
tout = itm.ArtistName
text = True
Case "%B"
tout = itm.Bitrate
If k = 0 Then k = 3
Case "%C"
tout = itm.Author
text = True
'D = <Auto Number>
Case "%E"
tout = GetPart(3,itm.Path)
text = True
Case "%F"
tout = GetPart(2,itm.Path)
text = True
Case "%G"
tout = itm.Genre
text = True
'H = <Track Length>
'I = <Playback Time>
Case "%J"
tout = itm.Custom4
text = True
Case "%K"
tout = itm.Custom5
text = True
Case "%L"
tout = itm.AlbumName
text = True
Case "%M"
If itm.BPM > 0 Then
tout = itm.BPM
Else
tout = "0"
End If
If k = 0 Then k = 3
'N = <Random>
Case "%O"
tout = itm.Path
text = True
Case "%P"
tout = GetPart(1,itm.Path)
text = True
'Q = <Playlist>
Case "%R"
tout = itm.AlbumArtistName
text = True
Case "%S"
tout = itm.Title
text = True
Case "%T"
If itm.TrackOrderStr = "" Then
tout = 0
Else
tout = itm.TrackOrderStr
If Not (IsNumeric(tout)) Then
text = True
End If
End If
Case "%U"
tout = itm.Custom1
text = True
Case "%V"
tout = itm.Custom2
text = True
Case "%W"
tout = itm.Custom3
text = True
'X = <Skip>
Case "%Y"
tout = itm.Year
If k = 0 Then k = 4
Case "%ZA"
tout = itm.Mood
text = True
Case "%ZB"
tout = itm.Occasion
text = True
Case "%ZC"
tout = itm.Tempo
text = True
Case "%ZD"
tout = itm.Comment
text = True
Case "%ZE"
tout = itm.Encoder
text = True
Case "%ZF"
tout = itm.ISRC
text = True
Case "%ZG"
tout = itm.Lyricist
text = True
Case "%ZH"
tout = itm.OriginalArtist
text = True
Case "%ZI"
tout = itm.OriginalLyricist
text = True
Case "%ZJ"
tout = itm.OriginalTitle
text = True
Case "%ZK"
tout = itm.Publisher
text = True
Case "%ZL"
tout = itm.Quality
text = True
Case "%ZM"
If itm.DiscNumberStr = "" Then
tout = ""
text = True
Else
tout = itm.DiscNumberStr
If Not (IsNumeric(tout)) Then
text = True
End If
End If
Case "%ZN"
tout = itm.MusicComposer
text = True
Case "%ZO"
tout = itm.Grouping
text = True
End Select
If Not (tout = "") Then
Dim l : l = Abs(k)
If asat Then
If l = 0 Then
l = 3
End If
Dim alph : alph = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
tout = FuncRemovePrefix(tout)
Dim c : c = Left(tout,1)
tout = "0-9"
k = 1
tag = Mid(alph,k,l)
While Not (tag = "")
If InStr(tag,c) > 0 Then
tout = tag
tag = ""
Else
k = k + l
tag = Mid(alph,k,l)
End If
WEnd
Else
If l > 0 Then
If l < Len(tout) Then
If text Or tag = "%B" Then
tout = Left(tout,l)
End If
Else
If text Then
If Len(tout) < l Then
If k < 0 Then
While Len(tout) < l
tout = tout&" "
WEnd
Else
While Len(tout) < l
tout = " "&tout
WEnd
End If
Else
tout = Left(tout,l)
End If
Else
While Len(tout) < l
tout = "0"&tout
WEnd
End If
End If
End If
End If
End If
End Sub
Function GetPart(mode,path)
GetPart = ""
Dim p2 : p2 = InStrRev(path,"\")
If p2 = 0 Then
Exit Function
End If
If mode = 1 Then 'Folder
Dim p1 : p1 = InStr(path,"\")
If p1 < p2 Then
GetPart = Mid(path,p1+1,p2-p1-1)
End If
Exit Function
End If
Dim p3 : p3 = InStrRev(path,".")
If mode = 2 Then 'Filename
If p3 > p2 Then
GetPart = Mid(path,p2+1,p3-p2-1)
End If
Exit Function
End If
If mode = 3 Then 'Extension
If p3 > p2 Then
GetPart = Mid(path,p3+1)
End If
Exit Function
End If
End Function
Sub clear()
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\UnAutoOrganised.log"
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim logf : Set logf = fso.CreateTextFile(loc,True)
logf.Close
End Sub
Sub out(txt)
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\UnAutoOrganised.log"
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim logf : Set logf = fso.OpenTextFile(loc,8,True)
logf.WriteLine(SDB.ToAscii(txt))
logf.Close
End Sub
Function NotInList(key,lst)
NotInList = False
Dim h : h = 0
For h = 0 To UBound(lst)
If Right(lst(h),1) = "\" Then
If InStr(key,lst(h)) = 1 Then
Exit Function
End If
Else
If key = lst(h) Then
Exit Function
End If
End If
Next
NotInList = True
End Function
Sub ItmClick(itm)
Dim list : Set list = SDB.SelectedSongList
If list.Count = 0 Then
Exit Sub
End If
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim dat : Set dat = Nothing
Dim i : i = 0
Dim str : str = Left(list.Item(0).Path,InStrRev(list.Item(0).Path,"\"))
Dim dir : dir = False
If list.Count > 1 Then
dir = True
For i = 1 To list.Count-1
If Not (Left(list.Item(i).Path,InStrRev(list.Item(i).Path,"\")) = str) Then
dir = False
Exit For
End If
Next
End If
If dir Then
i = SDB.MessageBox("UnAutoOrganised: Do you want to exclude the folder '"&str&"'? (Click 'No' to exclude each file individually)",mtConfirmation,Array(mbYes,mbNo,mbCancel))
Select Case i
Case mrYes
Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",8,True)
dat.WriteLine(str)
Case mrNo
dir = False
End Select
End If
If Not (dir) Then
If (dat Is Nothing) And (list.Count > 1) Then
Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",8,True)
End If
For i = 0 To list.Count-1
dat.WriteLine(list.Item(i).Path)
Next
End If
If Not (dat Is Nothing) Then
dat.Close
End If
End Sub
Sub Install()
Dim inip : inip = SDB.ApplicationPath&"Scripts\Scripts.ini"
Dim inif : Set inif = SDB.Tools.IniFileByPath(inip)
If Not (inif Is Nothing) Then
inif.StringValue("UnAutoOrganised","Filename") = "Auto\UnAutoOrganised.vbs"
inif.StringValue("UnAutoOrganised","Procname") = "UnAutoOrganised"
inif.StringValue("UnAutoOrganised","Order") = "10"
inif.StringValue("UnAutoOrganised","DisplayName") = "UnAutoOrganised"
inif.StringValue("UnAutoOrganised","Description") = "Populates UnAutoOrganised node"
inif.StringValue("UnAutoOrganised","Language") = "VBScript"
inif.StringValue("UnAutoOrganised","ScriptType") = "1"
SDB.RefreshScriptItems
End If
Call onStartUp()
End Sub
Sub InitSheet(Sheet)
Dim ini : Set ini = SDB.IniFile
Dim ui : Set ui = SDB.UI
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\UnAutoOrganised.log"
Dim exc : Set exc = CreateObject("Scripting.Dictionary")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim dat : Set dat = Nothing
If fso.FileExists(Script.ScriptPath&".dat") Then
Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",1,False)
If Not (dat Is Nothing) Then
While Not (dat.AtEndOfStream)
exc.Item(dat.ReadLine) = ""
WEnd
dat.Close
End If
End If
Dim lst : lst = exc.Keys
Dim edt : Set edt = ui.NewCheckBox(Sheet)
edt.Common.SetRect 5, 10, 400, 20
edt.Common.ControlName = "UAODebug"
edt.Caption = "Create logfile '"&loc&"'?"
edt.Checked = ini.BoolValue("UnAutoOrganised","Debug")
Set edt = ui.NewCheckBox(Sheet)
edt.Common.SetRect 5, 35, 400, 20
edt.Common.ControlName = "UAOICase"
edt.Caption = "Ignore case (non-case sensitive)?"
edt.Checked = ini.BoolValue("UnAutoOrganised","ICase")
Set edt = ui.NewLabel(Sheet)
edt.Common.SetRect 5, 60, 400, 20
edt.Caption = "EXCLUDE FILES AND FOLDERS..."
edt.Autosize = False
Dim h,i,j
If exc.Count = 0 Then
j = 0
Else
j = UBound(lst)
End If
For i = 0 To j
h = 85+(22*i)
Set edt = ui.NewEdit(Sheet)
edt.Common.SetRect 5, h, 400, 21
edt.Common.ControlName = "UAOEdit"&i
If exc.Count > 0 Then
edt.Text = lst(i)
End If
Set edt = ui.NewButton(Sheet)
edt.Common.SetRect 407, h, 21, 21
edt.Common.ControlName = "UAOBut1"&i
edt.Common.Hint = "Select a file"
edt.Caption = ".."
edt.UseScript = Script.ScriptPath
edt.OnClickFunc = "Button1Click"
Set edt = ui.NewButton(Sheet)
edt.Common.SetRect 430, h, 21, 21
edt.Common.ControlName = "UAOBut2"&i
edt.Common.Hint = "Select a folder"
edt.Caption = ".\"
edt.UseScript = Script.ScriptPath
edt.OnClickFunc = "Button2Click"
Set edt = ui.NewButton(Sheet)
edt.Common.SetRect 453, h, 21, 21
edt.Common.ControlName = "UAOBut3"&i
edt.Common.Hint = "Add a row"
edt.Caption = "+"
edt.UseScript = Script.ScriptPath
edt.OnClickFunc = "Button3Click"
Next
End Sub
Sub Button1Click(but)
Dim s : s = Mid(but.Common.ControlName,8)
If IsNumeric(s) Then
Dim edt : Set edt = but.Common.TopParent.Common.ChildControl("UAOEdit"&s)
If Not (edt Is Nothing) Then
Dim d : Set d = SDB.CommonDialog
d.Filter = "Any music file |*.*"
d.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly + cdlOFNNoChangeDir
d.InitDir = edt.Text
d.ShowOpen
If d.Ok Then
edt.Text = d.FileName
End If
End If
End If
End Sub
Sub Button2Click(but)
Dim s : s = Mid(but.Common.ControlName,8)
If IsNumeric(s) Then
Dim edt : Set edt = but.Common.TopParent.Common.ChildControl("UAOEdit"&s)
If Not (edt Is Nothing) Then
s = SDB.SelectFolder(edt.Text,"Select a folder:")
If Not (s = "") Then
If Right(s,1) = "\" Then
edt.Text = s
Else
edt.Text = s&"\"
End If
End If
End If
End If
End Sub
Sub Button3Click(but)
Dim s : s = Mid(but.Common.ControlName,8)
If IsNumeric(s) Then
Dim i : i = Int(s)+1
Dim h : h = 85+(22*i)
Dim ui : Set ui = SDB.UI
Dim Sheet : Set Sheet = but.Common.TopParent
Dim edt : Set edt = ui.NewEdit(Sheet)
edt.Common.SetRect 5, h, 400, 21
edt.Common.ControlName = "UAOEdit"&i
Set edt = ui.NewButton(Sheet)
edt.Common.SetRect 407, h, 21, 21
edt.Common.ControlName = "UAOBut1"&i
edt.Common.Hint = "Select a file"
edt.Caption = ".."
edt.UseScript = Script.ScriptPath
edt.OnClickFunc = "Button1Click"
Set edt = ui.NewButton(Sheet)
edt.Common.SetRect 430, h, 21, 21
edt.Common.ControlName = "UAOBut2"&i
edt.Common.Hint = "Select a folder"
edt.Caption = ".\"
edt.UseScript = Script.ScriptPath
edt.OnClickFunc = "Button2Click"
Set edt = ui.NewButton(Sheet)
edt.Common.SetRect 453, h, 21, 21
edt.Common.ControlName = "UAOBut3"&i
edt.Common.Hint = "Add a row"
edt.Caption = "+"
edt.UseScript = Script.ScriptPath
edt.OnClickFunc = "Button3Click"
End If
End Sub
Sub SaveSheet(Sheet)
Dim ini : Set ini = SDB.IniFile
ini.BoolValue("UnAutoOrganised","Debug") = Sheet.Common.ChildControl("UAODebug").Checked
ini.BoolValue("UnAutoOrganised","ICase") = Sheet.Common.ChildControl("UAOICase").Checked
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim dat : Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",2,True)
Dim i : i = 0
Dim j : j = 0
Dim edt : Set edt = Sheet.Common.ChildControl("UAOEdit"&i)
While Not (edt Is Nothing)
If Not (edt.Text = "") Then
dat.WriteLine(edt.Text)
j = j+1
End If
i = i+1
Set edt = Sheet.Common.ChildControl("UAOEdit"&i)
WEnd
dat.Close
If j = 0 Then
Call fso.DeleteFile(Script.ScriptPath&".dat")
End If
End Sub
Function CorrectPath(map,path)
CorrectPath = path
Dim i : i = 0
Dim a : a = map.Keys
For i = 0 To UBound(a)
CorrectPath = Replace(CorrectPath,a(i),map.Item(a(i)))
Next
End Function
Function HexToChr(h)
HexToChr = ""
If h = "" Then
Exit Function
End If
Dim c : c = 0
Dim i : i = 0
For i = Len(h) To 1 Step -1
Dim d : d = Mid(h,i,1)
d = Instr("0123456789ABCDEF",UCase(d))-1
If d >= 0 Then
c = c+(d*(16^(Len(h)-i)))
Else
c = 0
Exit For
End If
Next
If c < 256 Then
HexToChr = Chr(c)
End If
End Function