Playlist FTP 1.1 - Updated 08/02/2011
Posted: Mon Jan 31, 2011 1:19 pm
This script was requested here. When you run the script you will be asked to select a playlist and then enter details of your FTP server. All the tracks in the playlist will then be uploaded one at a time, with a progress bar. The progress bar does not update during the track upload, only between each track, so please be patient.
As always, the installer can be downloaded from my website. And the code is here...
As always, the installer can be downloaded from my website. And the code is here...
Code: Select all
'
' MediaMonkey Script
'
' NAME: PlaylistFTP 1.1
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 08/02/2011
'
' Thanks to Steegy for the SkinnedInputBox
' Thanks to Nathan Rice for FTPUpload
'
' FIXES: Fixed temporary files not deleted on error
'
Option Explicit
Sub OnInstall()
Dim inip : inip = SDB.ApplicationPath&"Scripts\Scripts.ini"
Dim inif : Set inif = SDB.Tools.IniFileByPath(inip)
If Not (inif Is Nothing) Then
inif.StringValue("PlaylistFTP","Filename") = "Auto\PlaylistFTP.vbs"
inif.StringValue("PlaylistFTP","Procname") = "PlaylistFTP"
inif.StringValue("PlaylistFTP","Order") = "10"
inif.StringValue("PlaylistFTP","DisplayName") = "Playlist FTP"
inif.StringValue("PlaylistFTP","Description") = "Uploads playlists via FTP"
inif.StringValue("PlaylistFTP","Language") = "VBScript"
inif.StringValue("PlaylistFTP","ScriptType") = "0"
SDB.RefreshScriptItems
End If
Call OnStartup()
End Sub
Sub OnStartup()
Dim btn : Set btn = SDB.Objects("PlaylistFTPButton")
If btn Is Nothing Then
Set btn = SDB.UI.AddMenuItem(SDB.UI.Menu_TbStandard,0,0)
btn.Caption = "PlaylistFTP"
btn.Hint = "Uploads playlists via FTP"
btn.IconIndex = 56
btn.Visible = True
Set SDB.Objects("PlaylistFTPButton") = btn
End If
Call Script.UnRegisterHandler("OnToolbar")
Call Script.RegisterEvent(btn,"OnClick","OnToolbar")
Call SDB.UI.AddOptionSheet("PlaylistFTP Settings",Script.ScriptPath,"InitSheet","SaveSheet",-2)
End Sub
Sub OnToolbar(btn)
Call PlaylistFTP()
End Sub
Sub PlaylistFTP()
Dim dic : Set dic = CreateObject("Scripting.Dictionary")
Call GetPlaylists(dic,"",0)
If dic.Count > 0 Then
Dim arr : arr = dic.Items
Dim i : i = SkinnedInputBox("Playlist","PlaylistFTP",arr,"PlaylistFTP")
If i > -1 Then
arr = dic.Keys
Dim pid : pid = Int(Mid(arr(i),2))
Dim ply : Set ply = PlaylistByID(pid,"")
If Not (ply Is Nothing) Then
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim list : Set list = ply.Tracks
Dim prog : Set prog = SDB.Progress
prog.MaxValue = list.Count
For i = 0 To list.Count-1
Dim itm : Set itm = list.Item(i)
Dim loc : loc = itm.Path
prog.Text = "PlaylistFTP: Uploading '"&ply.Title&"' track "&(i+1)&" of "&list.Count&" ("&loc&")..."
prog.Value = i
SDB.ProcessMessages
If InStr(loc,";") > 0 Then
loc = SDB.TemporaryFolder&Mid(Replace(loc,";","_"),InStrRev(loc,"\")+1)
Call fso.CopyFile(itm.Path,loc,True)
End If
Call SendTrack(loc)
If Not (loc = itm.Path) Then
Call fso.DeleteFile(loc,True)
End If
Next
prog.Text = "PlaylistFTP: Uploading '"&ply.Title&"' complete."
prog.Value = prog.MaxValue
SDB.ProcessMessages
End If
End If
End If
End Sub
Sub GetPlaylists(dic,nam,lev)
Dim ply : Set ply = SDB.PlaylistByTitle(nam)
If Not (ply Is Nothing) Then
lev = lev+1
Dim l : l = lev
Dim i : i = 0
Dim kids : Set kids = ply.ChildPlaylists
For i = 0 To kids.Count-1
Set ply = kids.Item(i)
nam = ply.Title
dic.Item("#"&ply.ID) = lev&"~"&nam
Call GetPlaylists(dic,nam,lev)
lev = l
Next
End If
End Sub
Function PlaylistByID(pid,nam)
Set PlaylistByID = Nothing
Dim ply : Set ply = SDB.PlaylistByTitle(nam)
If Not (ply Is Nothing) Then
Dim i : i = 0
Dim kids : Set kids = ply.ChildPlaylists
For i = 0 To kids.Count-1
Set ply = kids.Item(i)
If ply.ID = pid Then
Set PlaylistByID = ply
Else
nam = ply.Title
Set PlaylistByID = PlaylistByID(pid,nam)
End If
If Not (PlaylistByID Is Nothing) Then
Exit For
End If
Next
End If
End Function
Function GetIndent(str)
Dim i : i = InStr(str,"~")
Dim l : l = Int(Left(str,i-1))-1
GetIndent = Mid(str,i+1)
For i = 1 To l
GetIndent = ".."&GetIndent
Next
End Function
Sub SendTrack(loc)
'get settings
Dim site : site = ""
Dim user : user = ""
Dim pass : pass = ""
Dim path : path = ""
Call GetSettings(site,user,pass,path)
If (site = "") Or (user = "") Or (pass = "") Or (path = "") Then
Call SDB.MessageBox("PlaylistFTP: Some settings missing.",mtError,Array(mbOk))
Exit Sub
End If
'upload file
Dim fil : fil = loc
Dim res : res = FTPUpload(site,user,pass,fil,path)
If Not (res = "") Then
Call SDB.MessageBox("PlaylistFTP: "&res,mtError,Array(mbOk))
End If
End Sub
Function GetSettings(site,user,pass,path)
Dim ini : Set ini = SDB.IniFile
site = ini.StringValue("PlaylistFTP","Site")
If site = "" Then
site = SkinnedInputBox("FTP site","PlaylistFTP","","PlaylistFTP")
ini.StringValue("PlaylistFTP","Site") = site
End If
user = ini.StringValue("PlaylistFTP","User")
If user = "" Then
user = SkinnedInputBox("Username","PlaylistFTP","","PlaylistFTP")
ini.StringValue("PlaylistFTP","User") = user
End If
pass = ini.StringValue("PlaylistFTP","Pass")
If pass = "" Then
pass = SkinnedInputBox("Password","PlaylistFTP","","PlaylistFTP")
ini.StringValue("PlaylistFTP","Pass") = Encrypt(pass)
Else
pass = Decrypt(pass)
End If
path = ini.StringValue("PlaylistFTP","Path")
If path = "" Then
path = SkinnedInputBox("Remote path","PlaylistFTP","","PlaylistFTP")
ini.StringValue("PlaylistFTP","Path") = path
End If
End Function
Function FTPUpload(sSite,sUsername,sPassword,sLocalFile,sRemotePath)
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
sRemotePath = Trim(sRemotePath)
If InStr(sRemotePath," ") > 0 Then
If Left(sRemotePath,1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = """" & sRemotePath & """"
End If
End If
If Len(sRemotePath) = 0 Then
sRemotePath = "/"
End If
sLocalFile = Trim(sLocalFile)
If InStr(sLocalFile, "*") Then
If InStr(sLocalFile, " ") Then
FTPUpload = "Wildcard uploads do not work if the path contains a space."
Exit Function
End If
ElseIf Len(sLocalFile) = 0 Or Not fso.FileExists(sLocalFile) Then
FTPUpload = "Local file '"&sLocalFile&"' not found."
Exit Function
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
sLocalFile = """" & sLocalFile & """"
End If
End If
Dim sFTPScript : sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
sFTPScript = sFTPScript & sPassword & vbCRLF
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
sFTPScript = sFTPScript & "binary" & vbCRLF
sFTPScript = sFTPScript & "prompt n" & vbCRLF
sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
Dim sFTPTempFile : sFTPTempFile = SDB.TemporaryFolder
Dim sFTPResults : sFTPResults = sFTPTempFile&"\pftp.dat"
sFTPTempFile = sFTPTempFile&"\pftp.tmp"
On Error Resume Next
If fso.FileExists(sFTPResults) Then
Call fso.DeleteFile(sFTPResults)
End If
If Err.Number <> 0 Then
Err.Clear
End If
On Error Goto 0
Dim fFTPScript : Set fFTPScript = fso.CreateTextFile(sFTPTempFile, True)
fFTPScript.WriteLine(sFTPScript)
fFTPScript.Close
Dim dic : Set dic = CreateObject("Scripting.Dictionary")
dic.Item("run") = "%comspec% /c FTP -n -s:"&sFTPTempFile&" "&sSite&" > "&sFTPResults
Set SDB.Objects("PlaylistFTPDic") = dic
Set SDB.Objects("PlaylistFTPFil") = Nothing
Dim tmr : Set tmr = SDB.CreateTimer(10)
Call Script.RegisterEvent(tmr,"OnTimer","DoUpload")
Set dic = SDB.Objects("PlaylistFTPFil")
Do While (dic Is Nothing)
SDB.Tools.Sleep(50)
SDB.ProcessMessages
Set dic = SDB.Objects("PlaylistFTPFil")
Loop
Set SDB.Objects("PlaylistFTPDic") = Nothing
Set SDB.Objects("PlaylistFTPFil") = Nothing
Dim fil : Set fil = fso.OpenTextFile(sFTPResults,1,True,-2)
Dim str : str = ""
Dim del : del = False
FTPUpload = "Error occurred during file upload."
Do While Not fil.AtEndOfStream
str = Left(fil.ReadLine,3)
If str = "226" Then
FTPUpload = ""
del = True
Exit Do
ElseIf str = "530" Then
FTPUpload = "Login authentication failed."
del = True
Exit Do
End If
Loop
fil.Close
Set fil = Nothing
If del Then
On Error Resume Next
If fso.FileExists(sFTPResults) Then
Call fso.DeleteFile(sFTPResults)
End If
If fso.FileExists(sFTPTempFile) Then
Call fso.DeleteFile(sFTPTempFile)
End If
If Err.Number <> 0 Then
Err.Clear
End If
On Error Goto 0
End If
End Function
Sub DoUpload(tmr)
Call Script.UnregisterEvents(tmr)
Dim dic : Set dic = SDB.Objects("PlaylistFTPDic")
If Not (dic Is Nothing) Then
Dim run : run = dic.Item("run")
If Not (run = "") Then
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Call wsh.Run(run,0,True)
Set SDB.Objects("PlaylistFTPFil") = dic
End if
End If
End Sub
Function SkinnedInputBox(Text, Caption, Input, PositionName)
Dim Form, Label, Edt, btnOk, btnCancel, modalResult, i
' Create the window to be shown
Set Form = SDB.UI.NewForm
Form.Common.SetRect 100, 100, 360, 130
Form.BorderStyle = 2 ' Resizable
Form.FormPosition = 4 ' Screen Center
Form.SavePositionName = PositionName
Form.Caption = Caption
' Create a button that closes the window
Set Label = SDB.UI.NewLabel(Form)
Label.Caption = Text
Label.Common.Left = 5
Label.Common.Top = 10
If IsArray(Input) Then
Set Edt = SDB.UI.NewDropDown(Form)
Edt.Common.Left = Label.Common.Left
Edt.Common.Top = Label.Common.Top + Label.Common.Height + 5
Edt.Common.Width = Form.Common.Width - 20
Edt.Common.ControlName = "Edit1"
Edt.Common.Anchors = 1+2+4 'Left+Top+Right
Edt.Style = 2
For i = 0 To UBound(Input)
Call Edt.AddItem(GetIndent(Input(i)))
Next
Else
Set Edt = SDB.UI.NewEdit(Form)
Edt.Common.Left = Label.Common.Left
Edt.Common.Top = Label.Common.Top + Label.Common.Height + 5
Edt.Common.Width = Form.Common.Width - 20
Edt.Common.ControlName = "Edit1"
Edt.Common.Anchors = 1+2+4 'Left+Top+Right
Edt.Text = Input
End If
' Create a button that closes the window
Set BtnOk = SDB.UI.NewButton(Form)
BtnOk.Caption = "&OK"
BtnOk.Common.Top = Edt.Common.Top + Edt.Common.Height + 10
BtnOk.Common.Hint = "OK"
BtnOk.Common.Anchors = 4 ' Right
BtnOk.UseScript = Script.ScriptPath
BtnOk.Default = True
BtnOk.ModalResult = 1
Set BtnCancel = SDB.UI.NewButton(Form)
BtnCancel.Caption = "&Cancel"
BtnCancel.Common.Left = Form.Common.Width - BtnCancel.Common.Width - 15
BtnOK.Common.Left = BtnCancel.Common.Left - BtnOK.Common.Width - 10
BtnCancel.Common.Top = BtnOK.Common.Top
BtnCancel.Common.Hint = "Cancel"
BtnCancel.Common.Anchors = 4 ' Right
BtnCancel.UseScript = Script.ScriptPath
BtnCancel.Cancel = True
BtnCancel.ModalResult = 2
If Form.showModal = 1 Then
If IsArray(Input) Then
SkinnedInputBox = Edt.ItemIndex
Else
SkinnedInputBox = Edt.Text
End If
Else
If IsArray(Input) Then
SkinnedInputBox = -1
Else
SkinnedInputBox = ""
End If
End If
End Function
Sub InitSheet(Sheet)
Dim ini : Set ini = SDB.IniFile
Dim ui : Set ui = SDB.UI
Dim i : i = 0
Dim edt : Set edt = ui.NewLabel(Sheet)
edt.Common.SetRect 5, 10, 50, 20
edt.Caption = "FTP site:"
edt.Autosize = False
Set edt = ui.NewEdit(Sheet)
edt.Common.SetRect 90, 7, 200, 20
edt.Common.ControlName = "NPSite"
edt.Text = ini.StringValue("PlaylistFTP","Site")
Set edt = ui.NewLabel(Sheet)
edt.Common.SetRect 5, 35, 50, 20
edt.Caption = "Username:"
edt.Autosize = False
Set edt = ui.NewEdit(Sheet)
edt.Common.SetRect 90, 32, 200, 20
edt.Common.ControlName = "NPUser"
edt.Text = ini.StringValue("PlaylistFTP","User")
Set edt = ui.NewLabel(Sheet)
edt.Common.SetRect 5, 60, 50, 20
edt.Caption = "Password:"
edt.Autosize = False
Set edt = ui.NewEdit(Sheet)
edt.Common.SetRect 90, 57, 200, 20
edt.Common.ControlName = "NPPass"
edt.Text = ""
Dim l : l = Len(Decrypt(ini.StringValue("PlaylistFTP","Pass")))
For i = 1 To l
edt.Text = edt.Text&"*"
Next
Set edt = ui.NewLabel(Sheet)
edt.Common.SetRect 5, 85, 50, 20
edt.Caption = "Remote path:"
edt.Autosize = False
Set edt = ui.NewEdit(Sheet)
edt.Common.SetRect 90, 82, 200, 20
edt.Common.ControlName = "NPPath"
edt.Text = ini.StringValue("PlaylistFTP","Path")
End Sub
Sub SaveSheet(Sheet)
Dim ini : Set ini = SDB.IniFile
ini.StringValue("PlaylistFTP","Site") = Sheet.Common.ChildControl("NPSite").Text
ini.StringValue("PlaylistFTP","User") = Sheet.Common.ChildControl("NPUser").Text
ini.StringValue("PlaylistFTP","Path") = Sheet.Common.ChildControl("NPPath").Text
Dim t : t = Sheet.Common.ChildControl("NPPass").Text
Dim s : s = ""
Dim i : i = 0
Dim l : l = Len(Decrypt(ini.StringValue("PlaylistFTP","Pass")))
For i = 1 To l
s = s&"*"
Next
If Not (t = s) Then
ini.StringValue("PlaylistFTP","Pass") = Encrypt(t)
End If
End Sub
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