Hi
Mbncp made a great script back in 2005 for Cubase SX3 showing all used key commands in a color html-table.
Has anyone succeeded transforming the script to win7 and cubase 6 ?
Or can anybody help
I have changed the path but I get an error saying : "the file wasn’t found ".
line 81 letter 3
The Script was :
Option Explicit
Const HTML = True ' True html file, False texte file (Tab delimited)
Const SECTIONNAME = False ' add the section name (True or False)
Const SORTKEY = False ' sort by key name (True or False)
' TODO : to have your keys in a certain order, enter them here:
'-----------------------------------------------
B = Array( _
"F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12", _
"`","1","2","3","4","5","6","7","8","9","0", _
"-","=","_","+","Backspace", _
"A","B","C","D","E","F","G","H","I","J","K","L", "M", _
"N","O","P","Q","R","S","T","U","V","W","X","Y","Z", _
"[", "]","\",";","'",",",".","/","Return","Space", _
"Insert", "Del", "Home", "End", "PgUp", "PgDown", _
"Left Arrow", "Up Arrow", "Right Arrow", "Down Arrow", _
"Pad0","Pad1","Pad2","Pad3","Pad4","Pad5","Pad6","Pad7", _
"Pad8","Pad9","Pad .","Pad /","Pad *","Pad -","Pad +","Enter" _
) ' end of array
' Make sure you have SORTKEY = False ;)
Const REMOVE_UNUSED = false ' removes unused keys from the list
' Find Replace key name , add always by pair: "SX key name", "New Name"
C = Array("_", "Shift+-", "+", "Shift+=")
' C = Array(-1) ' uncomment if you don't want key renaming
' Section color (http://msdn.microsoft.com/library/default.asp?url=/workshop/author/dhtml/reference/colors/colors.asp)
' Each section name must be followed by a color name
BK = Array( "Mixer", "linen", _
"Preferences", "silver", _
"Edit", "red", _
"Devices", "white", _
"Media", "white", _
"MIDI Quantize", "steelblue", _
"Set Insert Length","skyblue", _
"Play Order", "white", _
"Transport", "yellow", _
"Zoom", "lightyellow", _
"Nudge", "yellow", _
"Scores Statusbar", "white", _
"Score Functions", "white", _
"Tool", "white", _
"File", "indianred", _
"Project", "white", _
"AddTrack", "white", _
"Editors", "white", _
"Inspector", "white", _
"Audio", "white", _
"Hitpoints", "white", _
"Audio Realtime Processing", "white", _
"MIDI", "turquoise", _
"Navigate", "white", _
"Import", "limegreen", _
"Export", "deeppink", _
"Process", "lightskyblue", _
"Process Plugin", "mediumturquoise", _
"Analyze", "gold", _
"Process Logical Preset", "white",_
"Scores", "white", _
"Score Symbol Palettes", "white", _
"Score Align Elements", "white",_
"Score Meter Scale", "white", _
"Workspaces", "lightyellow", _
"Macro", "white" _
)
CH = Array("Aring" ,197,"aring" ,229,"auml" ,228,"ouml" ,246,"uuml" ,252,"szlig" ,223,"Oslash" ,216, "oslash" ,248,"Auml" ,196,"Ouml" ,214,"Uuml" ,220,"nbsp" ,160,"Agrave" ,192,"Egrave" ,200,"Eacute" ,201,"Ecirc" ,202,"egrave" ,232,"eacute" ,233,"ecirc" ,234,"agrave" ,224,"iuml" ,239,"ugrave" ,249,"ucirc" ,251,"uuml" ,252,"ccedil" ,231,"AElig" ,198,"aelig" ,330, "OElig" ,338,"oelig" ,339,"euro" ,8364,"laquo" ,171,"raquo" ,187, "sect", 167)
' / TODO
'---------------------------------------------------
Dim A, B, C, BK, CH
GetSX_Keys
Sub GetSX_Keys
Dim WshShell, fso, f, f2, f3, dir, dir2, tp, bc, n
Redim A(UBound(B)+1)
For f = 0 To UBound(B)
A(f+1) = Array( B(f), ".", ".", ".", ".", ".", ".", ".", ".")
Next
A(0) = Array("key", "-", "Shift", "Ctrl", "Alt", "Ctrl+Shift", "Alt+Shift", "Ctrl+Alt", "Ctrl+Alt+Shift")
If HTML Then tp = "html" else tp = "txt"
set WshShell = CreateObject("WScript.Shell")
dir = WshShell.SpecialFolders("C:\Users\Bruger\AppData") & "C:\Program Files\Steinberg\Cubase 6\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(dir & "Key Commands 2." & tp, True)
Set f2 = fso.CreateTextFile(dir & "KC_TMP.xml", True)
Set f3 = fso.OpenTextFile(dir & "Key Commands.xml", 1)
dim xmlDoc, t, u, v, w, x, y, z, s, d
set xmlDoc = CreateObject("Microsoft.XMLDOM")
dir2 = replace(dir , "\", "/")
xmlDoc.validateOnParse = False
xmlDoc.resolveExternals = False
xmlDoc.async = False
' special foreign chars
f2.write "<!DOCTYPE characters [ <!ELEMENT characters (character*) > <!ELEMENT character (#PCDATA ) > "
For n = 0 To UBound(CH)
f2.Write "<!ENTITY " & CH(n) & " " & chr(34) & "&#" & CH(n+1) & ";" & chr(34) & " >"
n = n+1
Next
f2.write "] > "
f2.write vbCRLF
f2.write(f3.ReadAll())
f2.Close
f3.Close
xmlDoc.load(dir2 & "KC_TMP.xml")
If xmlDoc.parseError.errorCode Then
MsgBox _
"File: " & dir & "Key Commands.xml" &vbCrLf & _
"Line : " & xmlDoc.parseError.line & vbCrLf & _
"Error: " & xmlDoc.parseError.reason, 0, "XML parser error:"
' Exit Sub
End If
On error resume next
for each t in xmlDoc.childNodes
If s = "Macro" Then Exit For
for each u in t.childNodes
If s = "Macro" Then Exit For
for each v in u.childNodes
If s = "Macro" Then Exit For
for each w in v.childNodes
If w.nodename = "string" Then s = w.attributes.item(1).text
If s = "Process Plugin" Then bc = True Else bc = False
If s = "Macro" Then Exit For
for each x in w.childNodes
If x.childNodes.length = 2 Then
d = x.childNodes.item(0).attributes.item(1).text
If bc Then
If len(d) > 34 Then d = Mid(d, 35)
End If
If x.childNodes.item(1).childNodes.length > 1 Then
for each y in x.childnodes.item(1).childNodes
AddKey s, d , y.attributes.item(0).text
next
Else
AddKey s, d , x.childNodes.item(1).attributes.item(1).text
End If
End If
next
next
next
next
next
If HTML then
f.write "<TABLE cellSpacing=1 cellPadding=1 width=" & _
chr(34) & "99%" & chr(34) & "align=center border=1>" & vbCrLf
End If
If SORTKEY Then
For t = 1 To UBound(A)
For u = t+1 To UBound(A)
If UCase(A(u)(0)) < UCase(A(t)(0)) Then
z = A(t) : A(t) = A(u) : A(u) = z
End If
Next
Next
End If
For t = 0 To UBound(A)
If HTML Then f.write "<TR>"
If REMOVE_UNUSED Then
For B = 1 To UBound(A(t))
If A(t)(B) <> "." Then Exit For
Next
If B > UBound(A(t)) Then
Redim b(-1) : A(t) = b
End If
End If
For u = 0 To UBound(A(t))
If HTML Then
If t = 0 Or u = 0 Then
f.write "<TD align=middle style=" & chr(34) & "FONT-WEIGHT: bold" & Chr(34) & ">" & A(t)(u) & "</TD>"
Else
If A(t)(u) = "." Then
'f.write "<TD align=middle>" & A(t)(u) & "</TD>"
f.write "<TD align=middle>.</TD>"
Else
f.write "<TD align=middle style=" & chr(34) & "BACKGROUND-COLOR: " & A(t)(u) & "</TD>"
End If
End If
Else
f.write A(t)(u)
If u <> UBound(A(t)) Then f.write vbTab
End If
Next
If HTML Then f.write "</TR>"
f.write vbCrLf
Next
If HTML then f.write "</TABLE>" & vbCrLf
f.close
If HTML Then s = "Explorer.exe " Else s = "notepad.exe "
WshShell.Run s & dir & "Key Commands 2." & tp
End Sub
Sub AddKey(s, d, byval k)
dim bp, ak, n, kn, bkc, m, ks
k = Trim(k)
If IsArray(C) Then
For n = 0 To UBound(C) Step 2
If C(n) = k Then
k = C(n+1)
Exit for
End If
Next
End If
ks = k
If Right(k, 1) = "+" Then bp = True
k = Replace(k, "+", vbCr)
If bp Then k = Left(k, len(k)-1) & "+"
ak = Split(k, vbCr) : kn = 0
For n = 0 To UBound(ak)-1
Select Case UCase(ak(n))
Case "SHIFT"
kn = kn Or 1
Case "CTRL"
kn = kn Or 2
Case "ALT"
kn = kn Or 4
End Select
Next
For n = 1 To UBound(A)
If UCase(A(n)(0)) = UCase(ak(UBound(ak))) Then Exit For
Next
If n > UBOund(A) Then
Redim Preserve A(n)
A(n) = Array(ak(UBound(ak)), ".", ".", ".", ".", ".", ".", ".", ".")
End If
Select Case kn
Case 4:
kn = 3
Case 3:
kn = 4
End Select
If HTML Then
bkc = "white"
If IsArray(BK) Then
For m = 0 To UBound(BK) Step 2
If BK(m) = s Then
bkc = BK(m+1)
Exit For
End If
Next
End If
End If
If SECTIONNAME Then
A(n)(kn+1) = bkc & A(0)(kn) & ">" & s & "-" & d
Else
A(n)(kn+1) = bkc & chr(34) & " title=" & chr(34) & "[ " & s & " ] " & ks & " : " & d & chr(34) & ">" & d
End If
End Sub