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