Page 1 of 2

Playlist FTP 1.1 - Updated 08/02/2011

PostPosted: Mon Jan 31, 2011 1:19 pm
by trixmoto
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...

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

Re: Playlist FTP 1.0 - Created 31/01/2011

PostPosted: Mon Jan 31, 2011 1:23 pm
by Eyal
http://trixmoto.net/mm/go.php?f=PlaylistFTP10.mmip
File does not exist!
:(

Re: Playlist FTP 1.0 - Created 31/01/2011

PostPosted: Mon Jan 31, 2011 1:27 pm
by trixmoto
Ooops, I knew I'd forgotten something! Should be there now :)

Re: Playlist FTP 1.0 - Created 31/01/2011

PostPosted: Mon Jan 31, 2011 1:35 pm
by Eyal
Thanks :)

Re: Playlist FTP 1.0 - Created 31/01/2011

PostPosted: Mon Jan 31, 2011 8:39 pm
by gpzbc
This is a nice idea! Thanks.

Re: Playlist FTP 1.0 - Created 31/01/2011

PostPosted: Tue Feb 01, 2011 4:42 am
by JuBe
Will this also upload to a FTPES server or only unencrypted?

Re: Playlist FTP 1.0 - Created 31/01/2011

PostPosted: Tue Feb 01, 2011 1:02 pm
by trixmoto
I don't think FTPES will work, but I've not tried it as I don't have one.

Re: Playlist FTP 1.0 - Created 31/01/2011

PostPosted: Mon Feb 07, 2011 2:10 pm
by skafan00
Thanks so much for making this script. However, I am having trouble getting it to work. I get an error. My provider says I need these settings:

1. FTP Host Server: ftp.fatcow.com
2. FTP Host directory: leave bank.
3. Login: FTP account username.
4. Password: FTP account password.
5. Port: 21
6: login type: Normal

What is a remote path? They said to leave it blank, but the script won't let me. FYI...If anything is left blank the script goes into an endless loop
I don't see options for "port" or "login type"

If at all possible to upload multiple playlists at once, that would be great!

Re: Playlist FTP 1.0 - Created 31/01/2011

PostPosted: Mon Feb 07, 2011 5:58 pm
by trixmoto
The "remote path" is the "host directory" and should probably be "/" if this is the root directory, although I've never tried that. Port and login type do not need to be specified. If you want to update multiple playlists, you could create an autoplaylist which takes tracks from the other playlists, I think.

Re: Playlist FTP 1.1 - Updated 08/02/2011

PostPosted: Tue Feb 08, 2011 5:48 pm
by trixmoto
New version (1.1) is now available to download from my website. I have fixed it so that if you receive the generic error message "Error occurred during file upload." then you can look in the Windows Temporary directory (%temp%) and find the files "pftp.dat" and "pftp.tmp" would should be useful for working out what went wrong.

Re: Playlist FTP 1.1 - Updated 08/02/2011

PostPosted: Wed Feb 09, 2011 9:03 am
by skafan00
I am still getting errors and those files are not in my TEMP folder (Or anywhere else on my computer - according to advanced search). I am running Windows Vista Home Premium 64 bit if that helps.

ENHANCEMENT REQUEST: It would be great if this script also uploaded the actual .M3U file along with the new host location of the songs so that I can refer to the .M3U file from my website to play the songs in the playlist.

Also, I am wondering what will happen if a certain song is on multiple playlists. Will the script overwrite it? Would a previous uploaded playlist still work for that song (or would the location\filename be different?

Thanks o much.

Re: Playlist FTP 1.1 - Updated 08/02/2011

PostPosted: Wed Feb 09, 2011 11:51 am
by trixmoto
I don't know what to say, if there files aren't there then that's definitely problem as it's not possible for the script to run without creating them.

I could upload the .M3U file, but presumably it would need editing because the full paths would be wrong?

The script will overwrite songs if it uploads the same one twice, yes, but that shouldn't matter as the location will remain the same.

Re: Playlist FTP 1.1 - Updated 08/02/2011

PostPosted: Mon Feb 14, 2011 1:01 pm
by skafan00
Do yu need a snapshot of my specs or something to help figure out why those files are not being created? Thanks.

Re: Playlist FTP 1.1 - Updated 08/02/2011

PostPosted: Mon Feb 14, 2011 1:22 pm
by trixmoto
I don't think that will help :-?

Re: Playlist FTP 1.1 - Updated 08/02/2011

PostPosted: Wed Mar 02, 2011 1:48 pm
by skafan00
This script is still not working. Any updates?