
"Invalid Quickkey. This error has been forwarded to MediaFire's development team"
[DEISync1]
Filename=Auto\DEISync.vbs
Procname=ExportCompleteDatabase("Export Complete Database")
Order=99
DisplayName=Export Complete Database
Description=Export Complete Database
Language=VBScript
ScriptType=99If sValue = 0 And fso.FileExists(sdb.ApplicationPath & "Scripts\" & mnuScript(i)) Then'####################################################################
' Added by C:\PROGRA~1\MEDIAM~2\Scripts\Auto\RightClickForScripts.vbs
Sub RightClickForScripts_ExportCompleteDatabase("Export Complete Database")(o)
ExportCompleteDatabase("Export Complete Database")
End Sub
'####################################################################Sub RightClickForScripts_ExportCompleteDatabase(o)Removed. Better version down further
[DEISync1]
Filename=Auto\DEISync.vbs
Procname=ExportCompleteDatabase1
Order=99
DisplayName=Export Complete Database
Description=Export Complete Database
Language=VBScript
ScriptType=99
[DEISync2]
Filename=Auto\DEISync.vbs
Procname=ExportCompleteDatabase2
Order=99
DisplayName=Your 2nd displayname
Description=Your 2nd description
Language=VBScript
ScriptType=99
etc...
Sub ExportCompleteDatabase1
Call ExportCompleteDatabase("Export Complete Database")
End Sub
Sub ExportCompleteDatabase2
Call ExportCompleteDatabase("Your 2nd parameter")
End Sub
etc...
[DEISync1]
Filename=Auto\DEISync.vbs
Procname=ExportCompleteDatabase
Order=99
DisplayName=Export Complete Database
Description=Export Complete Database
Language=VBScript
ScriptType=99
[DEISync2]
Filename=Auto\DEISync.vbs
Procname=ExportCompleteDatabase
Order=99
DisplayName=Export Sync Database
Description=Export Sync Database
Language=VBScript
ScriptType=99
Sub RightClickForScripts_ExportCompleteDatabase(o)
ExportCompleteDatabase(o)
End Sub' MediaMonkey Script
' NAME: RightClickForScripts
' AUTHOR: Onenonymous
' VERSION: 1.41
' DATE: Feb 22, 2008
' UPDATE: July 4, 2008
' FORUM URL: http://www.mediamonkey.com/forum/viewtopic.php?t=26383&start=0
'
' This Script places a new sub-menu when you right click on song(s) in the 4 pop-up
' menus (Main Window, Track List, Now Playing & Menu_Pop_Tree)
' as well as a button in the standard toolbar. Logging options are available
' from the menu in the standard toolbar.
' It reads through the Scripts.ini file and loads any Script of type 0 into the menus.
' July 4 update - also checks for script type > 10
' To use, right click on a song, multiple songs or a node and find the new Scripts menu.
' Select one of the scripts from there. This is the same as if you chose the Script from
' the Scripts menu under the Tools menu. Tested with MM3.
'
' NOTES ON USE:
' To work, we must add some code to each of the scripts we want to use
' off of our Right-Click menus. To do this, we first check each script to
' see if we've already added that code. If not, the other script is
' first backed up with a ".bak" extension, then the original script is
' modified to add our code to the end of the script.
'
' INSTALL INSTRUCTIONS:
' Save as RightClickForScripts.vbs in the Scripts\Auto directory or use the mmip installer file
Option Explicit
CONST SCRIPT_NAME = "RightClickForScripts"
Dim sRCFS_LogFile: sRCFS_LogFile = sdb.ApplicationPath & "Scripts\Auto\RightClickForScripts.vbs" & ".log"
Dim mnuScript, mnuProc, mnuCaption, mnuHint, mnuType, boolLogging
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Sub OnStartUp()
' ################################################################################
' Uncomment the line below to turn on forced logging. Use for trouble-shooting only.
' sdb.IniFile.BoolValue(SCRIPT_NAME, "Logging") = True
' ################################################################################
On Error Resume Next
Dim sPath, sProc
Dim iniMM: Set iniMM = sdb.IniFile
If iniMM.BoolValue(SCRIPT_NAME, "Logging") = "" Then 'set it the first time we launch
iniMM.BoolValue(SCRIPT_NAME, "Logging") = False
End If
boolLogging = iniMM.BoolValue(SCRIPT_NAME, "Logging")
Dim objRCFS_menu, objRCFS_submenu, i, j, fso, sIconFile
Set iniMM = Nothing
RCFS_LogMe "OnStartup enter"
if not ProcessScriptsIni then exit sub
RCFS_LogMe "OnStartup - reenter from ProcessScriptsIni"
Call BubbleSort(mnuCaption)
RCFS_LogMe "OnStartup - reenter from BubbleSort"
For j = 1 To 5 'create the menus
Select Case j
Case 1
RCFS_LogMe "Loading menu Menu_Pop_NP_MainWindow"
If sdb.Objects("Menu_Pop_NP_MainWindow_Scripts") Is Nothing Then
RCFS_LogMe " Creating Scripts menu"
Set objRCFS_menu = sdb.UI.AddMenuItemSub(sdb.UI.Menu_Pop_NP_MainWindow, -1, -1)
sdb.UI.AddMenuItemSep sdb.UI.Menu_Pop_NP_MainWindow, -1, -2
Set sdb.Objects("Menu_Pop_NP_MainWindow_Scripts") = objRCFS_menu
Else
Set objRCFS_menu = sdb.Objects("Menu_Pop_NP_MainWindow_Scripts")
RCFS_LogMe " Scripts menu already available: Menu_Pop_NP_MainWindow_Scripts"
End If
Case 2
RCFS_LogMe "Loading menu Menu_Pop_TrackList"
If sdb.Objects("Menu_Pop_TrackList_Scripts") Is Nothing Then
RCFS_LogMe " Creating Scripts menu"
sdb.UI.AddMenuItemSep sdb.UI.Menu_Pop_TrackList, -1, -1
Set objRCFS_menu = sdb.UI.AddMenuItemSub(sdb.UI.Menu_Pop_TrackList, -1, -1)
Set sdb.Objects("Menu_Pop_TrackList_Scripts") = objRCFS_menu
Else
Set objRCFS_menu = sdb.Objects("Menu_Pop_TrackList_Scripts")
RCFS_LogMe " Scripts menu already available: Menu_Pop_TrackList_Scripts"
End If
Case 3
RCFS_LogMe "Loading menu Menu_Pop_NP"
If sdb.Objects("Menu_Pop_NP_Scripts") Is Nothing Then
RCFS_LogMe " Creating Scripts menu"
sdb.UI.AddMenuItemSep sdb.UI.Menu_Pop_NP, -1, -1
Set objRCFS_menu = sdb.UI.AddMenuItemSub(sdb.UI.Menu_Pop_NP, -1, -1)
Set sdb.Objects("Menu_Pop_NP_Scripts") = objRCFS_menu
Else
Set objRCFS_menu = sdb.Objects("Menu_Pop_NP_Scripts")
RCFS_LogMe " Scripts menu already available: Menu_Pop_NP_Scripts"
End If
Case 4
RCFS_LogMe "Loading menu Menu_Pop_Tree"
If sdb.Objects("Menu_Pop_Tree_Scripts") Is Nothing Then
RCFS_LogMe " Creating Scripts menu"
sdb.UI.AddMenuItemSep sdb.UI.Menu_Pop_Tree, -1, -1
Set objRCFS_menu = sdb.UI.AddMenuItemSub(sdb.UI.Menu_Pop_Tree, -1, -1)
Set sdb.Objects("Menu_Pop_Tree_Scripts") = objRCFS_menu
Else
Set objRCFS_menu = sdb.Objects("Menu_Pop_Tree_Scripts")
RCFS_LogMe " Scripts menu already available: Menu_Pop_Tree_Scripts"
End If
Case 5
RCFS_LogMe "Loading menu Menu_TbStandard"
If sdb.Objects("Menu_TbStandard_Scripts") Is Nothing Then
RCFS_LogMe " Creating Scripts menu"
Set objRCFS_menu = sdb.UI.AddMenuItemSub(sdb.UI.Menu_TbStandard, -1, -1)
Set sdb.Objects("Menu_TbStandard_Scripts") = objRCFS_menu
Else
Set objRCFS_menu = sdb.Objects("Menu_TbStandard_Scripts")
RCFS_LogMe " Scripts menu already available: Menu_TbStandard_Scripts"
End If
End Select
objRCFS_menu.Caption = "Scripts"
objRCFS_menu.Hint = "Displays the scripts"
sIconFile = sdb.ApplicationPath & "Scripts\Auto\RightClickForScripts.ico"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(sIconFile) Then
objRCFS_menu.IconIndex = sdb.RegisterIcon(sIconFile, 0)
RCFS_LogMe " Using icon: " & sIconFile
Else
objRCFS_menu.IconIndex = 44
RCFS_LogMe " Using icon: 44"
End If
Set fso = Nothing
For i = 1 To UBound(mnuCaption) ' now load each of the Script menus
Set objRCFS_submenu = sdb.UI.AddMenuItem(objRCFS_menu, 0, 0)
sPath = sdb.ApplicationPath & "Scripts\" & mnuScript(i)
sProc = SCRIPT_NAME & "_" & mnuProc(i)
With objRCFS_submenu
.Caption = mnuCaption(i)
.UseScript = sPath
.OnClickFunc = sProc
.Hint = mnuHint(i)
End With
RCFS_LogMe " Added item: " & mnuCaption(i)
Next
If j = 5 Then 'we're loading the standard toolbar, so add the logging menus
sdb.UI.AddMenuItemSep objRCFS_menu, -1, -1
Set objRCFS_submenu = sdb.UI.AddMenuItem(objRCFS_menu, 0, 0)
Set sdb.Objects("myRCFS_RCFS_LogMenu") = objRCFS_submenu
With objRCFS_submenu
.Caption = "Turn Logging On/Off"
.Checked = boolLogging
.Hint = "Turns on or off logging for 'Right Click For Scripts'"
End With
Script.RegisterEvent objRCFS_submenu, "OnClick", "ToggleLogging"
RCFS_LogMe " Added item: Logging"
Set objRCFS_submenu = sdb.UI.AddMenuItem(objRCFS_menu, 0, 0)
Set sdb.Objects("myRCFS_ViewRCFS_LogMenu") = objRCFS_submenu
With objRCFS_submenu
.Caption = "View Log"
.Hint = "Views the 'Right Click For Scripts' Log"
End With
Script.RegisterEvent objRCFS_submenu, "OnClick", "ViewLog"
RCFS_LogMe " Added item: View Log"
Set objRCFS_submenu = sdb.UI.AddMenuItem(objRCFS_menu, 0, 0)
Set sdb.Objects("myRCFS_DeleteRCFS_LogMenu") = objRCFS_submenu
With objRCFS_submenu
.Caption = "Delete Log"
.IconIndex = 8
.Hint = "Deletes the 'Right Click For Scripts' Log"
End With
Script.RegisterEvent objRCFS_submenu, "OnClick", "DeleteLog"
RCFS_LogMe " Added item: Delete Log"
Call ToggleRCFS_LogMenus
End If
Next
For i = 1 To UBound(mnuCaption)
FixScript mnuScript(i), mnuProc(i), mnuType(i)
Next
Set objRCFS_submenu = Nothing
Set objRCFS_menu = Nothing
RCFS_LogMe "OnStartup exit"
End Sub
Function ProcessScriptsIni()
' Reads through Scripts.ini file to gather info on
' all scripts of type 0 (scripts that go into the 'scripts' menu).
On Error Resume Next
ProcessScriptsIni = True
Dim i, fso, iniF, iniPathedFileName, iniLine, ch, _
p, keyName, lcKeyName, sValue
RCFS_LogMe "ProcessScriptsIni enter"
Set fso = CreateObject("Scripting.FileSystemObject")
iniPathedFileName = sdb.ApplicationPath & "Scripts\Scripts.ini"
If Not(fso.FileExists(iniPathedFileName)) Then
RCFS_LogMe "Couldn't find: " & iniPathedFileName
Msgbox "Couldn't find the Scripts.ini file at:" & vbcrlf & iniPathedFileName & _
vbcrlf & vbcrlf & "Exiting script: " & vbcrlf & Script.ScriptPath, vbCritical + vbOKOnly, Script.ScriptPath
ProcessScriptsIni = False
Exit Function
end if
Set iniF = fso.OpenTextFile(iniPathedFileName, 1)
i = 1
ReDim mnuScript(1)
ReDim mnuProc(1)
ReDim mnuCaption(1)
ReDim mnuHint(1)
ReDim mnuType(1)
Do While (Not iniF.AtEndOfStream) ' loop through all lines in file
iniLine = iniF.ReadLine
ch = Mid(iniLine, 1, 1)
If ((ch <> "") And (ch <> " ") And (ch <> ";") And (ch <> "[") And (ch <> "'")) Then
' process the line
RCFS_LogMe " Processing line: " & iniLine
p = InStr(iniLine, "=")
keyName = Mid(iniLine, 1, p - 1)
lcKeyName = LCase(keyName)
sValue = Trim(Mid(iniLine, p + 1))
Select Case lcKeyName
Case "filename"
mnuScript(i) = sValue
Case "procname"
mnuProc(i) = sValue
Case "displayname"
mnuCaption(i) = Replace(sValue, "&", "")
Case "description"
mnuHint(i) = sValue
Case "scripttype"
mnuType(i) = sValue
If (sValue = 0 or sValue > 10) And fso.FileExists(sdb.ApplicationPath & "Scripts\" & mnuScript(i)) Then
RCFS_LogMe " Script: " & mnuScript(i)
RCFS_LogMe " Proc: " & mnuProc(i)
RCFS_LogMe " Caption: " & mnuCaption(i)
RCFS_LogMe " Hint: " & mnuHint(i)
i = i + 1 ' increment i each type we get a Script type of 0 & Script is found
ReDim Preserve mnuScript(i)
ReDim Preserve mnuProc(i)
ReDim Preserve mnuCaption(i)
ReDim Preserve mnuHint(i)
ReDim Preserve mnuType(i)
End If
End Select
End If
Loop
ReDim Preserve mnuScript(i - 1)
ReDim Preserve mnuProc(i - 1)
ReDim Preserve mnuCaption(i - 1)
ReDim Preserve mnuHint(i - 1)
ReDim Preserve mnuType(i - 1)
iniF.Close
Set iniF = Nothing
Set fso = Nothing
RCFS_LogMe "ProcessScriptsIni exit"
End Function
Sub BubbleSort(List())
' Sorts an array using bubble sort algorithm
On Error Resume Next
RCFS_LogMe "BubbleSort enter"
Dim First, Last
Dim i
Dim j
Dim Temp
First = LBound(List) + 1
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If List(i) > List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
Temp = mnuScript(j)
mnuScript(j) = mnuScript(i)
mnuScript(i) = Temp
Temp = mnuProc(j)
mnuProc(j) = mnuProc(i)
mnuProc(i) = Temp
Temp = mnuHint(j)
mnuHint(j) = mnuHint(i)
mnuHint(i) = Temp
Temp = mnuType(j)
mnuType(j) = mnuType(i)
mnuType(i) = Temp
Temp = ""
End If
Next
Next
RCFS_LogMe "BubbleSort exit"
End Sub
Sub FixScript(sScript, sProc, sType)
'checks the Script for "Script.ScriptPath",
' if found, that scripts is backed up then modified
On Error Resume Next
RCFS_LogMe "FixScript enter: " & sScript
Dim sScriptPath, objFSO, objFile, sText, sNewText, sPattern
sScriptPath = sdb.ApplicationPath & "Scripts\" & sScript
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(sScriptPath, ForReading)
sText = objFile.ReadAll
sPattern = SCRIPT_NAME & "_" & sProc & "(o)"
If InStr(1, sText, sPattern, vbTextCompare) = 0 Then
' didn't find it so we need to add code to the script
' first make a copy of the file, then append my code to the end of the script
objFile.Close
objFSO.CopyFile sScriptPath, sScriptPath & ".bak", True
RCFS_LogMe " Backup Script name: " & sScriptPath & ".bak"
Set objFile = objFSO.OpenTextFile(sScriptPath, ForAppending)
objFile.WriteLine ""
objFile.WriteLine "'####################################################################"
objFile.WriteLine "' Added by " & Script.ScriptPath
objFile.WriteLine "Sub " & sPattern
If sType > 10 Then
objFile.WriteLine " " & sProc & "(o)"
Else
objFile.WriteLine " " & sProc
End If
objFile.WriteLine "End Sub"
objFile.WriteLine "'####################################################################"
objFile.Close
RCFS_LogMe " Fixing Script: " & sScriptPath
RCFS_LogMe " Added: Sub " & sPattern
Else
objFile.Close
RCFS_LogMe " No fix needed: " & sScriptPath
End If
Set objFile = Nothing
Set objFSO = Nothing
RCFS_LogMe "FixScript exit"
End Sub
Sub RCFS_LogMe(msg)
'by psyXonova'
On Error Resume Next
If boolLogging Then ' set at the beginning of the Script to enable logging
Dim fso, logf
Set fso = CreateObject("Scripting.FileSystemObject")
Set logf = fso.OpenTextFile(sRCFS_LogFile, ForAppending, True)
logf.WriteLine Now() & ": " & msg
Set fso = Nothing
Set logf = Nothing
End If
End Sub
Sub ToggleLogging(o)
On Error Resume Next
RCFS_LogMe "Logging turned off"
Dim iniMM: Set iniMM = sdb.IniFile
boolLogging = Not boolLogging
sdb.Objects("myRCFS_RCFS_LogMenu").Checked = boolLogging
iniMM.BoolValue(SCRIPT_NAME, "Logging") = boolLogging
Set iniMM = Nothing
ToggleRCFS_LogMenus
RCFS_LogMe "Logging turned on"
End Sub
Sub ViewLog(o)
On Error Resume Next
RCFS_LogMe "ViewLog enter"
Dim WshShell, fso
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(sRCFS_LogFile) Then
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run ("""" & sRCFS_LogFile & """")
Set WshShell = Nothing
Else
MsgBox "The log file does not exist." & vbCrLf & sRCFS_LogFile, vbInformation
End If
Set fso = Nothing
RCFS_LogMe "ViewLog exit"
End Sub
Sub DeleteLog(o)
On Error Resume Next
RCFS_LogMe "DeleteLog enter"
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(sRCFS_LogFile) Then
fso.DeleteFile (sRCFS_LogFile)
RCFS_LogMe " Deleted file: " & sRCFS_LogFile
Else
MsgBox "No log file to delete." & vbCrLf & sRCFS_LogFile, vbInformation
RCFS_LogMe " No file to delete"
End If
Set fso = Nothing
ToggleRCFS_LogMenus
RCFS_LogMe "DeleteLog exit"
End Sub
Sub ToggleRCFS_LogMenus()
On Error Resume Next
RCFS_LogMe "ToggleRCFS_LogMenus enter"
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(sRCFS_LogFile) Then
sdb.Objects("myRCFS_ViewRCFS_LogMenu").Enabled = True
sdb.Objects("myRCFS_DeleteRCFS_LogMenu").Enabled = True
RCFS_LogMe " Enabled"
Else
sdb.Objects("myRCFS_ViewRCFS_LogMenu").Enabled = False
sdb.Objects("myRCFS_DeleteRCFS_LogMenu").Enabled = False
RCFS_LogMe " Disabled"
End If
Set fso = Nothing
RCFS_LogMe "ToggleRCFS_LogMenus exit"
End Sub
sub HideMenus()
on error resume next
dim mnu
RCFS_LogMe "Hiding all menus"
sdb.Objects("Menu_Pop_Tree_Scripts").Visible = False
sdb.Objects("Menu_Pop_NP_MainWindow_Scripts").Visible = False
sdb.Objects("Menu_Pop_TrackList_Scripts").Visible = False
sdb.Objects("Menu_Pop_NP_Scripts").Visible = False
sdb.Objects("Menu_TbStandard_Scripts").Visible = False
End Sub
sub ShowMenus()
on error resume next
RCFS_LogMe "Showing all menus"
sdb.Objects("Menu_Pop_NP_MainWindow_Scripts").Visible = True
sdb.Objects("Menu_Pop_TrackList_Scripts").Visible = True
sdb.Objects("Menu_Pop_NP_Scripts").Visible = True
sdb.Objects("Menu_Pop_Tree_Scripts").Visible = True
sdb.Objects("Menu_TbStandard_Scripts").Visible = True
End Sub
Sub RCFS_Install()
On Error Resume Next
If sdb.Objects("myRCFS_RCFS_LogMenu") Is Nothing Then
Call OnStartUp
Else
MsgBox "You must restart MM to reload menus.", vbExclamation
End If
End Sub
Sub RCFS_UnInstall()
On Error Resume Next
RCFS_LogMe "Uninstalling script"
If (Not (sdb.IniFile Is Nothing)) Then
sdb.IniFile.DeleteSection (SCRIPT_NAME)
End If
HideMenus
End Sub
'
'##### END OF Script #######
onenonymous wrote:While you say this work for your specific requirement - it doesn't seem to be flexible for other situations. I don't think that I should assume that all script types > 10 require a parameter to be passed. I'll work on code to parse the procedure looking for a parameter to pass it in the snippet I add. I'll have to figure out when to pass the "(o)" and when to pass the parameter the original author put into scripts.ini, and when no parameter is needed at all.
In any case, what did you think about the method I suggested yesterday? It would seem to work in all situations and isn't dependent on my script interpreting which procedures need parameters.
Users browsing this forum: Exabot [Bot] and 7 guests