Change CSCRIPT background and foreground colours 3

[JPJeffery]

In Batch files I could do

color 9f

to get white text on a bright blue background.

Is there an equivalent when running a .vbs with cscript?

JJ
[small][purple]Variables won't. Constants aren't[/purple][/small]

 

[dilettante]

I took a look at things and it isn't too hard to create an ActiveX DLL in VB5 or 6 to do what you wanted.

I'm not sure that it's useful to you though. You'd need to install the DLL and register it on any machine where you wanted to "color control" the console from a CScript. I didn't find anything built in.

Sample.vbs

Option Explicit
Dim CC
Set CC = CreateObject("Console.Control")
CC.Cls &H9F
With WScript.StdOut
  .WriteLine "Colorful example"
  .WriteLine
  CC.PenColor &H0C
  .WriteLine " Red   "
  CC.PenColor &H0F
  .WriteLine " White "
  CC.PenColor &H09
  .WriteLine " Blue  "
End With
CC.PenColor &H9F
Set CC = Nothing

Writing your scripts as .WSFs gives you a way to reference the typlib, making the color constants (Enum) available to the script.

Sample.wsf

<job>
  <reference object="Console.Control" />
  <object id="CC" progid="Console.Control" />
  <script language="VBScript">
    Option Explicit

    Dim YellowOnPurple, PurpleOnAqua, WhiteOnBlack

    Function AlignedVal(ByVal Val)
      AlignedVal = Right(Space(8) & CStr(Val), 9)
    End Function

    YellowOnPurple = ambFGGreen Or ambFGRed   Or ambFGBright _
                  Or ambBGBlue  Or ambBGRed
    PurpleOnAqua   = ambFGBlue  Or ambFGRed _
                  Or ambBGBlue  Or ambBGGreen Or ambBGBright
    WhiteOnBlack   = ambFGBlue  Or ambFGGreen Or ambFGRed

    CC.Cls YellowOnPurple
    With WScript.StdOut
      .WriteLine "Simple example with tabular output:"
      CC.PenColor PurpleOnAqua
      CC.Position 0, 3
      .Write " Column 1 "
      CC.Position 15
      .Write " Column 2 "
      CC.Position 30
      .Write " Column 3 "
      CC.PenColor YellowOnPurple
      CC.Position 0, 5

      Dim I

      For I = 1 To 10
        .Write AlignedVal(I)
        CC.Position 15
        .Write AlignedVal(2 * I)
        CC.Position 30
        .WriteLine AlignedVal(I * I)
      Next
      .WriteBlankLines 1

      .Write "<Enter>"
    End With
    WScript.StdIn.ReadLine
    CC.Cls WhiteOnBlack
  </script>
</job>

You'd need VB5 or 6 to create the DLL. Just open a new ActiveX DLL project, name the project "Console" and the class "Control" and then copy in the code here and compile it:

Control.cls

Option Explicit
'
'Console.Control
'===============
'
'A smaller "helper" class for CScripts, written in VB6.
'
'Provides console color control, screen clearing, and cursor
'positioning.
'
'The AttribMaskBits Enum is only available in scripts written as
'.WSF files that load the type library a <REFERENCE> XML tag.  A
'simple .VBS file must declare these as Const values or inline
'literals.
'

Public Enum AttribMaskBits
    ambFGBlue = 1
    ambFGGreen = 2
    ambFGRed = 4
    ambFGBright = 8
    ambBGBlue = 16
    ambBGGreen = 32
    ambBGRed = 64
    ambBGBright = 128
End Enum

Private Const MYNAME = "Console.Control"
Private Const STD_OUTPUT_HANDLE = -11
Private Const INVALID_HANDLE_VALUE = -1

Private Type COORD
    X As Integer
    Y As Integer
End Type

Private Type DWCOORD
    XY As Long
End Type

Private Type SMALL_RECT
    Left As Integer
    Top As Integer
    Right As Integer
    Bottom As Integer
End Type

Private Type CONSOLE_SCREEN_BUFFER_INFO
    dwSize As COORD
    dwCursorPosition As COORD
    wAttributes As Integer
    srWindow As SMALL_RECT
    dwMaximumWindowSize As COORD
End Type

Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long

Private Declare Function FillConsoleOutputAttribute Lib "kernel32" ( _
    ByVal hConsoleOutput As Long, _
    ByVal wAttribute As Integer, _
    ByVal nLength As Long, _
    ByVal dwWriteCoord As Long, _
    lpNumberOfAttrsWritten As Long) As Long

Private Declare Function FillConsoleOutputCharacter Lib "kernel32" _
    Alias "FillConsoleOutputCharacterA" ( _
    ByVal hConsoleOutput As Long, _
    ByVal cCharacter As Byte, _
    ByVal nLength As Long, _
    ByVal dwWriteCoord As Long, _
    lpNumberOfCharsWritten As Long) As Long

