As always, the installation package is available to download from my website. Here's the code too...
Code: Select all
'
' MediaMonkey Script
'
' NAME: AutoAlbumDJ 3.8
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 08/08/2010
'
' Thanks to Abel for suggesting getting the ID range from the database
' Thanks to Randy for fixing the random number falling outside of range
' Thanks to Bex for the filter code which I've adapted
'
' INSTALL: Copy to Scripts directory
'
' FIXES:
'
Option Explicit
Dim MinTracks,AvgRating,MinRating,Capacity,Attempts,TheGenre,ModeNum
Dim Mode3f1,MaxTracks,Unplayed,Earliest,Debug,MaxDays,AvgPlays,IgnoreNon
Dim Filters(),FilterName,FilterSQL,Toolbar,Trayicon,MinDays,ApplyFilter
Public styleOn
MinTracks = 5 ' minimum tracks per album
AvgRating = 3 ' minimum average rating (stars) per album
MinRating = -1 ' minimum rating (stars) per song
Capacity = 10 ' number of albums to remember
Attempts = 100 ' number of queries to attempt
TheGenre = "" ' comma separated list, blank means any genre
Mode3f1 = False ' 3-from-1 mode
MaxTracks = 999 ' maximum tracks per album
Unplayed = False ' only select unplayed albums?
Earliest = "" ' earliest date in format "YYYYMMDD"
Debug = False ' create a debug log?
MaxDays = 9999 ' maximum number of days since added
AvgPlays = 999 ' maximum average playcount per album
IgnoreNon = False ' ignore albums without a name
ModeNum = 3 ' 3-from-1 mode control
Toolbar = False ' show toolbar button for selecting new album
FilterName = "- No Filter -"
FilterSQL = ""
MinDays = 0 ' minimum number of days since last played
Trayicon = False ' show tray icon menu item for selecting new album
ApplyFilter = False ' apply filter to tracks as well as album
Sub Install()
'set default values
Dim ini : Set ini = SDB.IniFile
ini.StringValue("AutoAlbumDJ","Enabled") = "0" 'switch off old version
If ini.StringValue("AutoAlbumDJ","MinTracks") = "" Then
ini.IntValue("AutoAlbumDJ","MinTracks") = MinTracks
End If
If ini.StringValue("AutoAlbumDJ","AvgRating") = "" Then
ini.IntValue("AutoAlbumDJ","AvgRating") = AvgRating
End If
If ini.StringValue("AutoAlbumDJ","MinRating") = "" Then
ini.IntValue("AutoAlbumDJ","MinRating") = MinRating
End If
If ini.StringValue("AutoAlbumDJ","Capacity") = "" Then
ini.IntValue("AutoAlbumDJ","Capacity") = Capacity
End If
If ini.StringValue("AutoAlbumDJ","Attempts") = "" Then
ini.IntValue("AutoAlbumDJ","Attempts") = Attempts
End If
If ini.StringValue("AutoAlbumDJ","TheGenre") = "" Then
ini.StringValue("AutoAlbumDJ","TheGenre") = TheGenre
End If
If ini.StringValue("AutoAlbumDJ","Mode3f1") = "" Then
ini.BoolValue("AutoAlbumDJ","Mode3f1") = Mode3f1
End If
If ini.StringValue("AutoAlbumDJ","MaxTracks") = "" Then
ini.IntValue("AutoAlbumDJ","MaxTracks") = MaxTracks
End If
If ini.StringValue("AutoAlbumDJ","Unplayed") = "" Then
ini.BoolValue("AutoAlbumDJ","Unplayed") = Unplayed
End If
If ini.StringValue("AutoAlbumDJ","Earliest") = "" Then
ini.StringValue("AutoAlbumDJ","Earliest") = Earliest
End If
If ini.StringValue("AutoAlbumDJ","Debug") = "" Then
ini.BoolValue("AutoAlbumDJ","Debug") = Debug
End If
If ini.StringValue("AutoAlbumDJ","MaxDays") = "" Then
ini.IntValue("AutoAlbumDJ","MaxDays") = MaxDays
End If
If ini.StringValue("AutoAlbumDJ","AvgPlays") = "" Then
ini.IntValue("AutoAlbumDJ","AvgPlays") = AvgPlays
End If
If ini.StringValue("AutoAlbumDJ","IgnoreNon") = "" Then
ini.BoolValue("AutoAlbumDJ","IgnoreNon") = IgnoreNon
End If
If ini.StringValue("AutoAlbumDJ","ModeNum") = "" Then
ini.IntValue("AutoAlbumDJ","ModeNum") = ModeNum
End If
If ini.StringValue("AutoAlbumDJ","Toolbar") = "" Then
ini.BoolValue("AutoAlbumDJ","Toolbar") = Toolbar
End If
If ini.StringValue("AutoAlbumDJ","FilterName") = "" Then
ini.StringValue("AutoAlbumDJ","FilterName") = FilterName
End If
If ini.StringValue("AutoAlbumDJ","MinDays") = "" Then
ini.IntValue("AutoAlbumDJ","MinDays") = MinDays
End If
If ini.StringValue("AutoAlbumDJ","Trayicon") = "" Then
ini.BoolValue("AutoAlbumDJ","Trayicon") = Trayicon
End If
If ini.StringValue("AutoAlbumDJ","ApplyFilter") = "" Then
ini.BoolValue("AutoAlbumDJ","ApplyFilter") = ApplyFilter
End If
'add ini entries
Set ini = SDB.Tools.IniFileByPath(SDB.ApplicationPath&"Scripts\Scripts.ini")
If Not (ini Is Nothing) Then
ini.StringValue("AutoAlbumDJ","Filename") = "AutoAlbumDJ3.vbs"
ini.StringValue("AutoAlbumDJ","DisplayName") = "Auto Album DJ"
ini.StringValue("AutoAlbumDJ","Description") = "An AutoDJ which selects whole albums"
ini.StringValue("AutoAlbumDJ","Language") = "VBScript"
ini.StringValue("AutoAlbumDJ","ScriptType") = "4"
ini.StringValue("AutoAlbumDJ2","Filename") = "AutoAlbumDJ3.vbs"
ini.StringValue("AutoAlbumDJ2","Procname") = "DoSelectAlbum"
ini.StringValue("AutoAlbumDJ2","DisplayName") = "Auto Album DJ - Play a new album"
ini.StringValue("AutoAlbumDJ2","Description") = "Auto Album DJ - Play a new album"
ini.StringValue("AutoAlbumDJ2","Language") = "VBScript"
ini.StringValue("AutoAlbumDJ2","ScriptType") = "0"
SDB.RefreshScriptItems
End If
'add toolbar button
Dim but : Set but = SDB.Objects("AADJ-Button")
If but Is Nothing Then
Set but = SDB.UI.AddMenuItem(SDB.UI.Menu_TbStandard,0,0)
but.Caption = "Play a new album"
but.IconIndex = SDB.RegisterIcon("Scripts\AADJ.ico",0)
but.UseScript = SDB.ApplicationPath&"Scripts\AutoAlbumDJ3.vbs"
but.OnClickFunc = "SelectAlbum"
but.Visible = SDB.IniFile.BoolValue("AutoAlbumDJ","Toolbar")
Set SDB.Objects("AADJ-Button") = but
End If
'add tray icon menu item
Dim itm : Set itm = SDB.Objects("AADJ-Tray")
If itm Is Nothing Then
Set itm = SDB.UI.AddMenuItem(SDB.UI.Menu_TrayIcon,2,0)
itm.Caption = "Play a new album"
itm.IconIndex = SDB.RegisterIcon("Scripts\AADJ.ico",0)
itm.UseScript = SDB.ApplicationPath&"Scripts\AutoAlbumDJ3.vbs"
itm.OnClickFunc = "SelectAlbum"
itm.Visible = SDB.IniFile.BoolValue("AutoAlbumDJ","Trayicon")
Set SDB.Objects("AADJ-Tray") = itm
End If
'initialise objects
Set SDB.Objects("AADJSongList") = Nothing
Set SDB.Objects("AADJOptsForm") = Nothing
Set SDB.Objects("AADJClearBtn") = Nothing
Set SDB.Objects("AADJClearBtn2") = Nothing
Set SDB.Objects("AADJModeCapt") = Nothing
End Sub
Sub InitConfigSheet(Sheet)
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\AutoAlbumDJ.log"
Dim ui : Set ui = SDB.UI
Dim ini : Set ini = SDB.IniFile
Mode3f1 = ini.BoolValue("AutoAlbumDJ","Mode3f1")
ModeNum = ini.IntValue("AutoAlbumDJ","ModeNum")
Debug = ini.BoolValue("AutoAlbumDJ","Debug")
Dim edt : Set edt = ui.NewCheckbox(Sheet)
edt.Common.SetRect 0, 2, 400, 20
edt.Common.ControlName = "AADJDebug"
edt.Caption = "Create logfile '"&loc&"'"
edt.Checked = Debug
Set edt = ui.NewCheckbox(Sheet)
edt.Common.SetRect 0, 23, 400, 20
edt.Common.ControlName = "AADJMode3f1"
edt.Caption = "Enable "&ModeNum&"-from-1 mode (adds "&ModeNum&" random tracks from selected album)"
edt.Checked = Mode3f1
Set SDB.Objects("AADJModeCapt") = edt
Set edt = ui.NewButton(Sheet)
edt.Common.SetRect 390, 20, 45, 21
edt.Caption = "More"
Call Script.RegisterEvent(edt,"OnClick","InitExtraSheet")
Set SDB.Objects("AADJOptsForm") = Nothing
End Sub
Sub InitExtraSheet()
Dim ini : Set ini = SDB.IniFile
MinTracks = ini.IntValue("AutoAlbumDJ","MinTracks")
AvgRating = ini.StringValue("AutoAlbumDJ","AvgRating")
MinRating = ini.StringValue("AutoAlbumDJ","MinRating")
Capacity = ini.IntValue("AutoAlbumDJ","Capacity")
Attempts = ini.IntValue("AutoAlbumDJ","Attempts")
TheGenre = ini.StringValue("AutoAlbumDJ","TheGenre")
MaxTracks = ini.IntValue("AutoAlbumDJ","MaxTracks")
Unplayed = ini.BoolValue("AutoAlbumDJ","Unplayed")
Earliest = ini.StringValue("AutoAlbumDJ","Earliest")
MaxDays = ini.IntValue("AutoAlbumDJ","MaxDays")
AvgPlays = ini.IntValue("AutoAlbumDJ","AvgPlays")
IgnoreNon = ini.BoolValue("AutoAlbumDJ","IgnoreNon")
ModeNum = ini.IntValue("AutoAlbumDJ","ModeNum")
Toolbar = ini.BoolValue("AutoAlbumDJ","Toolbar")
FilterName = ini.StringValue("AutoAlbumDJ","FilterName")
MinDays = ini.IntValue("AutoAlbumDJ","MinDays")
Trayicon = ini.BoolValue("AutoAlbumDJ","Trayicon")
ApplyFilter = ini.BoolValue("AutoAlbumDJ","ApplyFilter")
Dim ui : Set ui = SDB.UI
Dim Form : Set Form = ui.NewForm
Form.Common.SetRect 100, 100, 460, 375
Form.BorderStyle = 3
Form.FormPosition = 4
Form.Caption = "AutoAlbumDJ Settings"
Dim edt : Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 10, 50, 20
edt.Caption = "Min. tracks:"
edt.Autosize = False
Set edt = ui.NewSpinEdit(Form)
edt.Common.SetRect 85, 7, 50, 20
edt.Common.ControlName = "AADJMinTracks"
edt.MinValue = 0
edt.MaxValue = 99
edt.Value = MinTracks
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 185, 10, 50, 20
edt.Caption = "Min. avg-rating:"
edt.Autosize = False
Set edt = ui.NewDropDown(Form)
edt.Common.SetRect 285, 7, 100, 20
edt.Common.ControlName = "AADJAvgRating"
edt.AddItem("0")
edt.AddItem("0.5")
edt.AddItem("1")
edt.AddItem("1.5")
edt.AddItem("2")
edt.AddItem("2.5")
edt.AddItem("3")
edt.AddItem("3.5")
edt.AddItem("4")
edt.AddItem("4.5")
edt.AddItem("5")
edt.AddItem("Unknown")
If AvgRating = "-1" Then
edt.ItemIndex = 11
Else
edt.ItemIndex = Int(AvgRating*2)
End If
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 35, 50, 20
edt.Caption = "Max. tracks:"
edt.Autosize = False
Set edt = ui.NewSpinEdit(Form)
edt.Common.SetRect 85, 32, 50, 20
edt.Common.ControlName = "AADJMaxTracks"
edt.MinValue = 0
edt.MaxValue = 999
edt.Value = MaxTracks
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 185, 35, 50, 20
edt.Caption = "Min. rating:"
edt.Autosize = False
Set edt = ui.NewDropDown(Form)
edt.Common.SetRect 285, 32, 100, 20
edt.Common.ControlName = "AADJMinRating"
edt.AddItem("0")
edt.AddItem("0.5")
edt.AddItem("1")
edt.AddItem("1.5")
edt.AddItem("2")
edt.AddItem("2.5")
edt.AddItem("3")
edt.AddItem("3.5")
edt.AddItem("4")
edt.AddItem("4.5")
edt.AddItem("5")
edt.AddItem("Unknown")
If MinRating = "-1" Then
edt.ItemIndex = 11
Else
edt.ItemIndex = Int(MinRating*2)
End If
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 60, 50, 20
edt.Caption = "Attempts:"
edt.Autosize = False
Set edt = ui.NewSpinEdit(Form)
edt.Common.SetRect 85, 57, 50, 20
edt.Common.ControlName = "AADJAttempts"
edt.MinValue = 0
edt.MaxValue = 999
edt.Value = Attempts
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 185, 60, 50, 20
edt.Caption = "Max. avg-plays:"
edt.Autosize = False
Set edt = ui.NewSpinEdit(Form)
edt.Common.SetRect 285, 57, 50, 20
edt.Common.ControlName = "AADJAvgPlays"
edt.MinValue = 0
edt.MaxValue = 999
edt.Value = AvgPlays
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 85, 50, 20
edt.Caption = "Earliest (days):"
edt.Autosize = False
Set edt = ui.NewSpinEdit(Form)
edt.Common.SetRect 85, 82, 50, 20
edt.Common.ControlName = "AADJMaxDays"
edt.MinValue = 0
edt.MaxValue = 9999
edt.Value = MaxDays
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 185, 85, 50, 20
edt.Caption = "Earliest (date):"
edt.Autosize = False
Set edt = ui.NewEdit(Form)
edt.Common.SetRect 285, 82, 100, 20
edt.Common.ControlName = "AADJEarliest"
edt.Common.Hint = "Date in format: YYYYMMDD"
edt.Text = Earliest
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 185, 110, 50, 20
edt.Caption = "LastPlayed (days):"
edt.Autosize = False
Set edt = ui.NewSpinEdit(Form)
edt.Common.SetRect 285, 107, 50, 20
edt.Common.ControlName = "AADJMinDays"
edt.MinValue = 0
edt.MaxValue = 999
edt.Value = MinDays
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 135, 50, 20
edt.Caption = "Memory slots:"
edt.Autosize = False
Set edt = ui.NewSpinEdit(Form)
edt.Common.SetRect 85, 132, 50, 20
edt.Common.ControlName = "AADJCapacity"
edt.MinValue = 0
edt.MaxValue = 99
edt.Value = Capacity
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 160, 50, 20
edt.Caption = "Memory:"
edt.Autosize = False
Dim ddl : Set ddl = ui.NewDropDown(Form)
ddl.Common.SetRect 85, 157, 300, 20
ddl.Common.ControlName = "ddl"
ddl.Style = 2
Script.RegisterEvent ddl, "OnSelect", "DisplayCount"
Dim btn : Set btn = ui.NewButton(Form)
btn.Common.SetRect 390, 156, 50, 23
btn.Caption = "Clear"
Script.RegisterEvent btn, "OnClick", "ClearMemory"
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 185, 50, 20
edt.Caption = "Genre filter:"
edt.Autosize = False
Set edt = ui.NewEdit(Form)
edt.Common.SetRect 85, 182, 300, 20
edt.Common.ControlName = "AADJTheGenre"
edt.Common.Hint = "Comma separated list, blank means any genre"
edt.Text = TheGenre
Set btn = ui.NewButton(Form)
btn.Common.SetRect 390, 181, 50, 23
btn.Caption = "List"
Script.RegisterEvent btn, "OnClick", "ListGenres"
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 210, 50, 20
edt.Caption = "Library filter:"
edt.Autosize = False
Set edt = ui.NewDropDown(Form)
edt.Common.SetRect 85, 207, 200, 20
edt.Style = 2
edt.Common.ControlName = "AADJFilterName"
Call CreateFiltersArray()
Call FillDropDownFromArray(edt,Filters)
edt.ItemIndex = GetFiltersArrayID(FilterName)
Set edt = ui.NewCheckbox(Form)
edt.Common.SetRect 5, 235, 400, 20
edt.Common.ControlName = "AADJApplyFilter"
edt.Caption = "Apply library filter to tracks within selected album?"
edt.Checked = ApplyFilter
Set edt = ui.NewCheckbox(Form)
edt.Common.SetRect 5, 255, 400, 20
edt.Common.ControlName = "AADJUnplayed"
edt.Caption = "Only select albums which have not been played before?"
edt.Checked = Unplayed
Set edt = ui.NewCheckbox(Form)
edt.Common.SetRect 5, 275, 400, 20
edt.Common.ControlName = "AADJIgnoreNon"
edt.Caption = "Ignore albums without a name?"
edt.Checked = IgnoreNon
Set edt = ui.NewCheckbox(Form)
edt.Common.SetRect 5, 295, 400, 20
edt.Common.ControlName = "AADJToolbar"
edt.Caption = "Show toolbar button for selecting new album?"
edt.Checked = Toolbar
Set edt = ui.NewCheckbox(Form)
edt.Common.SetRect 5, 315, 400, 20
edt.Common.ControlName = "AADJTrayicon"
edt.Caption = "Show tray icon menu for selecting new album?"
edt.Checked = Trayicon
Set edt = ui.NewLabel(Form)
edt.Common.SetRect 5, 110, 50, 20
edt.Caption = "Mode ?-from-1:"
edt.Autosize = False
Set edt = ui.NewSpinEdit(Form)
edt.Common.SetRect 85, 107, 50, 20
edt.Common.ControlName = "AADJModeNum"
edt.MinValue = 0
edt.MaxValue = 999
edt.Value = ModeNum
Set SDB.Objects("AADJClearBtn") = btn
Call DisplayMemory(ddl)
Dim btn2 : Set btn2 = ui.NewButton(Form)
btn2.Common.SetRect 320, 206, 120, 23
btn2.Caption = "Clear current album"
Script.RegisterEvent btn2, "OnClick", "ClearCurrent"
Set SDB.Objects("AADJClearBtn2") = btn2
Dim BtnCancel : Set BtnCancel = ui.NewButton(Form)
BtnCancel.Caption = "&Cancel"
BtnCancel.Common.Top = 305
BtnCancel.Common.Left = Form.Common.Width - BtnCancel.Common.Width -25
BtnCancel.Cancel = True
BtnCancel.ModalResult = 2
Dim BtnBackup : Set BtnBackup = ui.NewButton(Form)
BtnBackup.Caption = "&Ok"
BtnBackup.Common.Top = BtnCancel.Common.Top
BtnBackup.Common.Left = BtnCancel.Common.Left - BtnBackup.Common.Width -5
BtnBackup.Default = True
BtnBackup.ModalResult = 1
'show form
Set SDB.Objects("AADJOptsForm") = Form
If Form.ShowModal = 1 Then
Set edt = SDB.Objects("AADJModeCapt")
If Not (edt Is Nothing) Then
ModeNum = Form.Common.ChildControl("AADJModeNum").Value
edt.Caption = "Enable "&ModeNum&"-from-1 mode (adds "&ModeNum&" random tracks from selected album)"
End If
End If
End Sub
Sub CloseConfigSheet(Sheet,SaveConfig)
Dim ini : Set ini = SDB.IniFile
Dim clr : clr = False
If ini.BoolValue("AutoAlbumDJ","Debug") Then
clr = True
End If
If SaveConfig Then
ini.BoolValue("AutoAlbumDJ","Mode3f1") = Sheet.Common.ChildControl("AADJMode3f1").Checked
ini.BoolValue("AutoAlbumDJ","Debug") = Sheet.Common.ChildControl("AADJDebug").Checked
If ini.BoolValue("AutoAlbumDJ","Debug") Then
clr = True
End If
Dim Form : Set Form = SDB.Objects("AADJOptsForm")
If Not (Form Is Nothing) Then
ini.IntValue("AutoAlbumDJ","MinTracks") = Form.Common.ChildControl("AADJMinTracks").Value
ini.IntValue("AutoAlbumDJ","Capacity") = Form.Common.ChildControl("AADJCapacity").Value
ini.IntValue("AutoAlbumDJ","Attempts") = Form.Common.ChildControl("AADJAttempts").Value
ini.StringValue("AutoAlbumDJ","TheGenre") = Form.Common.ChildControl("AADJTheGenre").Text
ini.IntValue("AutoAlbumDJ","MaxTracks") = Form.Common.ChildControl("AADJMaxTracks").Value
ini.BoolValue("AutoAlbumDJ","Unplayed") = Form.Common.ChildControl("AADJUnplayed").Checked
ini.IntValue("AutoAlbumDJ","MaxDays") = Form.Common.ChildControl("AADJMaxDays").Value
ini.IntValue("AutoAlbumDJ","AvgPlays") = Form.Common.ChildControl("AADJAvgPlays").Value
ini.BoolValue("AutoAlbumDJ","IgnoreNon") = Form.Common.ChildControl("AADJIgnoreNon").Checked
ini.IntValue("AutoAlbumDJ","ModeNum") = Form.Common.ChildControl("AADJModeNum").Value
Dim edt : Set edt = Form.Common.ChildControl("AADJFilterName")
ini.StringValue("AutoAlbumDJ","FilterName") = edt.ItemText(edt.ItemIndex)
ini.BoolValue("AutoAlbumDJ","Toolbar") = Form.Common.ChildControl("AADJToolbar").Checked
SDB.Objects("AADJ-Button").Visible = Form.Common.ChildControl("AADJToolbar").Checked
ini.BoolValue("AutoAlbumDJ","Trayicon") = Form.Common.ChildControl("AADJTrayicon").Checked
SDB.Objects("AADJ-Tray").Visible = Form.Common.ChildControl("AADJTrayicon").Checked
ini.IntValue("AutoAlbumDJ","MinDays") = Form.Common.ChildControl("AADJMinDays").Value
ini.BoolValue("AutoAlbumDJ","ApplyFilter") = Form.Common.ChildControl("AADJApplyFilter").Checked
Dim val : val = Form.Common.ChildControl("AADJMinRating").ItemIndex
If val = 11 Then
ini.StringValue("AutoAlbumDJ","MinRating") = "-1"
Else
ini.StringValue("AutoAlbumDJ","MinRating") = val/2
End If
val = Form.Common.ChildControl("AADJAvgRating").ItemIndex
If val = 11 Then
ini.StringValue("AutoAlbumDJ","AvgRating") = "-1"
Else
ini.StringValue("AutoAlbumDJ","AvgRating") = val/2
End If
Dim mem : mem = SDB.IniFile.StringValue("AutoAlbumDJ","Memory")
If Not (mem = "") Then
mem = Mid(mem,2,Len(mem)-2)
Dim arr : arr = Split(mem,"|")
Dim cap : cap = ini.IntValue("AutoAlbumDJ","Capacity")
If UBound(arr)+1 > cap Then
mem = "|"
For val = UBound(arr)-cap+1 To UBound(arr)
mem = mem&arr(val)&"|"
Next
ini.StringValue("AutoAlbumDJ","Memory") = mem
End If
End If
mem = Form.Common.ChildControl("AADJEarliest").Text
If Not (mem = "") Then
If ValidDate(mem) Then
ini.StringValue("AutoAlbumDJ","Earliest") = mem
Else
ini.StringValue("AutoAlbumDJ","Earliest") = ""
Call SDB.MessageBox("AutoAlbumDJ: Earliest date invalid, should be YYYYMMDD.",mtError,Array(mbOk))
End If
End If
End If
End If
Set SDB.Objects("AADJClearBtn") = Nothing
Set SDB.Objects("AADJClearBtn2") = Nothing
Set SDB.Objects("AADJModeCapt") = Nothing
If clr Then
Call clear()
End If
End Sub
Sub DoSelectAlbum()
Call SelectAlbum(Nothing)
End Sub
Sub SelectAlbum(but)
Debug = SDB.IniFile.BoolValue("AutoAlbumDJ","Debug")
If Debug Then
Call out("[SelectAlbum]")
End If
Dim song : Set song = SDB.Player.CurrentSong
If song Is Nothing Then
Exit Sub
End If
Dim aid : aid = song.Album.ID
If aid < 0 Then
Exit Sub
End If
Dim list : Set list = SDB.Objects("AADJSongList")
If Not (list Is Nothing) Then
If list.Count > 0 Then
If list.Item(0).Album.ID = aid Then
Set SDB.Objects("AADJSongList") = Nothing
SDB.IniFile.StringValue("AutoAlbumDJ","SongList") = ""
End If
End If
End If
Dim vol : vol = SDB.Player.Volume
SDB.Player.Volume = 0
SDB.Player.Next
While (SDB.Player.CurrentSong.Album.ID = aid)
Call SDB.Tools.Sleep(100)
SDB.ProcessMessages
If SDB.Player.CurrentSongIndex+1 = SDB.Player.PlaylistCount Then
SDB.Player.Volume = vol
Exit Sub
End If
SDB.Player.Next
WEnd
SDB.Player.Volume = vol
End Sub
Function GenerateNewTrack
Debug = SDB.IniFile.BoolValue("AutoAlbumDJ","Debug")
If Debug Then
Call out("[GenerateNewTrack]")
End If
Dim iter,i,str,arr
Dim list : Set list = SDB.Objects("AADJSongList")
If Not (list Is Nothing) Then
If list.Count = 0 Then
Set list = Nothing
End If
End If
If list Is Nothing Then
str = SDB.IniFile.StringValue("AutoAlbumDJ","SongList")
If str = "" Then
Call AutoAlbumDJ(list)
Else
arr = Split(str,",")
Set list = SDB.NewSongList
For i = 0 To UBound(arr)
Set iter = SDB.Database.QuerySongs("ID="&arr(i))
If Not iter.EOF Then
Call list.Add(iter.Item)
End If
Next
If list.Count = 0 Then
Set list = Nothing
End If
End If
End If
If list Is Nothing Then
FilterName = SDB.IniFile.StringValue("AutoAlbumDJ","FilterName")
FilterSQL = GetFilterSQL(FilterName)
Set iter = SDB.Database.OpenSQL("SELECT ID FROM Songs WHERE ID>0 "&FilterSQL&" ORDER BY Random(*) LIMIT 1")
Set iter = SDB.Database.QuerySongs("ID="&iter.ValueByIndex(0))
Set GenerateNewTrack = iter.Item
If Debug Then
Call out("Random track: "&GenerateNewTrack.Title&" ("&GenerateNewTrack.ID&")")
End If
Set SDB.Objects("AADJSongList") = Nothing
Else
Set GenerateNewTrack = list.Item(0)
If Debug Then
Call out("Next track: "&GenerateNewTrack.Title&" ("&GenerateNewTrack.ID&")")
End If
If list.Count = 1 Then
If Debug Then
Call out("(End of list)")
End If
Call AutoAlbumDJ(list)
Else
Call list.Delete(0)
End If
Set SDB.Objects("AADJSongList") = list
End If
str = ""
If Not (list Is Nothing) Then
If list.Count > 0 Then
str = list.Item(0).ID
For i = 1 To list.Count-1
str = str&","&list.Item(i).ID
Next
End If
End If
SDB.IniFile.StringValue("AutoAlbumDJ","SongList") = str
End Function
Sub AutoAlbumDJ(list)
'populate variables
Dim ini : Set ini = SDB.IniFile
MinTracks = ini.IntValue("AutoAlbumDJ","MinTracks")
AvgRating = ini.StringValue("AutoAlbumDJ","AvgRating")*1
MinRating = ini.StringValue("AutoAlbumDJ","MinRating")*1
Capacity = ini.IntValue("AutoAlbumDJ","Capacity")
Attempts = ini.IntValue("AutoAlbumDJ","Attempts")
TheGenre = ini.StringValue("AutoAlbumDJ","TheGenre")
Mode3f1 = ini.BoolValue("AutoAlbumDJ","Mode3f1")
MaxTracks = ini.IntValue("AutoAlbumDJ","MaxTracks")
Unplayed = ini.BoolValue("AutoAlbumDJ","Unplayed")
Earliest = ini.StringValue("AutoAlbumDJ","Earliest")
Debug = ini.BoolValue("AutoAlbumDJ","Debug")
MaxDays = ini.IntValue("AutoAlbumDJ","MaxDays")
AvgPlays = ini.IntValue("AutoAlbumDJ","AvgPlays")
IgnoreNon = ini.BoolValue("AutoAlbumDJ","IgnoreNon")
ModeNum = ini.IntValue("AutoAlbumDJ","ModeNum")
FilterName = ini.StringValue("AutoAlbumDJ","FilterName")
FilterSQL = GetFilterSQL(FilterName)
MinDays = ini.IntValue("AutoAlbumDJ","MinDays")
ApplyFilter = ini.BoolValue("AutoAlbumDJ","ApplyFilter")
'select random album
Dim mem : mem = ini.StringValue("AutoAlbumDJ","Memory")
Dim str : str = "SELECT MIN(ID) AS Minval, MAX(ID) AS Maxval, COUNT(ID) AS Totval FROM Albums WHERE ID>0"
If IgnoreNon Then
str = str&" AND Album != ''"
End If
Dim iter : Set iter = SDB.Database.OpenSQL(str)
Dim min : min = iter.ValueByName("Minval")
Dim max : max = iter.ValueByName("Maxval")
Dim boo : boo = True
Dim ind : ind = 0
Dim tot : tot = 0
Dim loops : loops = 0
Randomize
'calculate rating values
Dim minrat : minrat = 0
Select Case MinRating
Case -1
minrat = -2
Case 0
minrat = -1
Case Else
minrat = (MinRating*20)-5
End Select
Dim avgrat : avgrat = 0
Select Case AvgRating
Case -1
avgrat = -2
Case 0
avgrat = -1
Case Else
avgrat = (AvgRating*20)-5
End Select
If Debug Then
Call out("MinTracks = "&MinTracks)
Call out("AvgRating = "&AvgRating&" ("&(avgrat+1)&")")
Call out("MinRating = "&MinRating&" ("&(minrat+1)&")")
Call out("Capacity = "&Capacity)
Call out("Attempts = "&Attempts)
Call out("TheGenre = "&TheGenre)
Call out("Mode3f1 = "&Mode3f1)
Call out("ModeNum = "&ModeNum)
Call out("MaxTracks = "&MaxTracks)
Call out("Unplayed = "&Unplayed)
Call out("Earliest = "&Earliest)
Call out("MaxDays = "&MaxDays)
Call out("AvgPlays = "&AvgPlays)
Call out("IgnoreNon = "&IgnoreNon)
Call out("MinDays = "&MinDays)
Call out("ApplyFilter = "&ApplyFilter)
Call out("min(id) = "&min)
Call out("max(id) = "&max)
Call out("tot(id) = "&iter.StringByName("Totval"))
End If
'loop until valid album found
Do
boo = True
ind = Int((max-min+1)*Rnd)+min
'ensure album name isn't blank
If IgnoreNon Then
Set iter = SDB.Database.OpenSQL("SELECT Album FROM Albums WHERE ID="&ind)
If iter.EOF Then
boo = False
If Debug Then
Call out(ind&" not in database")
End if
Else
If iter.StringByName("Album") = "" Then
boo = False
If Debug Then
Call out(ind&" has no name")
End if
End If
End If
End If
'ensure album hasn't been selected recently
If (InStr(mem,"|"&ind&"|") > 0) Or (boo = False) Then
If boo Then
boo = False
If Debug Then
Call out(ind&" is in memory")
End If
End If
Else
'ensure there are enough tracks with minimum rating and matching genre and within filter
If TheGenre = "" Then
str = "SELECT Count(*) As Nombre FROM Songs WHERE IDAlbum="&ind&" AND Rating>"&minrat&" "&FilterSQL
Else
str = "SELECT Count(*) As Nombre FROM Songs,GenresSongs,Genres WHERE Songs.IDAlbum="&ind&" AND Songs.Rating>"&minrat&" AND GenresSongs.IDSong = Songs.ID AND GenresSongs.IDGenre = Genres.IDGenre AND Genres.GenreName IN ('"&Replace(TheGenre,",","','")&"') "&FilterSQL
End If
Set iter = SDB.Database.OpenSQL(str)
tot = Int(iter.ValueByName("Nombre"))
If (tot*1 < MinTracks*1) Or (tot*1 > MaxTracks*1) Then
If tot*1 < MinTracks*1 Then
str = "(too few)"
Else
str = "(too many)"
End If
boo = False
If Debug Then
If TheGenre = "" Then
Call out(ind&" has "&tot&" tracks above minimum rating "&str)
Else
Call out(ind&" has "&tot&" tracks above minimum rating and matching genres "&str)
End If
End If
Else
'ensure the average is high enough
str = "SELECT AVG(Rating) As AvgRating, MAX(PlayCounter) As MaxPlayed, MIN(DateAdded) As MinDate, AVG(PlayCounter) As AvgPlays, MAX(LastTimePlayed) As MaxTime FROM Songs WHERE IDAlbum="&ind
Set iter = SDB.Database.OpenSQL(str)
tot = FixLocale(iter.StringByName("AvgRating"))/20
If (tot*1 < AvgRating*1) Then
boo = False
If Debug Then Call out(ind&" has average rating of "&tot)
Else
'ensure tracks are unplayed
tot = iter.ValueByName("MaxPlayed")
If (Unplayed) And (tot*1 > 0) Then
boo = False
If Debug Then Call out(ind&" has a track played "&tot&" times")
Else
'ensure the playcount average is not too high
tot = FixLocale(iter.StringByName("AvgPlays"))
If tot*1 > AvgPlays*1 Then
boo = False
If Debug Then Call out(ind&" has tracks on average played "&tot&" times")
Else
'ensure not before earliest days
str = iter.StringByName("MinDate")
tot = DateDiff("d",DateAdd("d",(Left(str,InStr(str,".")-1)-1),#01/01/1900#),Date())
If tot*1 > MaxDays*1 Then
boo = False
If Debug Then Call out(ind&" has a track added "&tot&" days ago")
Else
'ensure the last played maximum is not too recent
str = iter.StringByName("MaxTime")
tot = DateDiff("d",DateAdd("d",(Left(str,InStr(str,".")-1)-1),#01/01/1900#),Date())
If tot*1 < MinDays*1 Then
boo = False
If Debug Then Call out(ind&" has a track played "&tot&" days ago")
Else
'ensure not before earliest date
If Not ( Earliest = "" ) Then
str = iter.StringByName("MinDate")
Dim days : days = Left(str,InStr(str,".")-1)
Dim tmp : tmp = FixDate(DateAdd("d",(days-2),#01/01/1900#))
If tmp < Earliest Then
boo = False
If Debug Then Call out(ind&" has a track added "&tmp)
End If
End If
End If
End If
End If
End If
End If
End If
End If
'ensure infinite loop doesn't occur
SDB.ProcessMessages
loops = loops + 1
If loops >= Attempts Then
Exit Do
End If
Loop Until boo
'check album was found
If boo Then
'add album to now playing
Set list = SDB.NewSongList
If Mode3f1 Then
str = "AND (Songs.IDAlbum="&ind&") AND (Songs.Rating>"&minrat&") ORDER BY Random(*)"
Set iter = SDB.Database.QuerySongs(str)
For loops = 1 To ModeNum
If iter.EOF Then
Exit For
End If
If Debug Then Call out("Adding track: "&iter.Item.Title&" ("&iter.Item.ID&")")
Call list.Add(iter.Item)
Iter.Next
Next
Else
str = "AND (Songs.IDAlbum="&ind&") AND (Songs.Rating>"&minrat&") "
If ApplyFilter Then
str = str&FilterSQL
End If
str = str&" ORDER BY CAST(Songs.DiscNumber AS INTEGER), CAST(Songs.TrackNumber AS INTEGER)"
Set iter = SDB.Database.QuerySongs(str)
Do While Not iter.EOF
If Debug Then Call out("Adding track: "&iter.Item.Title&" ("&iter.Item.ID&")")
Call list.Add(iter.Item)
Iter.Next
Loop
End If
'add album to memory
If mem = "" Then
ini.StringValue("AutoAlbumDJ","Memory") = "|"&ind&"|"
Else
mem = mem&ind
Dim arr : arr = Split(Mid(mem,2),"|")
If UBound(arr)+1 > Capacity Then
Dim pos : pos = InStr(2,mem,"|")
If (pos > 0) And (pos < Len(mem)) Then
mem = Mid(mem,pos)
Else
mem = "|"&ind
End If
End If
ini.StringValue("AutoAlbumDJ","Memory") = mem&"|"
End If
If Debug Then Call out(ind&" has been selected :)")
Else
If Debug Then Call out("No album has been selected :(")
Set list = Nothing
End If
End Sub
Sub DisplayMemory(List)
Dim btn : Set btn = SDB.Objects("AADJClearBtn")
Dim mem : mem = SDB.IniFile.StringValue("AutoAlbumDJ","Memory")
If Not (mem = "") Then
mem = Mid(mem,2,Len(mem)-2)
Dim arr : arr = Split(mem,"|")
Dim max : max = UBound(arr)+1
Dim i,sql,iter
List.AddItem(max&" albums...")
For i = max To 1 Step -1
sql = "SELECT Album, Artist FROM Albums WHERE Albums.ID="&arr(i-1)
Set iter = SDB.Database.OpenSQL(sql)
If iter.EOF Then
sql = "(Unknown album)"
Else
sql = iter.StringByName("Artist")&" - "&iter.StringByName("Album")
End If
If i > 9 Then
List.AddItem(i&". "&sql)
Else
List.AddItem("0"&i&". "&sql)
End If
Next
btn.Common.Enabled = True
Else
List.AddItem("0 albums...")
btn.Common.Enabled = False
End If
List.ItemIndex = 0
End Sub
Sub DisplayCount(List)
List.ItemIndex = 0
End Sub
Sub ClearMemory
SDB.IniFile.StringValue("AutoAlbumDJ","Memory") = ""
Dim btn : Set btn = SDB.Objects("AADJClearBtn")
If Not (btn Is Nothing) Then
btn.Common.Enabled = False
End If
Dim ddl : Set ddl = btn.Common.Parent.Common.ChildControl("ddl")
If Not (ddl Is Nothing) Then
Do While (ddl.ItemCount > 0)
ddl.DeleteItem(0)
Loop
ddl.AddItem("0 albums...")
ddl.ItemIndex = 0
End If
End Sub
Sub ListGenres
Dim Opts : Set Opts = SDB.Objects("AADJOptsForm")
If (Opts Is Nothing) Then
Exit Sub
End If
Dim Dict : Set Dict = CreateObject("Scripting.Dictionary")
Dim i : i = 0
Dim str : str = Opts.Common.ChildControl("AADJTheGenre").Text
If Not (str = "") Then
Dim arr : arr = Split(str,",")
For i = 0 To UBound(arr)
Dict.Item(arr(i)) = "#"&i
Next
End If
Dim UI : Set UI = SDB.UI
Dim Form : Set Form = UI.NewForm
Form.Common.SetRect 50, 50, 500, 400
Form.Common.MinWidth = 200
Form.Common.MinHeight = 150
Form.FormPosition = 4
Form.Caption = "AutoAlbumDJ Settings - Genre Filter"
Form.StayOnTop = True
Dim WB : Set WB = UI.NewActiveX(Form,"Shell.Explorer")
WB.Common.Align = 5
WB.Common.ControlName = "WB"
Dim doc : Set doc = WB.Interf.Document
Dim Foot : Set Foot = UI.NewPanel(Form)
Foot.Common.Align = 2
Foot.Common.Height = 35
Dim Btn : Set Btn = UI.NewButton(Foot)
Btn.Caption = SDB.Localize("&Cancel")
Btn.Common.SetRect (Foot.Common.Width - 180)/2+95, 9, 85, 24
Btn.Common.Anchors = 12
Btn.UseScript = Script.ScriptPath
Btn.OnClickFunc = "OnCancel"
Dim Btn2 : Set Btn2 = UI.NewButton(Foot)
Btn2.Caption = SDB.Localize("&Ok")
Btn2.Common.SetRect (Foot.Common.Width - 180)/2, 9, 85, 24
Btn2.Common.Anchors = 12
Btn2.UseScript = Script.ScriptPath
Btn2.OnClickFunc = "OnOk"
Form.Common.Visible = True
Set SDB.Objects("AADJListForm") = Form
doc.write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"&vbcrlf
doc.write "<html>"&vbcrlf
doc.write " <head>"&vbcrlf
doc.write " <title>AutoAlbumDJ Settings - Genre Filter</title>"&vbcrlf
doc.write " <style type=""text/css"">"&vbcrlf
doc.write " body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}"&vbcrlf
doc.write " H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-align:left}"&vbcrlf
doc.write " P{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000;}"&vbcrlf
doc.write " TH{font-family:'Verdana',sans-serif; font-size:9pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}"&vbcrlf
doc.write " TD{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}"&vbcrlf
doc.write " TD.highlight{font-family:'Verdana',sans-serif; font-size:8pt; background-color:#FFFF77; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}"&vbcrlf
doc.write " TR.dark{background-color:#EEEEEE}"&vbcrlf
doc.write " TR.aleft TH{text-align:left}"&vbcrlf
doc.write " </style>"&vbcrlf
doc.write " </head>"&vbcrlf
doc.write " <body>"&vbcrlf
doc.write " <table border=""0"" cellspacing=""0"" cellpadding=""4"" width=""100%"">"&vbcrlf
doc.write " <tr class=""aleft"">"&vbcrlf
doc.write " <th>Genre</th>"&vbcrlf
doc.write " <th>Useage</th>"&vbcrlf
doc.write " <th> </th>"&vbcrlf
doc.write " </tr>"&vbcrlf
Dim Iter : Set Iter = SDB.Database.OpenSQL("SELECT GenreName,UsageCount,IDGenre FROM Genres ORDER BY GenreName")
While Not Iter.EOF
Dim nam : nam = Iter.StringByIndex(0)
doc.write " <tr"&Style()&">"&vbcrlf
doc.write " <td>"&MapXML(nam)&"</td>"&vbcrlf
doc.write " <td>"&MapXML(Iter.StringByIndex(1))&"</td>"&vbcrlf
If Dict.Exists(nam) Then
doc.write " <td><input type=""checkbox"" id="""&Iter.StringByIndex(2)&""" value=""checked"" checked=""checked"" /></td>"&vbcrlf
Else
doc.write " <td><input type=""checkbox"" id="""&Iter.StringByIndex(2)&""" value=""checked"" /></td>"&vbcrlf
End If
doc.write " </tr>"&vbcrlf
Iter.Next
WEnd
doc.write " </table>"&vbcrlf
doc.write " </body>"&vbcrlf
doc.write "</html>"&vbcrlf
doc.close
End Sub
Sub OnCancel(Btn)
Set SDB.Objects("AADJListForm") = Nothing
End Sub
Sub OnOk(Btn)
Dim Form : Set Form = SDB.Objects("AADJListForm")
Dim Opts : Set Opts = SDB.Objects("AADJOptsForm")
If (Opts Is Nothing) Or (Form Is Nothing) Then
Set SDB.Objects("AADJListForm") = Nothing
Exit Sub
End If
Dim str : str = ""
Dim doc : Set doc = Form.Common.ChildControl("WB").Interf.Document
Dim Iter : Set Iter = SDB.Database.OpenSQL("SELECT IDGenre,GenreName FROM Genres ORDER BY GenreName")
While Not Iter.EOF
Dim chk : Set chk = doc.getElementById(Iter.StringByIndex(0))
If Not (chk Is Nothing) Then
If chk.checked Then
If str = "" Then
str = Iter.StringByIndex(1)
Else
str = str&","&Iter.StringByIndex(1)
End If
End If
End If
Iter.Next
WEnd
Opts.Common.ChildControl("AADJTheGenre").Text = str
Set SDB.Objects("AADJListForm") = Nothing
End Sub
Function Style()
styleOn = Not styleOn
If styleOn Then
Style = ""
Else
Style = " class=""Dark"""
End If
End Function
Function MapXML(orig)
If (orig = "") Then
MapXML = " "
Exit Function
End If
Dim hold : hold = Replace(orig,"&","&")
hold = Replace(hold," "," ")
hold = Replace(hold,"<","<")
hold = Replace(hold,">",">")
Dim i : i = 1
While i<=Len(hold)
If (AscW(Mid(hold,i,1))>127) Then
hold = Mid(hold,1,i-1)+"&#"+CStr(AscW(Mid(hold,i,1)))+";"+Mid(hold,i+1)
End If
i = i+1
WEnd
MapXML = hold
End Function
Sub ClearCurrent
Dim btn : Set btn = SDB.Objects("AADJClearBtn2")
If Not (btn Is Nothing) Then
btn.Common.Enabled = False
End If
Set SDB.Objects("AADJSongList") = Nothing
SDB.IniFile.StringValue("AutoAlbumDJ","SongList") = ""
End Sub
Function ValidDate(d)
ValidDate = False
If Not (Len(d) = 8) Then Exit Function
Dim i : i = 0
Dim v : v = "1234567890"
For i = 1 To Len(d)
If InStr(v,Mid(d,i,1)) = 0 Then Exit Function
Next
i = Int(Left(d,4))
If (i<1900) Or (i>2100) Then Exit Function
i = Int(Mid(d,5,2))
If (i<1) Or (i>12) Then Exit Function
i = Int(Right(d,2))
If (i<1) Or (i>31) Then Exit Function
ValidDate = True
End Function
Function FixDate(d)
If Len(d) = 10 Then
FixDate = Right(d,4)&Mid(d,4,2)&Left(d,2)
Else
FixDate = "19000101"
End If
End Function
Function FixLocale(rat)
Dim a : a = "0123456789"
Dim i : i = 0
Dim r : r = ""
If InStr(rat,"-") = 0 Then
For i = 1 To Len(rat)
If InStr(a,Mid(rat,i,1)) = 0 Then
r = Left(rat,i-1)
Exit For
End If
Next
End If
If r = "" Then
FixLocale = -20
Else
FixLocale = Int(r)
End If
End Function
Function GetFilterID(Name)
If SDB.Database.OpenSQL("SELECT COUNT(*) FROM Filters WHERE Name='"& Replace(Name,"'","''") &"'").ValueByIndex(0) = 0 Then
If SDB.MessageBox("The used Filter named ''"& Name &"'' does not any longer exist." & VbNewLine &_
"Do you wish to create the Report anyway without any Filter applied?" & VbNewLine &_
"(Click No to apply an existing Filter and run the Report again.)", mtWarning, Array(mbYes,mbNo)) = mrYes Then
FilterName = "- No Filter -"
SDB.IniFile.StringValue("AdvancedReport","FilterName") = FilterName
GetFilterID = -1
Else
Exit Function
End If
Else
GetFilterID = SDB.Database.OpenSQL("SELECT ID FROM Filters WHERE Name='"& Replace(Name,"'","''") &"'").ValueByIndex(0)
End If
End Function
Sub FillDropDownFromArray(DropDown, SourceArray)
Dim i
For i = 0 To UBound(SourceArray)
DropDown.AddItem SourceArray(i)
Next
End Sub
Sub CreateFiltersArray
Dim i,iter : Redim Filters(SDB.Database.OpenSQL("SELECT COUNT(*) FROM Filters").ValueByIndex(0)+1)
Filters(0) = "- No Filter -"
Filters(1) = "- Active Filter -"
i=2
Set iter = SDB.Database.OpenSQL("SELECT Name FROM Filters ORDER BY Pos")
Do While Not iter.EOF
Filters(i) = iter.StringByIndex(0)
i=i+1
iter.Next
Loop
Set iter = Nothing
End sub
Function GetFiltersArrayID(Name)
Dim i,exists
exists = False
For i=0 To Ubound(Filters)
If Filters(i)=Name Then
GetFiltersArrayID=i
exists = True
Exit For
End If
Next
If not exists Then GetFiltersArrayID=0
End Function
Function GetFilterSQL(Name)
Dim pAnd
Select Case Name
Case "- No Filter -"
GetFilterSQL = ""
Case "- Active Filter -"
If Not SDB.Database.ActiveFilterQuery = "" Then pAnd = "AND "
GetFilterSQL = pAnd & SDB.Database.ActiveFilterQuery
Case Else
If GetFilterID(Name) = -1 Then
GetFilterSQL = ""
Else
If Not SDB.Database.GetFilterQuery(GetFilterID(Name)) = "" Then pAnd = "AND "
GetFilterSQL = pAnd & SDB.Database.GetFilterQuery(GetFilterID(Name))
End If
End Select
End Function
Sub clear()
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\AutoAlbumDJ.log"
Dim logf : Set logf = fso.CreateTextFile(loc,True)
logf.Close
End Sub
Sub out(txt)
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\AutoAlbumDJ.log"
Dim logf : Set logf = fso.OpenTextFile(loc,8,True)
logf.WriteLine(SDB.ToAscii(txt))
logf.Close
End Sub