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