xp-consoles/console.vbs

150 lines
4.1 KiB
Plaintext

Option Explicit
On Error Resume Next
Private input, output, runButton, clearButton
Private Sub ConsoleLog(message, color)
Dim entry
Set entry = document.createElement("div")
With entry.style
.margin = "0"
.padding = "1px"
.borderBottom = "1px solid lightgray"
If Not IsNull(color) Then
.color = color
End If
End With
entry.appendChild(document.createTextNode(CStr(message)))
output.appendChild(entry)
End Sub
Sub Log(message)
ConsoleLog message, Null
End Sub
Sub Debug(message)
ConsoleLog message, "darkgray"
End Sub
Sub Info(message)
ConsoleLog message, Null
End Sub
Sub Warn(message)
ConsoleLog message, "orange"
End Sub
Sub Error(message)
ConsoleLog message, "red"
End Sub
Sub Assert(condition, message)
If Not condition Then
Error message
End If
End Sub
Sub Clear
output.innerHTML = ""
End Sub
Private Function RemoveCr (text)
RemoveCr = Replace(text, vbCrLf, vbLf)
End Function
Private Function GetSelectedText (element)
Dim normalizedValue, range, inputRange, endRange
Set range = document.selection.createRange()
If Not IsNull(range) And range.parentElement() = element Then
normalizedValue = RemoveCr(element.value)
Set inputRange = element.createTextRange()
inputRange.moveToBookmark range.getBookmark()
Set endRange = element.createTextRange()
endRange.collapse False
'Selection does not begin at the end of the input
If inputRange.compareEndPoints("StartToEnd", endRange) < 0 Then
Dim selectionStart, selectionEnd
selectionStart = UBound(Split(Right(normalizedValue, Len(normalizedValue) - selectionStart), vbLf)) - inputRange.moveStart("character", -Len(element.value))
selectionEnd = Len(element.value)
If inputRange.compareEndPoints("EndToEnd", endRange) < 0 Then
selectionEnd = UBound(Split(Right(normalizedValue, Len(normalizedValue) - selectionEnd), vbCrLf)) - inputRange.moveEnd("character", -Len(element.value))
End If
GetSelectedText = Left(Right(element.value, Len(element.value) - selectionStart), selectionEnd - selectionStart)
Else
GetSelectedText = ""
End If
Else
GetSelectedText = ""
End If
End Function
Private Sub Run
Dim selected, code
selected = GetSelectedText(input)
code = selected
If IsEmpty(selected) Then
code = input.value
End If
If IsEmpty(Trim(code)) Then
Exit Sub
End If
ConsoleLog code, "lightblue"
Err.Clear
Execute code
If Err.Number <> 0 Then
Error "Error " & Err.Number & " at " & Err.Source & ": " & Err.Description
End If
End Sub
Private Sub InputKeyPress
If window.event.keyCode = 13 And window.event.shiftKey Then
Run
End If
End Sub
'Auto-detect the wizard's browser extensions
Private Function InWebWizard()
InWebWizard = TypeName(window.external) = "INewWDEvents"
End Function
Private Function InIE7()
InIE7 = InStr(navigator.userAgent, "MSIE 7.0")
End Function
Sub window_onload
With document
Set input = .getElementById("input")
Set output = .getElementById("output")
Set runButton = .getElementById("runButton")
Set clearButton = .getElementById("clearButton")
End With
runButton.onclick = GetRef("Run")
clearButton.onclick = GetRef("Clear")
input.onkeypress = GetRef("InputKeyPress")
If InWebWizard() Then
window.external.SetHeaderText "VBScript Console", "Explore this wizard's VBScript environment."
window.external.SetWizardButtons True, False, False
End If
'For some reason, IE 7 messes up the textarea's width and height
'pretty badly. We hardcode the height, removing a little margin,
'and add some margin to the output.
'Setting the input's width causes it to somehow divide itself by 2 on every keystroke.
If InIE7() Then
input.style.height = document.documentElement.clientHeight - 7 & "px"
output.style.marginLeft = "7px"
End If
End Sub
'The web wizard specification requires every page to have an OnBack procedure
Sub OnBack
If InWebWizard() Then
window.external.FinalBack
End If
End Sub