A new node called "MP3Tunes Locker" will be added below the "Library" node. Expanding this will attempt to log you in, showing you a screen to enter your username and password (with options to store these values - the password is encrypted before storing). Once access has been granted the artists and albums in your locker will be displayed in the tree. Clicking on an album will show all the tracks in the album which are in your locker - these tracks are added to your library and can be played and tagged like any others, although changing the tags will not affect the tags in your locker.
If you delete one of these locker tracks in MM then it will also be deleted from your locker. In this case it is moved to the "trash" folder so you can access your locker online to undo this action. If you select library tracks, right-click and select "Send to... > MP3Tunes Locker" then the tracks will be uploaded to your locker. You will need to collapse and expand the "MP3Tunes Locker" node to refresh the artist and album lists.
As always the download link is on my website. Let me know what you think!
- Code: Select all
'
' MediaMonkey Script
'
' NAME: MP3TunesLocker 1.1
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 26/06/2010
'
' INSTALL: Copy to Scripts\Auto directory
'
' FIXES: Fixed locker songs left in library after uninstallation
'
Option Explicit
Dim pid : pid = "1529827848"
Sub onStartUp
'create tree
Dim Root : Set Root = SDB.Objects("MP3TunesLockerRoot")
If Root Is Nothing Then
Dim Tree : Set Tree = SDB.MainTree
Set Root = Tree.CreateNode
Root.Caption = "MP3Tunes Locker"
Root.IconIndex = SDB.RegisterIcon("Scripts\MP3TunesLocker.ico",1)
Root.UseScript = Script.ScriptPath
Root.OnFillChildren = "FillLocker"
Tree.AddNode Tree.Node_Library, Root, 1
Root.HasChildren = True
Set SDB.Objects("MP3TunesLockerRoot") = Root
End If
'create send to menu items
Dim itm1 : Set itm1 = SDB.Objects("MP3TunesLockerMenu1")
If itm1 Is Nothing Then
Set itm1 = SDB.UI.AddMenuItem(SDB.UI.Menu_Pop_NP_SendTo,0,0)
itm1.Caption = "MP3Tunes Locker"
itm1.OnClickFunc = "SendToClick"
itm1.UseScript = Script.ScriptPath
itm1.IconIndex = Root.IconIndex
Set SDB.Objects("MP3TunesLockerMenu1") = itm1
Dim itm2 : Set itm2 = SDB.UI.AddMenuItem(SDB.UI.Menu_Pop_TrackList_SendTo,0,0)
itm2.Caption = "MP3Tunes Locker"
itm2.OnClickFunc = "SendToClick"
itm2.UseScript = Script.ScriptPath
itm2.IconIndex = Root.IconIndex
Set SDB.Objects("MP3TunesLockerMenu2") = itm2
Dim itm3 : Set itm3 = SDB.UI.AddMenuItem(SDB.UI.Menu_Pop_NP_MainWindow_SendTo,0,0)
itm3.Caption = "MP3Tunes Locker"
itm3.OnClickFunc = "SendToClick"
itm3.UseScript = Script.ScriptPath
itm3.IconIndex = Root.IconIndex
Set SDB.Objects("MP3TunesLockerMenu3") = itm3
End If
'check progress
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Set SDB.Objects("MP3TunesLockerProg2") = Nothing
'load settings
Dim Dict : Set Dict = CreateObject("Scripting.Dictionary")
Dim Inif : Set Inif = SDB.IniFile
Dim mem : mem = Inif.StringValue("MP3TunesLocker","Remember")
If mem = "" Then
mem = "YN"
End If
Dim psw : psw = ""
Dim usr : usr = Inif.StringValue("MP3TunesLocker","Username")
If Not (usr = "") Then
psw = Decrypt(Inif.StringValue("MP3TunesLocker","Password"))
End If
Dict.Item("session#") = ""
Dict.Item("username") = usr
Dict.Item("password") = psw
Dict.Item("remeuser") = Mid(mem,1,1)
Dict.Item("remepass") = Mid(mem,2,1)
Dict.Item("timeoutc") = "-1"
Set SDB.Objects("MP3TunesLockerDict") = Dict
'create tables
Dim Mmdb : Set Mmdb = SDB.Database
Mmdb.ExecSQL("CREATE TABLE IF NOT EXISTS LockerUsr (Id INTEGER PRIMARY KEY, Email TEXT COLLATE IUNICODE, CurSize INTEGER, MaxSize INTEGER, Type TEXT COLLATE IUNICODE, Last INTEGER)")
Mmdb.ExecSQL("CREATE TABLE IF NOT EXISTS LockerArt (Id INTEGER PRIMARY KEY, Name TEXT COLLATE IUNICODE, Size INTEGER, Albums INTEGER, Tracks INTEGER)")
Mmdb.ExecSQL("CREATE TABLE IF NOT EXISTS LockerAlb (Id INTEGER PRIMARY KEY, Title TEXT COLLATE IUNICODE, ArtistId INTEGER, Name TEXT COLLATE IUNICODE, Size INTEGER, Tracks INTEGER)")
Mmdb.ExecSQL("CREATE TABLE IF NOT EXISTS LockerTrk (Id INTEGER PRIMARY KEY, SongsId INTEGER, AlbumId INTEGER, ArtistId INTEGER, Session TEXT COLLATE IUNICODE, DUrl TEXT COLLATE IUNICODE, PUrl TEXT COLLATE IUNICODE, AUrl TEXT COLLATE IUNICODE, FKey TEXT COLLATE IUNICODE)")
'register events
Call Script.RegisterEvent(SDB,"OnTrackDeleting","CancelDelete")
End Sub
Sub FillLocker(Node)
Node.HasChildren = False
'get dictionary
Dim Dict : Set Dict = SDB.Objects("MP3TunesLockerDict")
If Dict Is Nothing Then
Call SDB.MessageBox("Login failed: Dictionary not available",mtError,Array(mbOk))
Exit Sub
End If
'get progress
Dim Prog : Set Prog = SDB.Objects("MP3TunesLockerProg")
If Prog Is Nothing Then
Set Prog = SDB.Progress
Set SDB.Objects("MP3TunesLockerProg") = Prog
End If
Prog.Value = 0
Prog.MaxValue = 1
Prog.Text = "MP3TunesLocker: Initialising..."
SDB.ProcessMessages
'log in
Dim xml,sts,mes
Dim sid : sid = Dict.Item("session#")
If sid = "" Then
'show form
Dim usr : usr = Dict.Item("username")
Dim psw : psw = Dict.Item("password")
Dim mem : mem = Dict.Item("remeuser")&Dict.Item("remepass")
If (usr = "") Or (psw = "") Or Not (mem = "YY") Then
'*******************************************************************'
'* Form produced by MMVBS Form Creator (http://trixmoto.net/mmvbs) *'
'*******************************************************************'
Dim Form1 : Set Form1 = SDB.UI.NewForm
Form1.BorderStyle = 3
Form1.FormPosition = 4
Form1.Caption = "MP3TunesLocker"
Form1.Common.SetRect 0,0,750,150
Dim Activex1 : Set Activex1 = SDB.UI.NewActiveX(Form1,"Shell.Explorer")
Activex1.Common.SetRect 0,0,300,150
Activex1.Common.Align = 5
Activex1.Common.ControlName = "WB"
Call Activex1.SetHTMLDocument(GetLogin(usr))
Dim Panel1 : Set Panel1 = SDB.UI.NewTranspPanel(Form1)
Panel1.Common.SetRect 0,0,100,25
Panel1.Common.Align = 2
Dim Button1 : Set Button1 = SDB.UI.NewButton(Panel1)
Button1.Cancel = True
Button1.Caption = "Cancel"
Button1.ModalResult = 2
Button1.Common.Align = 3
Button1.Common.SetRect 0,0,75,25
Dim Button2 : Set Button2 = SDB.UI.NewButton(Panel1)
Button2.Caption = "Login"
Button2.Default = True
Button2.ModalResult = 1
Button2.Common.Align = 4
Button2.Common.SetRect 235,-2,75,25
Dim CheckBox2 : Set CheckBox2 = SDB.UI.NewCheckBox(Panel1)
CheckBox2.Caption = "Remember password"
CheckBox2.Common.ControlName = "RP"
CheckBox2.Common.SetRect 158,2,150,20
If Mid(mem,2,1) = "Y" Then
CheckBox2.Checked = True
End If
CheckBox2.Common.Align = 4
Dim CheckBox1 : Set CheckBox1 = SDB.UI.NewCheckBox(Panel1)
CheckBox1.Caption = "Remember email"
CheckBox1.Common.ControlName = "RE"
CheckBox1.Common.SetRect 80,2,120,20
If Mid(mem,1,1) = "Y" Then
CheckBox1.Checked = True
End If
CheckBox1.Common.Align = 4
'*******************************************************************'
'* End of form Richard Lewis (c) 2007 *'
'*******************************************************************'
'show form
If Not (Form1.ShowModal = 1) Then
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
'save settings
Dim Inif : Set Inif = SDB.IniFile
Dim doc : Set doc = Activex1.Interf.Document
usr = doc.getElementById("usr").value
psw = doc.getElementById("psw").value
If CheckBox1.Checked Then
mem = "Y"
Inif.StringValue("MP3TunesLocker","Username") = usr
Else
mem = "N"
Inif.StringValue("MP3TunesLocker","Username") = ""
End If
If CheckBox2.Checked Then
mem = mem&"Y"
Inif.StringValue("MP3TunesLocker","Password") = Encrypt(psw)
Else
mem = mem&"N"
Inif.StringValue("MP3TunesLocker","Password") = ""
End If
Inif.StringValue("MP3TunesLocker","Remember") = mem
Dict.Item("username") = usr
Dict.Item("password") = psw
Dict.Item("remeuser") = Mid(mem,1,1)
Dict.Item("remepass") = Mid(mem,2,1)
End If
'submit details
Prog.Text = "MP3TunesLocker: Logging in as '"&usr&"'..."
SDB.ProcessMessages
Set xml = SendQuery("login","partner_token="&pid&"&username="&usr&"&password="&psw)
If Prog.Terminate Then
SDB.IniFile.StringValue("MP3TunesLocker","Password") = ""
Dict.Item("password") = ""
Exit Sub
End If
If xml Is Nothing Then
Call SDB.MessageBox("Login failed: No response after 30 seconds",mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
'check for error
sts = GetText(xml.getElementsByTagName("status").Item(0))
If Not (sts = "1") Then
mes = GetText(xml.getElementsByTagName("errorMessage").Item(0))
If mes = "" Then
mes = "Login failed"
sts = "Unknown"
Else
sts = GetText(xml.getElementsByTagName("errorCode").Item(0))
End If
SDB.IniFile.StringValue("MP3TunesLocker","Password") = ""
Dict.Item("password") = ""
Call SDB.MessageBox(mes&" ("&sts&")",mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
'get session id
sid = GetText(xml.getElementsByTagName("session_id").Item(0))
If sid = "0" Then
Call SDB.MessageBox("Login failed: Invalid session id",mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
Else
sid = Left(sid,32)
End If
Dict.Item("session#") = sid
Prog.Text = "MP3TunesLocker: Login successful, checking last update..."
Else
Prog.Text = "MP3TunesLocker: Checking last update..."
End If
SDB.ProcessMessages
'check last update
Set xml = SendQuery("lastUpdate","type=locker&sid="&sid)
If Prog.Terminate Then
Dict.Item("session#") = ""
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
If xml Is Nothing Then
Call SDB.MessageBox("Access data failed: No response after 30 seconds",mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
mes = GetText(xml.getElementsByTagName("errorMessage").Item(0))
If Not (mes = "") Then
sts = GetText(xml.getElementsByTagName("errorCode").Item(0))
Call SDB.MessageBox(mes&": Code="&sts,mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
Dim upd : upd = GetText(xml.getElementsByTagName("timestamp").Item(0))
Dim Mmdb : Set Mmdb = SDB.Database
Dim iter : Set iter = Mmdb.OpenSQL("SELECT Last,CurSize,MaxSize,Id,Type FROM LockerUsr WHERE Email = '"&FixStr(usr)&"'")
Dim cur,max,per,typ,tid,itm
Dim dat : dat = True
If Not (iter.EOF) Then
cur = iter.ValueByIndex(1)
max = iter.ValueByIndex(2)
tid = iter.ValueByIndex(3)
typ = iter.ValueByIndex(4)
If Int(iter.ValueByIndex(0)) >= Int(upd) Then
dat = False
End If
End If
'access data
If dat Then
Prog.Text = "MP3TunesLocker: Accessing user data..."
SDB.ProcessMessages
Set xml = SendQuery("accountData","sid="&sid)
If Prog.Terminate Then
Dict.Item("session#") = ""
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
If xml Is Nothing Then
Call SDB.MessageBox("Access data failed: No response after 30 seconds",mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
mes = GetText(xml.getElementsByTagName("errorMessage").Item(0))
If Not (mes = "") Then
sts = GetText(xml.getElementsByTagName("errorCode").Item(0))
Call SDB.MessageBox(mes&": Code="&sts,mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
typ = GetText(xml.getElementsByTagName("lockerType").Item(0))
If Not (typ = "") Then
typ = UCase(Left(typ,1))&LCase(Mid(typ,2))
End If
cur = GetText(xml.getElementsByTagName("currentLockerSize").Item(0))
max = GetText(xml.getElementsByTagName("maxLockerSize").Item(0))
End If
'create or update user record
If iter.EOF Then
Set iter = Nothing
tid = Int(FixInt(Mmdb.OpenSQL("SELECT Max(Id) FROM LockerUsr").ValueByIndex(0)))+1
Mmdb.ExecSQL("INSERT INTO LockerUsr (Id,Email,CurSize,MaxSize,Type,Last) VALUES ("&FixInt(tid)&",'"&FixStr(usr)&"',"&FixInt(cur)&","&FixInt(max)&",'"&FixStr(typ)&"',"&FixInt(upd)&")")
Else
Set iter = Nothing
If dat Then
Mmdb.ExecSQL("UPDATE LockerUsr SET CurSize="&FixInt(cur)&",MaxSize="&FixInt(max)&",Type='"&FixStr(typ)&"',Last="&FixInt(upd)&" WHERE Id="&tid)
End If
End If
'get artist data
tid = FixInt(Mmdb.OpenSQL("SELECT Count(Id) FROM LockerArt").ValueByIndex(0))
If (dat) Or (tid = "0") Then
Prog.Text = "MP3TunesLocker: Accessing artist list..."
SDB.ProcessMessages
Set xml = SendQuery("lockerData","type=artist&sid="&sid)
If Prog.Terminate Then
Dict.Item("session#") = ""
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
If xml Is Nothing Then
Call SDB.MessageBox("Access data failed: No response after 30 seconds",mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
mes = GetText(xml.getElementsByTagName("errorMessage").Item(0))
If Not (mes = "") Then
sts = GetText(xml.getElementsByTagName("errorCode").Item(0))
Call SDB.MessageBox(mes&": Code="&sts,mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
'process artists
Mmdb.ExecSQL("DELETE FROM LockerArt")
Dim an,ai,ac,tc,si,at
Dim occ : occ = 0
Dim tot : tot = Int(GetText(xml.getElementsByTagName("totalResults").Item(0)))
If tot > 0 Then
Prog.Value = 0
Prog.MaxValue = tot
For Each itm In xml.getElementsByTagName("item")
occ = occ+1
Prog.Text = "MP3TunesLocker: Loading artist "&occ&" of "&tot&"..."
SDB.ProcessMessages
ai = GetText(itm.getElementsByTagName("artistId").Item(0))
an = GetText(itm.getElementsByTagName("artistName").Item(0))
ac = GetText(itm.getElementsByTagName("albumCount").Item(0))
tc = GetText(itm.getElementsByTagName("trackCount").Item(0))
si = GetText(itm.getElementsByTagName("artistSize").Item(0))
'create or update artist record
tid = FixInt(Mmdb.OpenSQL("SELECT Count(Id) FROM LockerArt WHERE Id="&ai).ValueByIndex(0))
If tid = "0" Then
Mmdb.ExecSQL("INSERT INTO LockerArt (Id,Name,Size,Albums,Tracks) VALUES ("&FixInt(ai)&",'"&FixStr(an)&"',"&FixInt(si)&","&FixInt(ac)&","&FixInt(tc)&")")
Else
Mmdb.ExecSQL("UPDATE LockerArt SET Name='"&FixStr(an)&"',Size="&FixInt(si)&",Albums="&FixInt(ac)&",Tracks="&FixInt(tc)&" WHERE Id="&ai)
End If
Prog.Increase
Next
End If
End If
'get album data
tid = FixInt(Mmdb.OpenSQL("SELECT Count(Id) FROM LockerAlb").ValueByIndex(0))
If (dat) Or (tid = "0") Then
Prog.Value = 0
Prog.MaxValue = 1
Prog.Text = "MP3TunesLocker: Accessing album list..."
SDB.ProcessMessages
Set xml = SendQuery("lockerData","type=album&sid="&sid)
If Prog.Terminate Then
Dict.Item("session#") = ""
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
If xml Is Nothing Then
Call SDB.MessageBox("Access data failed: No response after 30 seconds",mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
mes = GetText(xml.getElementsByTagName("errorMessage").Item(0))
If Not (mes = "") Then
sts = GetText(xml.getElementsByTagName("errorCode").Item(0))
Call SDB.MessageBox(mes&": Code="&sts,mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
'process albums
Mmdb.ExecSQL("DELETE FROM LockerAlb")
occ = 0
tot = Int(GetText(xml.getElementsByTagName("totalResults").Item(0)))
If tot > 0 Then
Prog.Value = 0
Prog.MaxValue = tot
For Each itm In xml.getElementsByTagName("item")
occ = occ+1
Prog.Text = "MP3TunesLocker: Loading album "&occ&" of "&tot&"..."
SDB.ProcessMessages
ai = GetText(itm.getElementsByTagName("albumId").Item(0))
at = GetText(itm.getElementsByTagName("albumTitle").Item(0))
ac = GetText(itm.getElementsByTagName("artistId").Item(0))
an = GetText(itm.getElementsByTagName("artistName").Item(0))
tc = GetText(itm.getElementsByTagName("trackCount").Item(0))
si = GetText(itm.getElementsByTagName("albumSize").Item(0))
'create or update album record
tid = FixInt(Mmdb.OpenSQL("SELECT Count(Id) FROM LockerAlb WHERE Id="&ai).ValueByIndex(0))
If tid = "0" Then
Mmdb.ExecSQL("INSERT INTO LockerAlb (Id,Title,ArtistId,Name,Size,Tracks) VALUES ("&FixInt(ai)&",'"&FixStr(at)&"',"&FixInt(ac)&",'"&FixStr(an)&"',"&FixInt(si)&","&FixInt(tc)&")")
Else
Mmdb.ExecSQL("UPDATE LockerAlb SET Title='"&FixStr(at)&"',ArtistId="&FixInt(ac)&",Name='"&FixStr(an)&"',Size="&FixInt(si)&",Tracks="&FixInt(tc)&" WHERE Id="&ai)
End If
Prog.Increase
Next
End If
End If
'show status
Prog.Value = 0
Prog.MaxValue = 1
If max = "-1" Then
Prog.Text = "MP3TunesLocker: Currently using "&FormatSize(cur)&" of unlimited"
Else
per = FormatNumb(100-((cur*100)/max))
Prog.Text = "MP3TunesLocker: Currently using "&FormatSize(cur)&" of "&FormatSize(max)&" ("&per&"% remaining)"
End If
SDB.ProcessMessages
'set timeout
Dict.Item("timeoutc") = "0"
Dim tmr : Set tmr = SDB.CreateTimer(500)
Call Script.RegisterEvent(tmr,"OnTimer","ProgressTimer")
'add artist node
Dim Tree : Set Tree = SDB.MainTree
Dim Subnode : Set Subnode = Tree.CreateNode
Subnode.Caption = "Artist"
Subnode.IconIndex = 0
Subnode.UseScript = Script.ScriptPath
Subnode.OnFillChildren = "FillArtist"
Call Tree.AddNode(Node,Subnode,3)
Subnode.HasChildren = True
Set SDB.Objects("MP3TunesLockerArtN") = Subnode
'add album node
Set Subnode = Tree.CreateNode
Subnode.Caption = "Album"
Subnode.IconIndex = 16
Subnode.UseScript = Script.ScriptPath
Subnode.OnFillChildren = "FillAlbum"
Call Tree.AddNode(Node,Subnode,3)
Subnode.HasChildren = True
Set SDB.Objects("MP3TunesLockerAlbN") = Subnode
Node.HasChildren = True
End Sub
Sub ProgressTimer(tmr)
'get dictionary
Dim Dict : Set Dict = SDB.Objects("MP3TunesLockerDict")
If Dict Is Nothing Then
Call Script.UnregisterEvents(tmr)
Exit Sub
End If
If Dict.Item("timeoutc") = "-1" Then
Call Script.UnregisterEvents(tmr)
Exit Sub
End If
'get progress
Dim Prog : Set Prog = SDB.Objects("MP3TunesLockerProg")
If Prog Is Nothing Then
Dict.Item("timeoutc") = "-1"
Call Script.UnregisterEvents(tmr)
Exit Sub
End If
'check timeout
Dim cur : cur = Int(Dict.Item("timeoutc"))+1
If (cur > 40) Or (Prog.Terminate) Then
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Dict.Item("timeoutc") = "-1"
Call Script.UnregisterEvents(tmr)
Exit Sub
End If
'update counter
Dict.Item("timeoutc") = cur
End Sub
Sub FillArtist(Node)
Node.HasChildren = False
'retrieve artists
Dim Mmdb : Set Mmdb = SDB.Database
Dim iter : Set iter = Mmdb.OpenSQL("SELECT Name,Id,Albums,Size FROM LockerArt ORDER BY Name")
If iter.EOF Then
Exit Sub
End If
'build tree
Dim Tree : Set Tree = SDB.MainTree
While Not (iter.EOF)
Dim Subnode : Set Subnode = Tree.CreateNode
Subnode.Caption = iter.StringByIndex(0)
Subnode.CustomNodeId = iter.StringByIndex(1)
Subnode.CustomDataId = iter.StringByIndex(2)
Subnode.CustomData = iter.StringByIndex(3)
Subnode.IconIndex = 0
Subnode.SortGroup = 1
Subnode.UseScript = Script.ScriptPath
Subnode.OnFillChildren = "FillArtistSub"
Call Tree.AddNode(Node,Subnode,3)
Subnode.HasChildren = True
iter.Next
WEnd
Node.HasChildren = True
End Sub
Sub FillAlbum(Node)
Node.HasChildren = False
'retrieve albums
Dim Mmdb : Set Mmdb = SDB.Database
Dim iter : Set iter = Mmdb.OpenSQL("SELECT Title,Name,Id,Tracks,Size FROM LockerAlb ORDER BY Title,Name")
If iter.EOF Then
Exit Sub
End If
'build tree
Dim Tree : Set Tree = SDB.MainTree
While Not (iter.EOF)
Dim Subnode : Set Subnode = Tree.CreateNode
Subnode.Caption = iter.StringByIndex(0)&" ("&iter.StringByIndex(1)&")"
Subnode.CustomNodeId = iter.StringByIndex(2)
Subnode.CustomDataId = iter.StringByIndex(3)
Subnode.CustomData = iter.StringByIndex(4)
Subnode.IconIndex = 16
Subnode.SortGroup = 2
Subnode.UseScript = Script.ScriptPath
Subnode.OnFillTracksFunct = "FillAlbumTracks"
Call Tree.AddNode(Node,Subnode,3)
Subnode.HasChildren = False
iter.Next
WEnd
Node.HasChildren = True
End Sub
Sub FillArtistSub(Node)
Node.HasChildren = False
'retrieve albums
Dim Mmdb : Set Mmdb = SDB.Database
Dim iter : Set iter = Mmdb.OpenSQL("SELECT Title,Id,Tracks,Size FROM LockerAlb WHERE ArtistId="&Node.CustomNodeId&" ORDER BY Title")
If iter.EOF Then
Exit Sub
End If
'build tree
Dim Tree : Set Tree = SDB.MainTree
While Not (iter.EOF)
Dim Subnode : Set Subnode = Tree.CreateNode
Subnode.Caption = iter.StringByIndex(0)
Subnode.CustomNodeId = iter.StringByIndex(1)
Subnode.CustomDataId = iter.StringByIndex(2)
Subnode.CustomData = iter.StringByIndex(3)
Subnode.IconIndex = 16
Subnode.SortGroup = 2
Subnode.UseScript = Script.ScriptPath
Subnode.OnFillTracksFunct = "FillAlbumTracks"
Call Tree.AddNode(Node,Subnode,3)
Subnode.HasChildren = False
iter.Next
WEnd
Node.HasChildren = True
End Sub
Sub FillAlbumTracks(Node)
'get dictionary
Dim Dict : Set Dict = SDB.Objects("MP3TunesLockerDict")
If Dict Is Nothing Then
Call SDB.MessageBox("Access data failed: Dictionary not available",mtError,Array(mbOk))
Exit Sub
End If
Dim sid : sid = Dict.Item("session#")
If sid = "" Then
Call SDB.MessageBox("Access data failed: Invalid session id",mtError,Array(mbOk))
Exit Sub
End If
'check library
Dim Mmdb : Set Mmdb = SDB.Database
Dim tid : tid = FixInt(Mmdb.OpenSQL("SELECT Count(Id) FROM LockerTrk WHERE AlbumId="&Node.CustomNodeId).ValueByIndex(0)&" AND Session='"&sid&"'")
If Not (tid = FixInt(Node.CustomDataId)) Then
'get progress
Dict.Item("timeoutc") = "-1"
Dim Prog : Set Prog = SDB.Objects("MP3TunesLockerProg")
If Prog Is Nothing Then
Set Prog = SDB.Progress
Set SDB.Objects("MP3TunesLockerProg") = Prog
End If
Prog.Value = 0
Prog.MaxValue = 1
Prog.Text = "MP3TunesLocker: Accessing track list..."
SDB.ProcessMessages
'get track list
Dim xml,mes,sts,itm
Set xml = SendQuery("lockerData","type=track&sid="&sid&"&album_id="&Node.CustomNodeId)
If Prog.Terminate Then
Dict.Item("session#") = ""
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
If xml Is Nothing Then
Call SDB.MessageBox("Access data failed: No response after 30 seconds",mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
mes = GetText(xml.getElementsByTagName("errorMessage").Item(0))
If Not (mes = "") Then
sts = GetText(xml.getElementsByTagName("errorCode").Item(0))
Call SDB.MessageBox(mes&": Code="&sts,mtError,Array(mbOk))
Set SDB.Objects("MP3TunesLockerProg") = Nothing
Exit Sub
End If
'process tracks
Dim id,ai,ri,du,pu,au,fk,sng,dit,sit,ids,sql
Dim occ : occ = 0
Dim tot : tot = Int(GetText(xml.getElementsByTagName("totalResults").Item(0)))
If tot > 0 Then
Prog.Value = 0
Prog.MaxValue = tot
For Each itm In xml.getElementsByTagName("item")
occ = occ+1
Prog.Text = "MP3TunesLocker: Loading track "&occ&" of "&tot&"..."
SDB.ProcessMessages
id = GetText(itm.getElementsByTagName("trackId").Item(0))
ai = GetText(itm.getElementsByTagName("albumId").Item(0))
ri = GetText(itm.getElementsByTagName("artistId").Item(0))
du = GetText(itm.getElementsByTagName("downloadURL").Item(0))&pid
pu = GetText(itm.getElementsByTagName("playURL").Item(0))&pid
au = GetText(itm.getElementsByTagName("albumArtURL").Item(0))
fk = GetText(itm.getElementsByTagName("trackFileKey").Item(0))
If ids = "" Then
ids = id
Else
ids = ids&","&id
End If
'create or update song data
Dim upd : upd = False
Set dit = Mmdb.OpenSQL("SELECT SongsId FROM LockerTrk WHERE Id="&FixInt(id))
If dit.EOF Then
Set sng = SDB.NewSongData
Else
upd = True
Set sit = Mmdb.QuerySongs("AND (Songs.Id="&dit.ValueByIndex(0)&")")
If sit.EOF Then
Set sng = SDB.NewSongData
Else
Set sng = sit.Item
End If
Set sit = Nothing
End If
Set dit = Nothing
sng.Title = GetText(itm.getElementsByTagName("trackTitle").Item(0))
sng.TrackOrderStr = GetText(itm.getElementsByTagName("trackNumber").Item(0))
sng.FileLength = FixInt(GetText(itm.getElementsByTagName("trackFileSize").Item(0)))
sng.SongLength = FixInt(GetText(itm.getElementsByTagName("trackLength").Item(0)))
sng.AlbumName = GetText(xml.getElementsByTagName("albumTitle").Item(0))
sng.ArtistName = GetText(itm.getElementsByTagName("artistName").Item(0))
sng.Year = FixInt(GetText(itm.getElementsByTagName("albumYear").Item(0)))
sng.Path = ""
sng.Path = pu
sng.UpdateDB
sng.UpdateArtist
sng.UpdateAlbum
'update or create track record
If upd Then
sql = "UPDATE LockerTrk SET SongsId="&FixInt(sng.ID)&",AlbumId="&FixInt(ai)&",ArtistId="&FixInt(ri)&",Session='"&FixStr(sid)&"',DUrl='"&FixStr(du)&"',PUrl='"&FixStr(pu)&"',AUrl='"&FixStr(au)&"',FKey='"&FixStr(fk)&"' WHERE Id="&id
Else
sql = "INSERT INTO LockerTrk (Id,SongsId,AlbumId,ArtistId,Session,DUrl,PUrl,AUrl,FKey) VALUES ("&FixInt(id)&","&FixInt(sng.ID)&","&FixInt(ai)&","&FixInt(ri)&",'"&FixStr(sid)&"','"&FixStr(du)&"','"&FixStr(pu)&"','"&FixStr(au)&"','"&FixStr(fk)&"')"
End If
Mmdb.ExecSQL(sql)
Prog.Increase
Next
End If
'delete previous
sql = "DELETE FROM LockerTrk WHERE AlbumId="&Node.CustomNodeId
If Not (ids = "") Then
sql = sql&" AND Id NOT IN ("&ids&")"
End If
Mmdb.ExecSQL(sql)
Set SDB.Objects("MP3TunesLockerProg") = Nothing
End If
'list tracks
Dim Tracks : Set Tracks = SDB.MainTracksWindow
Tracks.AddTracksFromCustomQuery("SELECT Songs.* FROM Songs,LockerTrk WHERE LockerTrk.SongsId=Songs.Id AND LockerTrk.AlbumId="&Node.CustomNodeId)
Tracks.FinishAdding
End Sub
Function FormatSize(h)
Dim i : i = h
Dim s : s = "b"
If i >= 1024 Then
i = i / 1024
s = "Kb"
End If
If i >= 1024 Then
i = i / 1024
s = "Mb"
End If
If i >= 1024 Then
i = i / 1024
s = "Gb"
End If
If i >= 1024 Then
i = i / 1024
s = "Tb"
End If
FormatSize = FormatNumb(i)&s
End Function
Function FormatNumb(i)
If i < 10 Then
FormatNumb = FormatNumber(i,2)
Else
If i < 100 Then
FormatNumb = FormatNumber(i,1)
Else
FormatNumb = FormatNumber(i,0)
End If
End If
End Function
Function GetText(ele)
If ele Is Nothing Then
GetText = ""
Else
GetText = Replace(ele.Text,"&","&")
End If
End Function
Function SendQuery(ope,par)
Dim Prog : Set Prog = SDB.Objects("MP3TunesLockerProg")
Dim xml : Set xml = CreateObject("Microsoft.XMLDOM")
xml.async = True
Dim url : url = ""
If ope = "login" Then
url = "https://shop.mp3tunes.com/api/v1/"&ope&"?output=xml&"&par
Else
url = "http://ws.mp3tunes.com/api/v1/"&ope&"?output=xml&"&par
End If
Call out(url)
Call xml.Load(url)
Dim cnt : cnt = 0
While (xml.readyState < 4) And (cnt < 300)
Call SDB.Tools.Sleep(100)
SDB.ProcessMessages
cnt = cnt+1
If Prog.Terminate Then
cnt = 300
End If
WEnd
If xml.readyState < 4 Then
Set SendQuery = Nothing
Else
Set SendQuery = xml
End If
End Function
Function Encrypt(str)
Dim tmp : tmp = ""
Dim i : i = 0
For i = 1 To Len(str)
tmp = tmp&Chr(Asc(Mid(str,i,1))+1)
Next
Encrypt = StrReverse(tmp)
End Function
Function Decrypt(str)
Dim enc : enc = StrReverse(str)
Dim tmp : tmp = ""
Dim i : i = 0
For i = 1 To Len(enc)
tmp = tmp&Chr(Asc(Mid(enc,i,1))-1)
Next
Decrypt = tmp
End Function
Function FixInt(num)
If IsNull(num) Then
FixInt = "0"
Else
If num = "" Then
FixInt = "0"
Else
FixInt = CStr(num)
End If
End If
End Function
Function FixStr(str)
If IsNull(str) Then
FixStr = ""
Else
FixStr = Replace(str,"'","''")
End If
End Function
Function GetLogin(usr)
GetLogin = "<style type=""text/css"">html {overflow:auto;}</style>"
GetLogin = GetLogin&"<link href=""http://www.mp3tunes.com/styles/locker.css"" rel=""styleSheet"" type=""text/css"" />"
GetLogin = GetLogin&"<link href=""http://www.mp3tunes.com/styles/bubble.css"" rel=""styleSheet"" type=""text/css"" />"
GetLogin = GetLogin&"<link href=""http://www.mp3tunes.com/styles/color.css"" rel=""styleSheet"" type=""text/css"" />"
GetLogin = GetLogin&"<body style=""background:white""><div id=""header"" style=""background-color:white""><br />"
GetLogin = GetLogin&"<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""680px""><tr height=""73px"">"
GetLogin = GetLogin&"<td valign=""top"" width=""120px""><img src=""http://s.mp3tunes.com/images/locker/mp3tunes_logo.gif"" width=""113"" height=""64"" alt=""MP3tunes"" /></td>"
GetLogin = GetLogin&"<td valign=""top"" width=""180px""><img src=""http://s.mp3tunes.com/images/locker/mp3tunes_tagline.gif"" width=""166"" height=""36"" alt="""" /></td>"
GetLogin = GetLogin&"<td valign=""top"" align=""right""><div id=""loginform""><table border=""0"" cellpadding=""0"" cellspacing=""3"" align=""center"">"
GetLogin = GetLogin&"<tr><td style=""color:434B58; font-size:12px; font-weight:bold;"">LOGIN </td>"
GetLogin = GetLogin&"<th>Email</th><td><input type=""text"" id=""usr"" name=""frmEmail"" value="""&usr&""" tabindex=""1"" /></td></tr>"
GetLogin = GetLogin&"<tr><td></td><th>Password</th><td><input type=""password"" id=""psw"" name=""frmPassword"" value="""" tabindex=""2"" /></td>"
GetLogin = GetLogin&"</tr></table></div></td></tr></table></div></body>"
End Function
Sub SendToClick(but)
'get track list
Dim list : Set list = SDB.SelectedSongList
If list.Count = 0 Then
Exit Sub
End If
'get dictionary
Dim Dict : Set Dict = SDB.Objects("MP3TunesLockerDict")
If Dict Is Nothing Then
Call SDB.MessageBox("Upload track failed: Dictionary not available",mtError,Array(mbOk))
Exit Sub
End If
Dim sid : sid = Dict.Item("session#")
If sid = "" Then
Call SDB.MessageBox("Upload track failed: Invalid session id",mtError,Array(mbOk))
Exit Sub
End If
'get progress bar
Dim Prog : Set Prog = SDB.Objects("MP3TunesLockerProg2")
If Prog Is Nothing Then
Set Prog = SDB.Progress
Set SDB.Objects("MP3TunesLockerProg2") = Prog
Else
Dict.Item("timeoutc") = "-1"
End If
Prog.Value = 0
Prog.MaxValue = list.Count
Prog.Text = "MP3TunesLocker: Initialising..."
SDB.ProcessMessages
'upload tracks
Dim Mmdb : Set Mmdb = SDB.Database
Dim i : i = 0
Dim j : j = 0
Dim r : r = 0
For i = 0 To list.Count-1
Dim itm : Set itm = list.Item(i)
If list.Count = 1 Then
Prog.Text = "MP3TunesLocker: Uploading track '"&itm.Title&"'..."
Else
Prog.Text = "MP3TunesLocker: Uploading track "&(i+1)&" of "&list.Count&" '"&itm.Title&"'..."
End If
SDB.ProcessMessages
'upload track
If UploadTrack(itm,"sid="&sid&"&partner_token="&pid) Then
j = j + 1
End If
If Prog.Terminate Then
Set SDB.Objects("MP3TunesLockerProg2") = Nothing
Exit Sub
End If
Prog.Increase
Next
Set SDB.Objects("MP3TunesLockerProg2") = Nothing
End Sub
Function UploadTrack(sng,par)
UploadTrack = False
Dim Prog : Set Prog = SDB.Objects("MP3TunesLockerProg2")
If Prog Is Nothing Then
Exit Function
End If
'read file data
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(sng.Path) Then
Call SDB.MessageBox("Upload track failed: File cannot be found",mtError,Array(mbOk))
Exit Function
End If
Dim ado : Set ado = CreateObject("ADODB.Stream")
If ado Is Nothing Then
Call SDB.MessageBox("Upload track failed: Stream component cannot be found",mtError,Array(mbOk))
Exit Function
End If
ado.Type = 1
ado.Open
Call ado.LoadFromFile(sng.Path)
Dim dat : dat = ado.Read
Dim nam : nam = FixUtf8(GetPart(4,sng.Path))
'get file hash
Dim key : key = GetMD5(sng.Path)
If key = "" Then
Call SDB.MessageBox("Upload track failed: MD5 component cannot be installed",mtError,Array(mbOk))
Exit Function
End If
Dim url : url = "http://content.mp3tunes.com/storage/lockerPut/"&key&"?"&par
'post query
Dim xml : Set xml = CreateObject("Microsoft.XMLHTTP")
If xml Is Nothing Then
Call SDB.MessageBox("Upload track failed: HTTP component cannot be found",mtError,Array(mbOk))
Exit Function
End If
Call out(url)
Call xml.open("PUT",url,true)
Call xml.setRequestHeader("X-Original-Filename",nam)
Call xml.setRequestHeader("X-MP3tunes-Artist-Name",sng.ArtistName)
Call xml.setRequestHeader("X-MP3tunes-Album-Title",sng.AlbumName)
Call xml.setRequestHeader("X-MP3tunes-Track-Title",sng.Title)
Call xml.setRequestHeader("X-MP3tunes-Track-Number",sng.TrackOrderStr)
Call xml.setRequestHeader("X-MP3tunes-Year",sng.Year)
Call xml.send(dat)
Dim cnt : cnt = 0
While (xml.readyState < 4) And (cnt < 3000)
Call SDB.Tools.Sleep(100)
SDB.ProcessMessages
cnt = cnt+1
If Prog.Terminate Then
Exit Function
End If
WEnd
If xml.readyState < 4 Then
Call SDB.MessageBox("Upload track failed: No response after 5 minutes",mtError,Array(mbOk))
Exit Function
End If
'check response
If xml.status = 200 Then
UploadTrack = True
Else
Dim cod : cod = xml.getResponseHeader("X-MP3tunes-ErrorNo")
Dim str : str = xml.getResponseHeader("X-MP3tunes-ErrorString")
If InStr(str,"] ") > 0 Then
str = Mid(str,InStr(str,"] ")+2)
End If
Dim ret : ret = xml.getResponseHeader("Retry-After")
If Not (ret = "") Then
ret = " - please wait "&ret&" seconds before retrying"
End If
Call SDB.MessageBox("Upload track failed: "&str&" ("&cod&")"&ret,mtError,Array(mbOk))
End If
End Function
Function GetMD5(loc)
GetMD5 = ""
On Error Resume Next
Dim md5 : Set md5 = CreateObject("XStandard.MD5")
If Not (Err.Number = 0) Then
Call InstallMD5
Err.Clear
Set md5 = CreateObject("XStandard.MD5")
If Not (Err.Number = 0) Then
Exit Function
End If
End If
On Error GoTo 0
GetMD5 = md5.GetCheckSumFromFile(loc)
End Function
Sub InstallMD5()
'check component exists
Dim dll : dll = SDB.ApplicationPath&"Scripts\XMD5.dll"
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(dll) Then
Exit Sub
End If
'copy component
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim cmd : cmd = "command /c copy "&Chr(34)&dll&Chr(34)&" %windir% /y"
Dim res : res = wsh.Run(cmd,0,1)
'register component
Dim win : win = wsh.ExpandEnvironmentStrings("%windir%")
If fso.FileExists(win&"\XMD5.dll") Then
cmd = "regsvr32 %windir%\XMD5.dll /s"
Else
cmd = "regsvr32 "&Chr(34)&dll&Chr(34)&" /s"
End If
res = wsh.Run(cmd,1,1)
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
If mode = 4 Then 'Filename and Extension
If p3 > p2 Then
GetPart = Mid(path,p2+1)
End If
Exit Function
End if
End Function
Function FixUtf8(sRawURL)
Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
If Len(sRawURL) > 0 Then
Dim i : i = 1
Dim url : url = sRawURL
Do While i < Len(url)+1
Dim s : s = Mid(url,i,1)
If InStr(1,sValidChars,s,0) = 0 Then
Dim d : d = AscW(s)
If d > 65536 Then
s = "%5F"
Else
If d < 128 Then
s = DecToHex(d)
ElseIf d < 2048 Then
s = DecToUtf(d)
Else
s = DecToUtf2(d)
End If
End If
End If
FixUtf8 = FixUtf8&s
i = i + 1
Loop
End If
End Function
Function HexToDec(h)
HexToDec = 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
HexToDec = HexToDec+(d*(16^(Len(h)-i)))
Else
HexToDec = 0
Exit For
End If
Next
End Function
Function DecToBin(intDec)
DecToBin = ""
Dim d : d = intDec
Dim e : e = 1024
While e >= 1
If d >= e Then
d = d - e
DecToBin = DecToBin&"1"
Else
DecToBin = DecToBin&"0"
End If
e = e / 2
Wend
End Function
Function DecToBin2(intDec)
DecToBin2 = ""
Dim d : d = intDec
Dim e : e = 65536
While e >= 1
If d >= e Then
d = d - e
DecToBin2 = DecToBin2&"1"
Else
DecToBin2 = DecToBin2&"0"
End If
e = e / 2
Wend
End Function
Function BinToHex(strBin)
Dim d : d = 0
Dim i : i = 0
For i = Len(strBin) To 1 Step -1
Select Case Mid(strBin,i,1)
Case "0"
'do nothing
Case "1"
d = d + (2^(Len(strBin)-i))
Case Else
BinToHex = "00"
Exit Function
End Select
Next
BinToHex = DecToHex(d)
End Function
Function DecToHex(d)
If d < 16 Then
DecToHex = "%0"&CStr(Hex(d))
Else
DecToHex = "%"&CStr(Hex(d))
End If
End Function
Function DecToUtf(d)
Dim b : b = DecToBin(d)
Dim a : a = "110"&Left(b,5)
b = "10"&Mid(b,6)
DecToUtf = BinToHex(a)&BinToHex(b)
End Function
Function DecToUtf2(d)
Dim b : b = DecToBin2(d)
Dim a : a = "1110"&Left(b,4)
Dim c : c = "10"&Mid(b,11,6)
b = "10"&Mid(b,5,6)
DecToUtf2 = BinToHex(a)&BinToHex(b)&BinToHex(c)
End Function
Function CancelDelete(sng,dsk)
CancelDelete = False
Dim Mmdb : Set Mmdb = SDB.Database
'check file cache
Dim key : key = ""
If Right(sng.Path,Len(pid)+1) = "="&pid Then
Dim iter : Set iter = Mmdb.OpenSQL("SELECT FKey FROM LockerTrk WHERE SongsId = "&FixInt(sng.ID))
If Not iter.EOF Then
key = iter.StringByIndex(0)
End If
Set iter = Nothing
End If
If key = "" Then
Exit Function
End If
CancelDelete = True
'get dictionary
Dim Dict : Set Dict = SDB.Objects("MP3TunesLockerDict")
If Dict Is Nothing Then
Call SDB.MessageBox("Delete track failed: Dictionary not available",mtError,Array(mbOk))
Exit Function
End If
Dim sid : sid = Dict.Item("session#")
If sid = "" Then
Call SDB.MessageBox("Delete track failed: Invalid session id",mtError,Array(mbOk))
Exit Function
End If
Dim url : url = "http://content.mp3tunes.com/storage/lockerDelete/"&key&"?sid="&sid
'get progress
Dim Prog : Set Prog = SDB.Progress
Prog.Value = 0
Prog.MaxValue = 1
Prog.Text = "MP3TunesLocker: Deleting track '"&sng.Title&"'..."
SDB.ProcessMessages
'post query
Dim xml : Set xml = CreateObject("Microsoft.XMLHTTP")
If xml Is Nothing Then
Call SDB.MessageBox("Delete track failed: HTTP component cannot be found",mtError,Array(mbOk))
Exit Function
End If
Call out(url)
Call xml.open("GET",url,true)
Call xml.send()
Dim cnt : cnt = 0
While (xml.readyState < 4) And (cnt < 300)
Call SDB.Tools.Sleep(100)
SDB.ProcessMessages
cnt = cnt+1
If Prog.Terminate Then
Exit Function
End If
WEnd
If xml.readyState < 4 Then
Call SDB.MessageBox("Delete track failed: No response after 30 seconds",mtError,Array(mbOk))
Exit Function
End If
'check response
If xml.status = 200 Then
Mmdb.ExecSQL("DELETE FROM LockerTrk WHERE SongsId = "&FixInt(sng.ID))
CancelDelete = False
Else
Dim cod : cod = xml.getResponseHeader("X-MP3tunes-ErrorNo")
If Not (cod = "") Then
cod = " ("&cod&")"
End If
Dim str : str = xml.getResponseHeader("X-MP3tunes-ErrorString")
If str = "" Then
str = "Unknown"
Else
If InStr(str,"] ") > 0 Then
str = Mid(str,InStr(str,"] ")+2)
End If
End If
Dim ret : ret = xml.getResponseHeader("Retry-After")
If Not (ret = "") Then
ret = " - please wait "&ret&" seconds before retrying"
End If
Call SDB.MessageBox("Delete track failed: "&str&cod&ret,mtError,Array(mbOk))
End If
End Function
Sub out(str)
Exit Sub
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\MP3TunesLocker.log"
Dim txt : txt = SDB.ToAscii(str)
Dim logf : Set logf = fso.OpenTextFile(loc,8,True)
If Left(txt,4) = "http" Then
Dim tmp : tmp = Replace(Mid(txt,InStr(txt,"?")+1),"="," = ")
Dim arr : arr = Split(tmp,"&")
txt = txt&vbcrlf&" "&Join(arr,vbcrlf&" ")
End If
Call logf.WriteLine(Time&" "&txt)
Call logf.Close
End Sub