Private Declare Function GetConsoleScreenBufferInfo Lib "kernel32" ( _
    ByVal hConsoleOutput As Long, _
    lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO) As Long

Private Declare Function GetStdHandle Lib "kernel32" ( _
    ByVal nStdHandle As Long) As Long

Private Declare Function SetConsoleCursorPosition Lib "kernel32" ( _
    ByVal hConsoleOutput As Long, _
    ByVal dwCursorPosition As Long) As Long

Private Declare Function SetConsoleTextAttribute Lib "kernel32" ( _
    ByVal hConsoleOutput As Long, _
    ByVal wAttributes As Integer) As Long

Private m_hOutput As Long
Private m_crdHome As COORD
Private m_dwCrdHome As DWCOORD
Private m_csbi As CONSOLE_SCREEN_BUFFER_INFO
Private m_lngConSize As Long

Public Sub Cls(Optional ByVal AttribMask As Integer = -1)
    'Clears the console window, optionally changing the console
    'window colors and the PenColor to the value supplied for
    'AttribMask.
    Dim lngWritten As Long
    
    If FillConsoleOutputCharacter(m_hOutput, _
                                  AscB(" "), _
                                  m_lngConSize, _
                                  m_dwCrdHome.XY, _
                                  lngWritten) = 0 Then
        Err.Raise &H80045101, MYNAME, _
                  "FillConsoleOutputCharacter Error " _
                & CStr(Err.LastDllError)
    End If
    If SetConsoleCursorPosition(m_hOutput, m_dwCrdHome.XY) = 0 Then
        Err.Raise &H80045102, MYNAME, _
                  "SetConsoleCursorPosition Error " _
                & CStr(Err.LastDllError)
    End If
    If AttribMask <> -1 Then Color AttribMask
End Sub

Public Sub Color(Optional ByVal AttribMask As Integer = &H7)
    'Changes the console window colors and the PenColor to the
    'value supplied for AttribMask.  Default value is &H07
    '(dim white on black).
    Dim lngWritten As Long
    
    If FillConsoleOutputAttribute(m_hOutput, _
                                  AttribMask, _
                                  m_lngConSize, _
                                  m_dwCrdHome.XY, _
                                  lngWritten) = 0 Then
        Err.Raise &H80045103, MYNAME, _
                  "FillConsoleOutputAttribute Error " _
                & CStr(Err.LastDllError)
    End If
    PenColor AttribMask
End Sub

Public Sub PenColor(ByVal AttribMask As Integer)
    'Sets the "pen color" (colors used for subsequent input and
    'output) to the value supplied for AttribMask.
    
    SetConsoleTextAttribute m_hOutput, AttribMask
End Sub

Public Sub Position(ByVal Column As Integer, _
                    Optional ByVal Row As Integer = -1)
    'Move console window cursor to the specified column and optionally
    'row.  If Row is not specified use the current row.
    Dim crdNew As COORD
    Dim dwCrdNew As DWCOORD

    crdNew.X = Column
    If Row = -1 Then
        Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
        
        If GetConsoleScreenBufferInfo(m_hOutput, csbi) = 0 Then
            Err.Raise &H80045104, MYNAME, _
                    "GetConsoleScreenBufferInfo Error " _
                  & CStr(Err.LastDllError)
        End If
        crdNew.Y = csbi.dwCursorPosition.Y
    Else
        crdNew.Y = Row
    End If
    LSet dwCrdNew = crdNew
    If SetConsoleCursorPosition(m_hOutput, dwCrdNew.XY) = 0 Then
        Err.Raise &H80045102, MYNAME, _
                  "SetConsoleCursorPosition Error " _
                & CStr(Err.LastDllError)
    End If
End Sub

Private Sub Class_Initialize()
    m_hOutput = GetStdHandle(STD_OUTPUT_HANDLE)
    If m_hOutput = INVALID_HANDLE_VALUE Then
        Err.Raise &H80045105, MYNAME, _
                  "Invalid handle for StdOut.  Error " _
                & CStr(Err.LastDllError)
    End If
    If GetConsoleScreenBufferInfo(m_hOutput, m_csbi) = 0 Then
        Err.Raise &H80045104, MYNAME, _
                  "GetConsoleScreenBufferInfo Error " _
                & CStr(Err.LastDllError)
    End If
    m_lngConSize = m_csbi.dwSize.X * m_csbi.dwSize.Y
    m_crdHome.X = 0: m_crdHome.Y = 0
    LSet m_dwCrdHome = m_crdHome
End Sub

Private Sub Class_Terminate()
    CloseHandle m_hOutput
End Sub

As I said, not useful for your original purpose perhaps due to the deployment requirement. Maybe someone else might find it useful for creating more spiffy CScripts though.

It could be extended with additional console functions to provide scrolling regions, use a second console output buffer for the "colorful" operations, etc.