Now Playing FTP 1.8 - Updated 09/01/2010
Posted: Wed Sep 19, 2007 12:17 pm
This is a new script, as requested here. When the state of the player changes (play, stop, ...) this script creates a file in the format...
This is then uploaded via FTP to the host you specify. This file can then be included by another PHP page on your site so that you can display these values as you wish.
The installer is available to download from my website, and here's the code...
Code: Select all
<?php
$mode = "0";
$title = "...";
$artist = "...";
$album = "...";
$year = "...";
$genre = "...";
$track = "...";
$disc = "...";
$image = "...";
$albart = "...";
$rating = "...";
?>The installer is available to download from my website, and here's the code...
Code: Select all
'
' MediaMonkey Script
'
' NAME: NowPlayingFTP 1.8
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 09/01/2010
'
' Thanks to Steegy for the SkinnedInputBox
' Thanks to Nathan Rice for FTPUpload
'
' FIXES: Added encryption of FTP password
'
Option Explicit
Sub OnInstall()
SDB.IniFile.StringValue("NowPlayingFTP","Pass") = ""
Call OnStartup()
End Sub
Sub OnStartup()
Call Script.RegisterEvent(SDB,"OnPlay","Event_OnPlay")
Call Script.RegisterEvent(SDB,"OnStop","Event_OnStop")
Call Script.RegisterEvent(SDB,"OnShutdown","Event_OnShutdown")
Call Script.RegisterEvent(SDB,"OnPause","Event_OnPause")
Call SDB.UI.AddOptionSheet("NowPlayingFTP Settings",Script.ScriptPath,"InitSheet","SaveSheet",-2)
If SDB.IniFile.StringValue("NowPlayingFTP","Enab") = "" Then
SDB.IniFile.BoolValue("NowPlayingFTP","Enab") = True
End If
End Sub
Sub Event_OnPlay()
If SDB.IniFile.BoolValue("NowPlayingFTP","Enab") Then
Call SendInfo(0)
End If
End Sub
Sub Event_OnStop()
If SDB.IniFile.BoolValue("NowPlayingFTP","Enab") Then
Call SendInfo(1)
End If
End Sub
Sub Event_OnShutdown()
If SDB.IniFile.BoolValue("NowPlayingFTP","Enab") Then
Call SendInfo(2)
End If
End Sub
Sub Event_OnPause()
If SDB.IniFile.BoolValue("NowPlayingFTP","Enab") Then
Call SendInfo(3)
End If
End Sub
Sub SendInfo(mode)
'get current song
Dim cur : Set cur = SDB.Player.CurrentSong
If cur Is Nothing Then
Exit Sub
End If
'get settings
Dim site : site = ""
Dim user : user = ""
Dim pass : pass = ""
Dim path : path = ""
Dim arti : arti = ""
Dim albu : albu = ""
Dim year : year = ""
Dim name : name = ""
Dim secs : secs = ""
Dim genr : genr = ""
Dim dnum : dnum = ""
Dim tnum : tnum = ""
Dim artw : artw = ""
Dim recs : recs = ""
Dim aart : aart = ""
Dim rati : rati = ""
Call GetSettings(site,user,pass,path,secs,artw,recs)
If (site = "") Or (user = "") Or (pass = "") Or (path = "") Or (secs = "") Or (artw = "") Or (recs = "") Then
Call SDB.MessageBox("NowPlayingFTP: Some settings missing.",mtError,Array(mbOk))
Exit Sub
End If
'check songlength
Dim msec : msec = 0
If IsNumeric(secs) Then
msec = secs*1000
End If
If cur.SongLength < msec Then
Exit Sub
End If
'create file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\np.inc"
Dim tmp : Set tmp = fso.CreateTextFile(loc,True)
Call tmp.WriteLine("<?php")
Call tmp.WriteLine(" $mode = """&mode&""";")
If Not (cur Is Nothing) Then
name = cur.Title
arti = cur.ArtistName
albu = cur.AlbumName
year = cur.Year
genr = cur.Genre
dnum = cur.DiscNumberStr
tnum = cur.TrackOrderStr
If UCase(artw) = "Y" Then
artw = GetAlbumArt(cur,0)
Else
artw = ""
End If
aart = cur.AlbumArtistName
rati = cur.Rating
End If
Call tmp.WriteLine(" $title = """&HtmlEncode(name)&""";")
Call tmp.WriteLine(" $artist = """&HtmlEncode(arti)&""";")
Call tmp.WriteLine(" $album = """&HtmlEncode(albu)&""";")
Call tmp.WriteLine(" $year = """&HtmlEncode(year)&""";")
Call tmp.WriteLine(" $genre = """&HtmlEncode(genr)&""";")
Call tmp.WriteLine(" $track = """&HtmlEncode(tnum)&""";")
Call tmp.WriteLine(" $disc = """&HtmlEncode(dnum)&""";")
If Not (artw = "") Then
Call tmp.WriteLine(" $image = """&HtmlEncode(Mid(artw,InStrRev(artw,"\")+1))&""";")
Else
Call tmp.WriteLine(" $image = """";")
End If
Call tmp.WriteLine(" $rating = """&HtmlEncode(rati)&""";")
Call tmp.WriteLine(" $albart = """&HtmlEncode(aart)&""";")
'include history
Dim tot : tot = Int(recs)
If tot > 0 Then
Dim ltp : ltp = "0.0" '!!!
Dim iter : Set iter = SDB.Database.QuerySongs("LastTimePlayed >= "<p&" ORDER BY LastTimePlayed DESC LIMIT "&tot)
If iter.EOF Then
Call tmp.WriteLine(" $prev = array();")
Else
Dim ind : ind = 0
Call tmp.WriteLine(" $prev = array(")
While Not iter.EOF
Set cur = iter.Item
Call tmp.WriteLine(" "&ind&" => array(")
Call tmp.WriteLine(" ""title"" => """&HtmlEncode(cur.Title)&""",")
Call tmp.WriteLine(" ""artist"" => """&HtmlEncode(cur.ArtistName)&""",")
Call tmp.WriteLine(" ""album"" => """&HtmlEncode(cur.AlbumName)&""",")
Call tmp.WriteLine(" ""year"" => """&HtmlEncode(cur.Year)&""",")
Call tmp.WriteLine(" ""genre"" => """&HtmlEncode(cur.Genre)&""",")
Call tmp.WriteLine(" ""track"" => """&HtmlEncode(cur.TrackOrderStr)&""",")
Call tmp.WriteLine(" ""disc"" => """&HtmlEncode(cur.DiscNumberStr)&""",")
Call tmp.WriteLine(" ""rating"" => """&HtmlEncode(cur.Rating)&""",")
Call tmp.WriteLine(" ""albart"" => """&HtmlEncode(cur.AlbumArtistName)&"""")
iter.Next
If iter.EOF Then
Call tmp.WriteLine(" )")
Else
Call tmp.WriteLine(" ),")
End If
ind = ind+1
WEnd
Call tmp.WriteLine(" );")
End If
Set iter = Nothing
End If
'upload file
Call tmp.WriteLine("?>")
tmp.Close
Dim res : res = ""
If Not (artw = "") Then
res = FTPUpload(site,user,pass,artw,path)
If Not (res = "") Then
Call SDB.MessageBox("NowPlayingFTP: "&res,mtError,Array(mbOk))
End If
End If
If res = "" Then
res = FTPUpload(site,user,pass,loc,path)
If Not (res = "") Then
Call SDB.MessageBox("NowPlayingFTP: "&res,mtError,Array(mbOk))
End If
End If
End Sub
Function GetSettings(site,user,pass,path,secs,artw,recs)
Dim ini : Set ini = SDB.IniFile
site = ini.StringValue("NowPlayingFTP","Site")
If site = "" Then
site = SkinnedInputBox("FTP site","NowPlayingFTP","","NowPlayingFTP")
ini.StringValue("NowPlayingFTP","Site") = site
End If
user = ini.StringValue("NowPlayingFTP","User")
If user = "" Then
user = SkinnedInputBox("Username","NowPlayingFTP","","NowPlayingFTP")
ini.StringValue("NowPlayingFTP","User") = user
End If
pass = ini.StringValue("NowPlayingFTP","Pass")
If pass = "" Then
pass = SkinnedInputBox("Password","NowPlayingFTP","","NowPlayingFTP")
ini.StringValue("NowPlayingFTP","Pass") = Encrypt(pass)
Else
pass = Decrypt(pass)
End If
path = ini.StringValue("NowPlayingFTP","Path")
If path = "" Then
path = SkinnedInputBox("Remote path","NowPlayingFTP","","NowPlayingFTP")
ini.StringValue("NowPlayingFTP","Path") = path
End If
secs = ini.StringValue("NowPlayingFTP","Secs")
If secs = "" Then
secs = SkinnedInputBox("Minimum songlength (sec)","NowPlayingFTP","","NowPlayingFTP")
If Not (IsNumeric(secs)) Then
secs = ""
End If
ini.StringValue("NowPlayingFTP","Secs") = secs
End If
artw = ini.StringValue("NowPlayingFTP","Artw")
If artw = "" Then
artw = UCase(SkinnedInputBox("Artwork (Y/N)?","NowPlayingFTP","","NowPlayingFTP"))
If Not (artw = "Y") Then
artw = "N"
End If
ini.StringValue("NowPlayingFTP","Artw") = artw
End If
recs = ini.StringValue("NowPlayingFTP","Recs")
If recs = "" Then
recs = SkinnedInputBox("Include previous tracks","NowPlayingFTP","","NowPlayingFTP")
If Not (IsNumeric(recs)) Then
recs = "0"
End If
ini.StringValue("NowPlayingFTP","Recs") = recs
End If
End Function
Function FTPUpload(sSite,sUsername,sPassword,sLocalFile,sRemotePath)
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim wsh : Set wsh = CreateObject("WScript.Shell")
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 prog : Set prog = Nothing
If SDB.IniFile.StringValue("NowPlayingFTP","Prog") = "Y" Then
Set prog = SDB.Progress
prog.Text = "NowPlayingFTP: Uploading file "&sLocalFile&"..."
End If
Set SDB.Objects("NowPlayingFTPPrg") = prog
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 = wsh.ExpandEnvironmentStrings("%TEMP%")
Dim sFTPResults : sFTPResults = sFTPTempFile&"\np.dat"
sFTPTempFile = sFTPTempFile&"\np.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("NowPlayingFTPDic") = dic
Set SDB.Objects("NowPlayingFTPFil") = Nothing
Dim tmr : Set tmr = SDB.CreateTimer(10)
Call Script.RegisterEvent(tmr,"OnTimer","DoUpload")
Set dic = SDB.Objects("NowPlayingFTPFil")
Do While (dic Is Nothing)
SDB.Tools.Sleep(50)
SDB.ProcessMessages
Set dic = SDB.Objects("NowPlayingFTPFil")
Loop
Set SDB.Objects("NowPlayingFTPDic") = Nothing
Set SDB.Objects("NowPlayingFTPFil") = Nothing
Set SDB.Objects("NowPlayingFTPPrg") = Nothing
Dim fil : Set fil = fso.OpenTextFile(sFTPResults,1,True,-2)
Dim str : str = ""
FTPUpload = "Error occurred during file upload."
Do While Not fil.AtEndOfStream
str = Left(fil.ReadLine,3)
If str = "226" Then
FTPUpload = ""
Exit Do
ElseIf str = "530" Then
FTPUpload = "Login authentication failed."
Exit Do
End If
Loop
fil.Close
Set fil = Nothing
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 Function
Sub DoUpload(tmr)
Call Script.UnregisterEvents(tmr)
Dim dic : Set dic = SDB.Objects("NowPlayingFTPDic")
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("NowPlayingFTPFil") = dic
End if
End If
End Sub
Function SkinnedInputBox(Text, Caption, Input, PositionName)
Dim Form, Label, Edt, btnOk, btnCancel, modalResult
' 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
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
' 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
SkinnedInputBox = Edt.Text
Else
SkinnedInputBox = ""
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("NowPlayingFTP","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("NowPlayingFTP","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("NowPlayingFTP","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("NowPlayingFTP","Path")
Set edt = ui.NewLabel(Sheet)
edt.Common.SetRect 5, 110, 50, 20
edt.Caption = "Min. length (s):"
edt.Autosize = False
Set edt = ui.NewEdit(Sheet)
edt.Common.SetRect 90, 107, 200, 20
edt.Common.ControlName = "NPSecs"
edt.Text = ini.IntValue("NowPlayingFTP","Secs")
Set edt = ui.NewCheckBox(Sheet)
edt.Common.SetRect 5, 135, 200, 20
edt.Common.ControlName = "NPEnab"
edt.Caption = "Enable this script?"
edt.Checked = ini.BoolValue("NowPlayingFTP","Enab")
Set edt = ui.NewCheckBox(Sheet)
edt.Common.SetRect 5, 160, 200, 20
edt.Common.ControlName = "NPArtw"
edt.Caption = "Upload artwork as well?"
If ini.StringValue("NowPlayingFTP","Artw") = "Y" Then
edt.Checked = True
Else
edt.Checked = False
End If
Set edt = ui.NewCheckBox(Sheet)
edt.Common.SetRect 5, 185, 200, 20
edt.Common.ControlName = "NPProg"
edt.Caption = "Show progress bar?"
If ini.StringValue("NowPlayingFTP","Prog") = "Y" Then
edt.Checked = True
Else
edt.Checked = False
End If
Set edt = ui.NewLabel(Sheet)
edt.Common.SetRect 5, 210, 50, 20
edt.Caption = "Previous tracks:"
edt.Autosize = False
Set edt = ui.NewEdit(Sheet)
edt.Common.SetRect 90, 207, 200, 20
edt.Common.ControlName = "NPRecs"
edt.Text = ini.IntValue("NowPlayingFTP","Recs")
End Sub
Sub SaveSheet(Sheet)
Dim ini : Set ini = SDB.IniFile
Dim i : i = 0
Dim s : s = ""
Dim t : t = ""
Dim l : l = Len(Decrypt(ini.StringValue("NowPlayingFTP","Pass")))
For i = 1 To l
s = s&"*"
Next
ini.StringValue("NowPlayingFTP","Site") = Sheet.Common.ChildControl("NPSite").Text
ini.StringValue("NowPlayingFTP","User") = Sheet.Common.ChildControl("NPUser").Text
ini.StringValue("NowPlayingFTP","Path") = Sheet.Common.ChildControl("NPPath").Text
t = Sheet.Common.ChildControl("NPPass").Text
If Not (t = s) Then
ini.StringValue("NowPlayingFTP","Pass") = Encrypt(t)
End If
ini.IntValue("NowPlayingFTP","Secs") = Sheet.Common.ChildControl("NPSecs").Text
ini.BoolValue("NowPlayingFTP","Enab") = Sheet.Common.ChildControl("NPEnab").Checked
If Sheet.Common.ChildControl("NPArtw").Checked Then
ini.StringValue("NowPlayingFTP","Artw") = "Y"
Else
ini.StringValue("NowPlayingFTP","Artw") = "N"
End If
If Sheet.Common.ChildControl("NPProg").Checked Then
ini.StringValue("NowPlayingFTP","Prog") = "Y"
Else
ini.StringValue("NowPlayingFTP","Prog") = "N"
End If
ini.IntValue("NowPlayingFTP","Recs") = Sheet.Common.ChildControl("NPRecs").Text
End Sub
Function GetAlbumArt(track,num)
GetAlbumArt = Replace(Script.ScriptPath,"NowPlayingFTP.vbs","default.jpg")
Dim fso : Set fso = SDB.Tools.FileSystem
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim str : str = "\np.jpg"
If num > 0 Then
str = "\np"&num&".jpg"
End If
Dim temp : temp = wsh.ExpandEnvironmentStrings("%TEMP%")&str
Dim pics : Set pics = track.AlbumArt
If Not (pics Is Nothing) Then
Dim i : i = 0
For i = 0 To pics.Count-1
If (pics.Item(i).ItemStorage = 0) Or (num > 0) Then
Dim img : Set img = pics.Item(i).Image
If Not (img Is Nothing) Then
Dim outimg : Set outimg = fso.CreateTextFile(temp,True)
If Not (outimg Is Nothing) Then
Call outimg.WriteData(img.ImageData,img.ImageDataLen)
outimg.Close
GetAlbumArt = temp
Exit Function
End If
End If
Else
GetAlbumArt = pics.Item(i).PicturePath
Exit Function
End If
Next
End If
End Function
Function HtmlEncode(str)
HtmlEncode = SDB.toAscii(str)
HtmlEncode = Replace(HtmlEncode,"&","&")
HtmlEncode = Replace(HtmlEncode,"""",""")
HtmlEncode = Replace(HtmlEncode,"<","<")
HtmlEncode = Replace(HtmlEncode,">",">")
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