Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleMake a console application that checks for palindromes
DescriptionThis example shows how to make a console application that checks for palindromes in Visual Basic 6. It uses the AllocConsole API function to open a console window and then reads and writes to it.
Keywordsconsole, stdin, stdout, stderr
CategoriesSoftware Engineering, Windows
 
Thanks to Dipak Auddy.

This program starts from Sub Main. That routine uses the AllocConsole API function to open a console window. It uses the GetStdHandle API function to get handles to the console's StdIn, StdOut, and StdErr (standard input, standard output, and standard error).

Next the code sets the consoles attributes to display bright yellow text (red + green) on a blue background and prints Dipak's name.

Then in a loop the program displays white text on a black background, uses the ConsolePrint routine to display a prompt, and calls ConsoleRead to read the user's input. If the input is not an empty string, the program calls IsPalin to see if the text is a palindrome and displays the result. If the inupt is an empty string, the program exits its loop and calls FreeConsole to destroy the console window.

 
Private Sub Main()
    Dim szUserInput As String
    Dim Flag As Boolean
    
    AllocConsole 'Create a console instance
    
    SetConsoleTitle "VB Palindrome" 'Set the title on the
        ' console window
    'Get the console's handle
    hIn = GetStdHandle(STD_INPUT_HANDLE)
    hOut = GetStdHandle(STD_OUTPUT_HANDLE)
    hErr = GetStdHandle(STD_ERROR_HANDLE)
    
    'Print the prompt to the user. Use the vbCrLf to get to
    ' a new line.
    SetConsoleTextAttribute hOut, FOREGROUND_RED Or _
        FOREGROUND_GREEN Or FOREGROUND_INTENSITY Or _
        BACKGROUND_BLUE
    ConsolePrint "Search For Palindrome (C) Dipak Auddy." & _
        vbCrLf & vbCrLf
    Do
        SetConsoleTextAttribute hOut, FOREGROUND_RED Or _
            FOREGROUND_GREEN Or FOREGROUND_BLUE
        ConsolePrint vbCrLf & "Enter Word,Phrase or a " & _
            "Sentence[ENTER to Quit.]--> "
        'Get the user's input
        szUserInput = ConsoleRead()
        If Not szUserInput = vbNullString Then
            Flag = IsPalin(szUserInput)
            If Flag Then
                SetConsoleTextAttribute hOut, _
                    FOREGROUND_GREEN
                ConsolePrint szUserInput & " -- IS " & _
                    "PALINDROME." & vbCrLf
            Else
                SetConsoleTextAttribute hOut, FOREGROUND_RED
                ConsolePrint szUserInput & " -- IS NOT " & _
                    "PALINDROME." & vbCrLf
            End If
        Else
            ConsolePrint "Good Bye!"
            Exit Do
        End If
    Loop

    'Call ConsoleRead
    FreeConsole 'Destroy the console
End Sub
 
The ConsolePrint subroutine calls the WriteConsole API function to display a string in the console's standard output.

ConsoleRead calls the ReadConsole API function to get data from the console's standard input. It trims off the trailing null character and vbCrLf to make the result easier to use.

Finally, the IsPalin function determines whether a string is a palindrome (reads the same forwards and backwards).

 
Private Sub ConsolePrint(szOut As String)
    WriteConsole hOut, szOut, Len(szOut), vbNull, vbNull
End Sub

Private Function ConsoleRead() As String
    Dim sUserInput As String * 256
    Call ReadConsole(hIn, sUserInput, Len(sUserInput), _
        vbNull, vbNull)
    'Trim off the NULL charactors and the CRLF.
    ConsoleRead = Left$(sUserInput, InStr(sUserInput, _
        Chr$(0)) - 3)
End Function

Function IsPalin(ByVal TXT As String) As Boolean
Dim a As String

    'Remove Space(s) from user input and make it Upper Case
    TXT = UCase(Replace(TXT, " ", ""))

    a = StrReverse(TXT)

    If TXT = a Then
        IsPalin = True
    Else
        IsPalin = False
    End If
End Function
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated