This file contains all of the code fragments in the wcCODE manual.

The wcCODE programming language is a very powerful tool and it should
be used with care and consideration. Some of the commands are quite
capable of deleting or damaging sections of the Wildcat! files and/or 
databases if used improperly.

This file can NOT be compiled due to the duplication of declared
variables and other such conflicts.

The code is provided to save you having to type in the examples.
You can simply cut from this file and paste into another in the IDE.

Each command is referenced at the beginning of the code fragment and
ends with a line of equal-signs and plus-signs.

You are free to use any of the code fragments in your programs without
royalties or fees to Mustang Software Inc.

The code fragments are supplied as-is and are not designed to specifically
interact with each other as part of a larger program.
The suitability to the task they used for and any results arising from 
that use is entirely the responsibility  of the user.




Rem  + (Concatenation) Operator
Rem FIRST EXAMPLE
Rem Concatenate both literals and variables

Dim FName As String, LName As String
Print "Enter your first name ";
Input FName
Print " Enter your last name ";
Input LName
FName = "Hello " + Trim(FName) + " " + Trim(LName)
Print FName
Rem End of the main program body

Rem SECOND EXAMPLE
  Rem Successive statements using the semicolon
Print "The @Code color system in @"; "21"; "@ living color"
  Rem Concatenated statements using the plus sign
Print "The @Code color system in @"+ "21"+ "@ living color"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem \ (Line-break) Instruction
Rem Breaking long source code lines with the backslash

Dim YourLongVariableName As String
Const ShorterVariable = "Phew!! "
YourLongVariableName = " the use of the backslash"
Print ShorterVariable; "Now this is really getting silly"+ \
  " just to show"; YourLongVariablename;
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ABS Function
Rem Two signed numbers with the same absolute value.

Dim IntA As Integer, IntB As Integer
IntA = +5 : IntB = -5
If Abs(IntA) = Abs(IntB) Then
  Print "IntA and IntB have the same absolute value"
  Print "And -5 multiplied by +5 appears positive! "; Abs(+5 * -5)
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ACTIVITYLOG Statement
Rem Adding your own data to the activity log

Sub TrackMyProgs
  Dim DT As DateTime, tStr As String
  CurrentDateTime DT
  tStr = "Program: " + ProgName + " "
  tStr = tStr + FormatDate(DT.D,"mm/dd/yy") + \
           FormatTime(DT.T," hh:mm")
  ActivityLog(tStr)
End Sub
TrackMyProgs
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ADDFILE Function
Rem Attempt to add a file to the database

Dim FRec As FileRecord, Ctr As Integer
Print "File name: "; : Input FRec.Name
Print "     Path: "; : Input FRec.StoredPath
For Ctr = 1 To 6
  Print "Keyword "; Ctr; " of 6 = ";
  Input FRec.KeyWords(Ctr)
  If FRec.KeyWords(Ctr) = "" Then Exit For
Next Ctr 
If FRec.Name + FRec.StoredPath + FRec.KeyWords(1) > "" Then
  If AddFile(FRec) Then
    Print "File added ok" 
  Else
    Print "AddFile error. File was not added!"
    Beep
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ADDMESSAGE Function
Rem Attempt to add a message to the database

Dim Msg As MessageHeader
Function FillMsg(MsgHd As MessageHeader) As Integer
  Dim Ok As Integer
  FillMsg = False : Rem Set a default value for the function
  Do
    DisplayPrompt(997) : Input MsgHd.From
    DisplayPrompt(990) : Input MsgHd.To
    DisplayPrompt(837) : Input MsgHd.Subject
    Ok = Trim(MsgHd.From + MsgHd.To + MsgHd.Subject) > ""
    If Not(Ok) Then
      If InputYesNo("Abort message ?") Then Exit Function
    End If
  Loop Until Ok
  FillMsg = True
End Function
Dim tStr As String
If FillMsg(Msg) Then
  Print "Message: ";
  Input tStr
  If tStr > "" Then AddMessage Msg, tStr
  Print "Message added"
Else
  Print "No message sent"
  WaitEnter
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ADDTIME Statement
Rem Change a caller's time left on line with AddTime

Const Tword = "sillyanswer"
Dim Aword As String, Ctr As Integer : Ctr = 0
Do
  Ctr = Ctr + 1
  Print "Try ["; Ctr; "] Enter access code ";
  Input AWord
  AWord = LCase(AWord)
  If AWord <> Tword Then
    AddTime - 10
  Else
    AddTime + 10
  End If
Loop Until (Ctr = 3) Or (AWord = TWord)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ADDUSER Function
Rem Add new data record to the user data base

Dim HotUser As UserRecord
Print "Enter the name of the new user ";
Input HotUser.Name
Print "Enter an alias if you use one ";
Input HotUser.Alias
If HotUser.Name > "" Then
  If AddUser(HotUser) Then
    Print "Name added ok"
    WaitEnter
  Else
    Print "Name was NOT added to the database!"
    WaitEnter
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem AND Operator
Rem Perform a bit-wise logical manipulation on integers

Dim IntA As Integer, IntB As Integer : IntA = 129 : IntB = 4
If (IntA And 127) = 1 Then
  Print "IntA when ANDed with 127 does equal "; (IntA And 127)
End If
If (IntA > 30) And (12 < 100) Then
  Print "Both must be true!"
End If
If (IntA = 129) And (IntB = 4) And (IntA > IntB) Then
  Print "All three conditions have been met"
End if
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ANSIDETECTED Function
Rem Display color at the caller's end if it is possible

If ANSIDetected Then
  Print Chr(27); "[32m This should be colorful"
Else
  Print "No ANSI colors possible"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ANSIENABLED Function
Rem Set a display file defaults as appropriate

Dim FileExt As String*3
If ANSIEnabled Then
  FileExt = "SCR"
Else
  FileExt = "BBS"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem APPEND Declaration
Rem Extend the data in your own tracking-file

Dim DT As DateTime
CurrentDateTime(DT)
Open "Tracking.LOG" For Append As #1
Print #1, "User: "; User.Name;
Print #1, "  When: "; FormatDate(DT.D,"mm/dd/yy  "); 
Print #1, FormatTime(DT.T,"HH:MM")
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ASC Function
Rem Capitalize the first letter in a name if in lower case

Dim tStr As String*45
Input "Enter your first name "; tStr
Rem Check to see if it is already capped
If (Asc(tStr) >= 97) And (Asc(tStr) <= 123) Then 
  tStr = Chr(Asc(Mid(tStr, 1, 1)) - 32) + \
        Mid(tStr, 2, Len(tStr) - 1)
End If
Print "Good afternoon "; tStr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ATLEN Function
Rem Check a file size, not including @Codes

Dim tStr As String, Ctr As Long
Open "HELP1.BBS" For Input As #1
While Not(EOF(1))
  Input #1, tStr
  Ctr = Ctr + AtLen(tStr)
Wend
Close #1
Print "The total character count for this file is "; Ctr; " bytes"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ATN Function
Rem Compute and display the value of pi.

Print "The value of pi is roughly "; 4*Atn(1)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem BAUDRATE function
Rem Keep track of high-speed modem users

Dim tStr As String
If BaudRate >= 9600 Then
  tStr = Str(BaudRate)
  Open "FastUser.LOG" For Append As #1
  Print #1, User.Name; " Logged at "; tStr
  Close #1
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem BEEP Statement
Rem Sound a warning on error.

Dim NameStr As String, TryCtr As Integer
TryCtr = 0
Do While (Len(NameStr) = 0) And (TryCtr < 3)
  Print "Enter your name "; : Input NameStr
  TryCtr = TryCtr + 1
  If TryCtr > 3 Then
    Print "Three strikes and you're out!"
    Beep : Chain "GetOff.WCX"
  End If
  If Len(NameStr) = 0 Then
    Print "You must enter your name here"
    Beep
  End If
Loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem BINARY Declaration
Rem Display the contents of a binary file 

Dim tByte As Byte, Ctr As Integer
Open "Wildcat.EXE" For Binary As #1
For Ctr = 1 To 256
  Get #1, Ctr, tByte
  If (Ctr > 1) And ((Ctr Mod 16) = 0) Then
    Print Right(Hex(tByte), 2)
  Else
    Print Right(Hex(tByte), 2); " ";
  End If
Next Ctr
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem BULLETIN Statement
Rem Display the mandatory bulletin

Print "Welcome. As  a new user you must at least read the "
Print "Rules and Manners bulletin."
GluttonForPunishment:
Bulletin 1
If InputYesNo("Read it again? ") Then
  GoTo GluttonForPunishment
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem BULLETINMENU Statement
Rem Present the caller with the Bulletin menu

If InputYesNo("Jump straight to the bulletins? ") Then
  BulletinMenu
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem BYTE Type
Rem Assign a Byte-variable a value.

Dim BigDeal As Byte, BiggerDeal As Integer
BigDeal = 205
Print "This Byte value is "; BigDeal
BiggerDeal = -400
BigDeal = BiggerDeal
Print "Now look at this for a Byte value "; BigDeal
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CALL Statement
Rem Set up a Sub and Call it without Call

Sub CapName(tStr As String)
  tStr = LCase(tStr)
  tStr = UCase(Left(tStr, 1)) + Mid(tStr, 2, Len(tStr) - 1)
End Sub

Dim TestName As String
Print "Please enter your first name "; : Input TestName
CapName((TestName)) : Rem The least ambiguous approach
Print "By value "; TestName
CapName TestName  : Rem Valid, but prone to oversight and confusion
Print "By reference "; TestName
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CALLERIDRESULT Function
Rem Store the caller's phone number in a file

Dim DT As DateTime, tStr As String
Open "Caller.LOG" For Append As #1
CurrentDateTime(DT)
tStr = "Caller: "
tStr = tStr + FormatDate(DT.D,"mm/dd/yy  ") + \
          FormatTime(DT.T,"hh:mmTE  ") + \
          CallerIdResult
Print #1, tStr
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CAPTURE Statement
Rem Turn Capture On if required

Dim CapOn As String*1
Print "Capture all data for the Sysop? "; : Input CapOn
  Rem You can use either Asc or direct a character 
  Rem as Asc(89) = the uppercase letter "Y"
If (Asc(CapOn) = 89) Or (CapOn = "y") Then
  Capture(On)    : Rem ASCII "Y" = 89
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CARRIER Function
Rem A basic shell for almost all communication.

CarrierCheck(Off) : Rem Let's do this ourselves
While Carrier = On  : Rem The '= On' is optional as 'On' is implied
  Rem The bulk of your program in here in case the user
  Rem drops carrier at their end or the line drops out.
Wend
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CARRIERCHECK Function
Rem The basis of an after logon, call-back system

Dim PhoneNum As String
PhoneNum = User.DataNumber
Print "Stand by, we will now call you back"
CarrierCheck Off : HangUp
Delay 10 : Rem Wait for things to settle
Send "ATZ" + Chr(13)
Send "ATDT " + PhoneNum + Chr(13)
Delay(30) : Rem Hopefully long enough to establish carrier
CarrierCheck On
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CASE Statement
Rem Get a transmission protocol from the caller.

Dim TransProt As String*1, Protocol As String*6
while Len(Protocol) = 0
  Print "Enter [Z]-ZModem  [K]-Kermit  [Q]-Quit (ZKQ) "; 
  Input TransProt
  Select Case UCase(TransProt) : Rem Force upper case
    Case "Z"
      Protocol = "ZModem"
    Case "K"
      Protocol = "Kermit"
    Case "Q"
      Protocol = "None"
    Case Else
      Print "That was not in the selection."
      Beep
  End Select
Wend
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CATCH Statement
Rem Use 'Catch' and 'Catch All' statements.
Rem Save this as 'ReadFile.WCC'. Compile and
Rem use it in 'Chain' example 

Sub OpenForInput(FNameStr As String, AllOk As Byte)
  AllOk = True : Rem Set this to TRUE just to start with
  Open FNameStr For Input As #1
  Catch Err_FileOpen
    Print "Could not find the file ["; FNameStr; "] to open"
    AllOk = False
End Sub

Dim FNameStr As String, DataStr As String, FileOk As Byte
Print "Read which file name "; : Input FNameStr
If Len(FNameStr) > 0 Then
  OpenForInput(FNameStr, FileOk)
  If FileOk Then
    While Not(EOF(1))
      Input #1, DataStr
      Print DataStr
    Wend
    Close #1
  Else
    Print "Halting as file "; FNameStr; " could not be read"
    Beep : Delay 3
  End If : Rem The file was opened successfully
End If : Rem A suitable length file name was supplied
Catch All
  Print "An undefined error occurred. Process halting."
  Delay 3 : Rem Show this message for 3 seconds
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CHAIN Statement
Rem Use ReadFile.WCX program defined in 'Catch'
Dim DoWhatStr As String*1
Rem The following is a label for the GoTo statement
RetryEntry:
Print "Enter [R]-Read file  [Q]-Quit to menu (RQ) ";
Input DoWhatStr
Select Case DoWhatStr : Rem Upper/lower covered next line
  Case "R", "r"
    Chain "ReadFile.WCX"
  Case "Q", "q"
    Print "Returning to the menu "; : Rem Leave cursor here
    Delay 10
  Case Else
    GoTo RetryEntry
End Select
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CHANGESETTINGS Statement
Rem Offer the caller the option of changing their settings

If InputYesNo("Change your default settings? ") Then
  ChangeSettings
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CHECKBULLETINS Statement
Rem A very basic logon program

QuoteOfTheDay
CheckNewsLetter
CheckBulletins
CheckMailAtLogon
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CHECKMAIL Statement
Rem A very basic logon program

QuoteOfTheDay
CheckNewsLetter
CheckBulletins
CheckMail
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CHECKMAILATLOGON Statement
Rem A very basic logon program

QuoteOfTheDay
CheckNewsLetter
CheckBulletins
CheckMailAtLogon
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CHECKNEWSLETTER Statement
Rem A very basic logon program

QuoteOfTheDay
CheckNewsLetter
CheckBulletins
CheckMailAtLogon
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CHR Function
Rem Force a user entered character to upper case

Dim YesSir As String*1
Print "Ready to Rock and Roll: "; : Input YesSir
If (Asc(YesSir) >= 97) And (Asc(YesSir) <= 122) Then
  YesSir = Chr(Asc(YesSir)-32)
End If
Print YesSir
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CLOSE Statement
Rem Open, Copy a text file and Close both

Dim tStr As String
Open "MyCopy.TXT" For Input As #1
Open "YourCopy.TXT" For Output As #2
While Not(EOF(1)) 
  Input #1, tStr : Print #2, tStr
Wend : Close #1 : Close #2
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CLREOL Statement
Rem Clear a line to print a prompt

Sub ShowPrompt(Row As Byte, Col As Byte, Prompt As String)
  Locate Row, Col
  ClrEOL
  Print Prompt;  : Rem Keep the cursor at the end
End Sub

Cls
Locate 23, 1
Print "This will not last long in this "+ \
    "position as it waits 2 seconds...";
Delay(2)
ShowPrompt(23,11,"NOW clear the line")
WaitEnter
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CLS Statement
Rem Clear the screen

Cls
Print "Starting on line one"
WaitEnter
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem COLOR Statement
Rem Display all the colors and their values

Dim FG As Integer, BG As Integer
Dim Row As Integer, Col As Integer
Col = 1
Cls
MorePrompt Off : Rem Stop Pause interfering
For FG = 0 To 15 : Rem Print a column of values
  Print FG
Next
For FG = 0 To 15
  Col = Col + 4 : Rem Position out to the next column
  Row = 0 : Rem Reset the Row position for each column 
  For BG = 0 To 15
    Row = Row + 1
    Color FG, BG
    Locate Row, Col
    Print FG
  Next BG
Next FG
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem COMMENT Statement
Rem Allow the user to leave a message

If InputYesNo("All finished for today? ") Then
  Comment
  If Not(Local) Then HangUp
Else
  If Not(Local) Then GoodBye
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CONST Statement
Rem Typical Constant declarations

Const LocalBBSName = "Wildcat Local 0220"
Const MaxCallers = 23, MaxMinOnline = 30, MinUpload = 45000
Const FuzzyBlock = Chr(176)
Dim YesSir As String*1
Print "Do you want to see our stats? (YN) ";
Input YesSir 
If (Asc(YesSir) >= 97) And (Asc(YesSir) <= 122) Then
  Print String(39, FuzzyBlock)
  Print "This board's name is ";LocalBBSName
  Print "---------------------------------------"
  Print "The maximum lines available is ";MaxCallers; "."
  Print "Each caller has ";MaxMinOnline; " minutes on-line."
  Print "There is a mandatory minimum upload of "; MinUpload; " bytes."
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem COPYFILE Function
Rem Copy a file across drives

If CopyFile("C:WCLIST.OUT", "D:\BAK\DATA\WCLIST.BAK") Then
  Print "File copied" 
Else
  Print "Copy failed"
  Beep
  WaitEnter
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem COS Function
Rem Print the Cosine of 1 Radian

Print Cos(1)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CSRLIN Function
Rem Store the cursor positions and step through the database

Dim NameRow As Integer, NameCol As Integer
Dim StateRow As Integer, StateCol As Integer
Dim uRec As UserRecord, uName As String
Print "User's name is    ";
NameRow = CsrLin
NameCol = Pos
Print "From the state of ";
StateRow = CsrLin
StateCol = Pos
Print
Rem Null string for user name will start at beginning
Print "Starting user name: ";
Input uName
If GetUser(uRec, uName) Then
  Do
    Locate NameRow, NameCol
    Print uRec.Name
    Locate StateRow, StateCol
    Print uRec.State
    If Not(InputYesNo("More...")) Then Exit Do
  Loop Until Not(GetNextUser(uRec))
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CURRENTDATE Statement
Rem Display today's date and format the display

Const DateMask = "Mm/dd/yyyy"
Dim Today As Date
CurrentDate(Today)
Print "Date: "; FormatDate(Today, DateMask)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CURRENTDATETIME Statement
Rem Get the current date and time and format the result

Const DateMask = "DD/mm/yyyy"
Dim TodayNow As DateTime
CurrentDateTime(TodayNow)
Print "Date: "; FormatDate(TodayNow.D, DateMask);
Print " Time: "; FormatTime(TodayNow.T, "HH:MM")
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem CURRENTTIME Statement
Rem Get the current time and format the output

Const TimeMask = "Hh:MM:Ss"
Dim TimeNow As Time
CurrentTime(TimeNow)
Print "Time: "; FormatTime(TimeNow, TimeMask)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DECLARE Statement
Rem A simple forward declaration function

Declare Function CapName(tStr As String) As String
Dim FName As String*30, LName As String*30
Dim Prompt(2) As String*5, Ctr As Integer
Prompt(1) = "first" : Prompt(2) = "last"
Ctr = 0
Do
  Ctr = Ctr + 1
  Print "Enter the "; Prompt(Ctr); " name of your favorite actor ";
  Select Case Ctr
  Case 1
    Input FName
  Case 2
    Input LName
  End Select
Loop Until Ctr = 2
Print "So "; CapName((FName)); " "; CapName((LName)); " eh?"

Function CapName(tStr As String) As String
  CapName = UCase(Left(tStr, 1)) + \
    LCase(Mid(tStr, 2, Len(tStr) - 1))
End Function
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DEFCOLOR Function
Rem Display colors and reset with DefColor

Const RedYellow = "@E4@", BlueWhite = "@F1@"
Print RedYellow + "Fried eggs and Ketchup"
Print BlueWhite;
Print "Sailors ahoy!"
Print DefColor; "Finally black to sanity."
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DEL Statement
Rem Attempt to delete the Test.DAT file

Const FName = "Test.DAT"
If Exists(FName) Then  : Rem First check to see if it is there
  Del(FName) 
Else
  Print "Could not find "; FName
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DELAY Statement
Rem Reset a Hayes type MODEM, then dial a number

Delay(3)      : Rem Get the attention of the Modem first
Send "+++"
Delay(3)
Send "ATZ" + Chr(13) : Rem Send a carriage return too
Delay(3.50)
Send "ATDT *70" + Chr(13) : Rem Turn Call-waiting on or off
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DELETEMESSAGE Statement
Rem Clean up the message area

Print "About to begin deleting messages."
Do While InputYesNo("Kill more? ")
  DeleteMessage
Loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DIM Statement
Rem Typically declare a few variables

Dim ByteA As Byte : Dim TestStrA As String
Dim ByteB As Byte, TestStrB As String*128
Dim IntA As Integer
Dim PayDayTotal as Real
Dim ZeroBaseArray(56) As Long    : Rem 0 to 56 subscripts
Dim MyArray(15 To 109) As String*64  : Rem 15 to 109 subscripts
For ByteA = 0 To 56
  ZeroBaseArray(ByteA) = ByteA * 6
Next
For ByteA = 0 To 56
  Print ByteA; " value of array = "; ZeroBaseArray(ByteA)
Next
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DISPLAYFILE Function
Rem Greet the caller

Dim Today As Date
Const DateMask = "dd/mm/yy"
CurrentDate(Today)
If User.BirthDate.Number = Today.Number Then
  If Not(DisplayFile("Birthday")) Then
    Print "Birthday file was not found!";
  End If : Rem DisplayFile failed
End If : Rem Birthday today
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DISPLAYGROUPFILES Statement 
Rem A very basic logon program

QuoteOfTheDay
CheckNewsLetter
CheckBulletins
CheckMailAtLogon
DisplayGroupFiles
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DISPLAYHELP Statement
Rem Display the help file to a caller

Dim FName As String
FName = "\WILDCAT\HELP\FaxHelp.BBS"
If Exists(FName) Then
  DisplayHelp FName 
Else
  Print "You failed to find help on the Fax feature"
  WaitEnter
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DISPLAYPROMPT Statement
Rem Add multilingual support by using Wildcat! prompts

Dim tRec As UserRecord
Print "New name to add to the database: ";
Input tRec.Name
If AddUser(tRec) Then 
  Print "New name added"
Else
  DisplayPrompt 67 : Rem Run program to see 67?
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DISPLAYSTOPPED Function
Rem Assume the file is a long text file

Const MaxCtr = 200
Dim Ctr As Integer, KeepGoing As Integer
Dim tStr As String
Open "LongText.TXT" For Input As #1 : Rem Assume it exists
KeepGoing = InputYesNo("Display large lumps at a time? ")
If KeepGoing Then MorePrompt Off
While Not(EOF(1))
  Ctr = Ctr + 1
  Input #1, tStr : Print DefColor; tStr
    Rem Check every so often if large lumps displayed
  If (KeepGoing) And (Ctr > MaxCtr) Then
    Ctr = 0
    Pause
    If DisplayStopped Then GoTo HadEnough
  End If
Wend
HadEnough:
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DISPLAYTEXTFILE Function
Rem Greet the caller

Dim Today As Date
Const DateMask = "mm/dd/yy"
Const FName = "\WILDCAT\LANGUAGE\Birthday.TXT"
CurrentDate(Today)
If User.BirthDate.Number = Today.Number Then
  if Exists(FName) Then
    DisplayTextFile(FName)
  Else
    Print "Birthday.TXT was not found"
  End If
End If : Rem Birthday today
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DO Statement
Rem A basic example of a Do ... Loop

Dim ByteA As Integer
Const WaitingStr = " I'm still here and working hard"
ByteA = 0
Do
  Print ByteA; WaitingStr
  ByteA = ByteA + 1
Loop Until ByteA > 10
Rem ByteA now equals eleven
Do While ByteA < 10
  Print "This will never be seen"
  ByteA = ByteA - 1
Loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DOOR Statement
Rem As part of a menu selection this could run a door

Door 1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DOORMENU Statement
Rem A very basic use of the DoorMenu command

DoorMenu
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DOSVERSION Function
Rem Determine if the DOS version is suitable

Function DosGreaterThan(LowestVer As Byte) As Integer
  Dim DVStr As String, DV As Integer
  DosGreaterThan = False
  DVStr = DosVersion
  DV = Val(Left(DVStr,Instr(DVStr,".") - 1))
  If DV < LowestVer Then
    Print "wcCODE requires DOS "; LowestVer; \
        ".xx or better. Your version is "; DVStr
  Else
    DosGreaterThan = True
  End If
End Function
If DosGreaterThan(5) Then : Rem Try 9 here too
  Print "This looks good already!"
Else
  Print "program ending"
  End
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem DOWNLOAD Statement
Rem Allow your program to control downloads

Dim tStr As String*1
Do
  Print "Press [D]..Download a file   [Q]..Quit back to menu ";
  Input tStr
  Select Case UCase(tStr)
    Case "D" 
      DownLoad
    Case "Q"
      End
  End Select
Loop : Rem No need for a condition as "Q" will end the loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem EDITMARKLIST Statement
Rem Process the marked list of files

If InputYesNo("Do you need to edit the list? ") Then
  EditMarkList
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ELSE & ELSEIF Statement
Rem Else and ElseIf used here to control partial If

Const MaxID = "SYSOP", MaxAcc = 20, SysPw = "TESTING"
Dim uID As String, uAcc As Integer, uPw As String
Print "Enter your ID please "; : Input uID
uID = UCase(uID)
Print "Enter your access level please "; : Input uAcc
Print "Enter your access level "; uAcc; " password ";
Input uPw : uPw = UCase(uPw)
If (uID = MaxID) And (uAcc = MaxAcc) And (uPw = SysPw) Then
  Print "Access to all areas is valid for unlimited time."
ElseIf (uID = MaxID) And (uAcc = MaxAcc) Then
  Print "Access is limited to Browse for 6 minutes."
Else
  Print "Access is denied with those access levels."
  Beep
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ENCODEPASSWORD Function
Rem You must encode a password before updating

Dim tStr1 As String, tStr2 As String, uRec As UserRecord
Do
  Print "Password ";
  Input tStr1
  tStr1 = EncodePassword(tStr1)
  Print "Verify ";
  Input tStr2
  tStr2 = EncodePassword(tStr2)
  If tStr1 <> tStr2 Then
    Print "Passwords did not verify. Please re-do"
    Beep
  End If
Loop Until tStr1 = tStr2
uRec.Password = tStr1
AddUser uRec : Rem Assume uRec was filled in before password
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem END Statement
Rem Force the termination of the wcCODE program

Dim Ctr As Integer, PwStr As String*5
For Ctr = 1 To 3
  Print "Enter your password "; Ctr; ": ";
  Input PwStr
  If UCase(PwStr) <> "SYSOP" Then
    End : Rem Terminate the process right now!
  End If
Next Ctr
Print "Ok so far so good"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ENTERMESSAGE Statement
Rem Your program can process messages

Print "You are about to leave the RIP conference."
If InputYesNo("Add a message before leaving? ") Then
  EnterMessage
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ENVIRON Function
Rem Display the DOS path string

Dim EnvStr As String
Print "Options are: COMSPEC, PATH, PROMPT ";
Input EnvStr
EnvStr = UCase(EnvStr)
Select Case EnvStr
  Case "COMSPEC", "PATH", "PROMPT"
    Print "The "; EnvStr; "environment variable = ";
    Print Environ(EnvStr)
  Case Else
    Print "Invalid environment variable "; EnvStr
End Select
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem EOF Function
Rem Print the entire contents of a text file

Dim InputStr As String
Open "Test.DAT" For Input As #1 : Rem Assume it exists
Do While Not EOF(1)
  Input #1, InputStr
  Print InputStr
Loop
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem EQV Operator
Rem A demonstration of the Boolean operator

Dim i As Integer, j As Integer, k As Integer
i = 10 : j = 8 : k = 6
If i > j Eqv j > k Then : Rem Same as below!
  Print "Yup, i is greater than j and j is also greater than k"
End If
i = 6 : j = 8 : k = 10
If i > j Eqv j > k Then : Rem Same as above!
  Print "But, i is LESS than j and j is also LESS than k"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem ERROR Statement
Rem Catch a file error

Sub UserCode(AllOk As Byte)
  Dim tStr As String, Ctr As Integer
  Const Err_NoGoJoe = 21
  Ctr = 0
  AllOk = 99 : Rem Get ready for a good exit
  While (tStr = "" ) And (Ctr < 4)
    Ctr = Ctr + 1
    Print "Enter your user code ";
    Input tStr
  Wend
  If (Ctr > 3) And (UCase(tStr) <> "SUCCESS") Then
    Error(Err_NoGoJoe)
  End If
  Catch Err_NoGoJoe 
    Print "Bye bye. It's back to the menu for you!"
    Delay(3)
    AllOk = 0
End Sub

Dim Ok As Byte
UserCode(Ok)
If (Ok < 1) Then
  End : Rem Dump the user back to the menu
Else
  Print "Quite acceptable!"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem EXISTS Function
Rem Check for a file to prevent an opening error

Function OpenFile(FName As String) As Integer
  OpenFile = True : Rem Assume the best
  If Exists(FName) Then
    Open FName For Input As #1
  Else
    OpenFile = False
  End If
  Catch Err_FileOpen
    OpenFile = False
End Function      : Rem Assume file exists
Dim tStr As String : Const tFName = "TestData.TXT"
If OpenFile(tFName) Then
  While Not(EOF(1))
    Input #1, tStr
    Print tStr
  Wend
Else
  Print "Error trying to open the file, wait. ";
  Delay(3)
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem EXIT Statement
Rem Get out of a function early

Function IncToMax(ByteA As Byte, MaxByte As Byte) As Integer
  IncToMax = False  : Rem Just in case we have to quit early
  If (ByteA + 1) > MaxByte Then
    Exit Function
  Else 
    ByteA = ByteA + 1
    IncToMax = True
  End If
End Function

Dim Ctr As Byte, Row As Integer, Col As Integer
Dim Key As String
Const MaxCtr = 20
Ctr = 0
Row = CsrLin : Col = Pos
Do While IncToMax(Ctr,MaxCtr)
  Locate Row, Col
  Print "You have until the counter equals "; MaxCtr;
  Print " Now at "; Ctr
  Delay 0.5
  Key = Inkey : Rem Any keystrokes pending?
  If Key > "" Then Exit Do
Loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem EXP Function
Rem Compute the square of the natural Logarithm base (e)

Print Exp(2)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FASTLOGON Function
Rem Determine the caller's logon method

Dim AllowShortCuts As Integer
AllowShortCuts = False
If FastLogon Then
  AllowShortCuts = True
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FILEINFO Statement
Rem Having selected a file, display extended description

FileInfo
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FILESTATS Statement
Rem Display the file statistics

FileStats
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FINDFIRST Function
Rem Display all of the available files with a .TXT extension

Dim SRec As SearchRec, FileFound As Integer
Const FileMask = "D:\Wildcat\MSG\TXTDATA\*.TXT"
FileFound = FindFirst(FileMask,0,SRec)
Do While FileFound = 0
  Print SRec.Name; "  ";
  Print SRec.Size; "  "
  FileFound = FindNext(SRec)
Loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FINDNEXT Function
Rem Delete unwanted .MSG files

Function YesNo(Prompt As String) As Integer
Dim Key As String*1
  Print Prompt;
  Do
    Key = Inkey
  Loop until Key <> ""
  YesNo = UCase(Key) = "Y"
End Function

Dim SRec As SearchRec, FileFound As Integer
FileFound = FindFirst("*.MSG",0,SRec)
Do While FileFound = 0
  Print SRec.Name;
  If YesNo(" Delete (YN) ") Then
    Del SRec.Name
  End If
  Print
  FileFound = FindNext(SRec)
Loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FIX Function
Rem Fix and Int examples

Print "Fix(3.7) = "; Fix(3.7)
Print "Int(3.7) = "; Int(3.7)
Print "Fix(-4.9) = "; Fix(-4.9)
Print "Int(-4.9) = "; Int(-4.9)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FOR Statement
Rem Display a count-down timer

Dim Ctr As Integer, Row As Integer, Col As Integer
Dim Dot As Integer
Print "Waiting for keyboard response : ";
Row = CsrLin : Col = Pos
For Ctr = 30 To 1 Step -1
  Locate Row, Col
  Print Ctr; " "; : Rem Stomp on extra digit when we get below 10
  For Dot = 1 To 10
    Print ".";
    Delay 0.1
    If InKey > "" Then
      Dot = 99
      Exit For : Rem Exit the Dot's For-Next
    End If
  Next Dot
  If Dot = 99 Then Exit For : Rem Exit the Ctr's For-Next
  Locate Row, Col
Next Ctr
If (Dot < 99) Or (Ctr = 0) Then Print "Timed out"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FORMATDATE Function
Rem Different demos of the Format feature

Dim tDate As Date, tTime As Time, tDateTime As DateTime
Dim tStr As String
CurrentTime(tTime)
CurrentDate(tDate)
CurrentDateTime(tDateTime)
Print FormatTime(tTime, "hh:mm:ss"),
Print FormatDate(tDate, "dd/mm/yyyy")
Print FormatTime(tDateTime.T, "hh:mm"),
Print FormatDate(tDateTime.D, "dd/mm/yy")
tStr = "The time is now : " + \
    FormatTime(tDateTime.T, "hh:MM:SS")
Print tStr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FORMATTIME Function
Rem Different demos of the Format feature

Dim tDate As Date, tTime As Time, tDateTime As DateTime
Dim tStr As String
CurrentTime(tTime)
CurrentDate(tDate)
CurrentDateTime(tDateTime)
Print FormatTime(tTime, "hh:mm:sst"),
Print FormatDate(tDate, "dd/mm/yyyy")
Print FormatTime(tDateTime.T, "hh:mmte"),
Print FormatDate(tDateTime.D, "dd/mm/yy")
tStr = "The time is now : " + \
    FormatTime(tDateTime.T, "hh:MM:SS")
Print tStr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FREEFILE Function
Rem Make a copy of a text file
Sub ExitNoFiles
  Print "No more files available. Halting!"
  Delay(3)
  Reset
  End : Rem Make a swift and abrupt halt here
End Sub
Dim InputFile As Integer, OutputFile As Integer, tStr As String
InputFile = FreeFile
If InputFile > 0 Then : Rem Assume file exists
  Open "Message.TXT" For Input As #InputFile
Else ExitNoFiles
End If
OutputFile = FreeFile
If OutputFile > 0 Then
  Open "CopyMsg.TXT" For Output As #OutputFile
Else ExitNoFiles
End If
While Not(EOF(InputFile))
  Input #InputFile, tStr
  Print #OutputFile, tStr
Wend
Close #InputFile
Close #OutputFile
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem FUNCTION Statement
Rem Define functions and demo the Static declaration

Function QuickExit(IntA As Integer) As Integer
  QuickExit = False : Rem Set the most likely result
  If InputYesNo("Counter = " + Str(IntA) + " exit anyway? ") Then
    QuickExit = True
  End If
End Function
Function CapName(tStr As String, TimesUsed As Integer) As String
  Dim CapStr As String
  Static NamesCapped As Integer
  CapStr = LCase(tStr) : Rem Copy to not change the original
  CapName = UCase(Left(CapStr,1)) + Mid(CapStr,2,Len(CapStr)-1)
  NamesCapped = NamesCapped + 1
  TimesUsed = NamesCapped
End Function

Dim NameStr As String, Ctr As Integer
Ctr = 0 : Rem Not needed, but on the subject of good practice!
While Ctr < 3
  Print "Enter your name "; : Input NameStr
  Print "Hello "; CapName(NameStr,Ctr)
  Print "The Function CapName has now been used "; Ctr; " times"
  If QuickExit(Ctr) Then End
Wend
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GET Statement
Rem Assume 'Records.DAT' exists with 'UserRec' structure and data

Type UserRec
  Name As String*30
  Alias As String*30
  LastDate As String*8
  TimesCalled As Integer
End Type
Dim DataF As Integer, URec As UserRec
DataF = FreeFile      : Rem Assume file exists
Open "Records.DAT" For Random As #DataF Len = Len(UserRec)
While Not(EOF(DataF))
  Get #DataF,, Urec  : Rem Step sequentially from
  Print LeftPad(URec.Name,32); LeftPad(URec.Name,32);
  Print LeftPad(URec.LastDate,10); URec.TimesCalled
Wend
Close #DataF
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETCOLOR Function
Rem Demonstrate a range of colors using @Codes

Const RedYellow = "@E4@"
Const BlueWhite = "@F1@"
Dim HexVal As String
Print RedYellow + "Fried eggs and Ketchup"
Print BlueWhite; : Print "Sailors ahoy!"
HexVal = Right(Hex(GetColor),2)
Print "We are printing in @"; HexVal; "@ color at the moment."
Print DefColor; "Finally black to sanity."
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETCONFINFO Function
Rem Attempt to retrieve a conference record

Dim tConfRec As ConfRecord, tConfNum As Integer
tConfNum = InputNumber("Conference number:", 0, \
          MakeWild.MaxConfAreas -1)
If GetConfInfo(tConfRec, tConfNum) Then
  Print "This conference is "; tConfRec.Name
Else
  Print "Conference request error!"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETFILEAREA Function
Rem List all files from a start point in the database

Dim fRec As FileRecord, tStr As String
Print "Starting file to retrieve. [Quit to exit] : ";
Input tStr
If UCase(tStr) <> "QUIT" Then
  If GetFileInfo(fRec, tStr) Then
    Do
      Print "       File: "; fRec.Name
      Print "Description: "; fRec.Description
    Loop Until Not(GetNextFile(fRec))
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETMESSAGE Function
Rem Retrieve a known message number

Dim Msg As MessageHeader, tInt As Integer
tInt = InputNumber("Message number: (9999 to Quit) ",0,9999)
If tInt <> 9999 Then
  If GetMessage(Msg, tInt) Then
    Print "Subject: "; Msg.Subject
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETMESSAGETEXT Function
Rem Read and display the message text for a given message number

Dim MsgNum As Integer, tStr As String
Const FName = "TempFile.TXT"
Print "Message to view: "; 
Input MsgNum
If GetMessageText(MsgNum, TempPath+ FName) Then
  Open TempPath+ FName For Input As #1
  While Not EOF(1)
    Input #1, tStr
    Print tStr
  Wend
  Close #1
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETNEXTFILE Function
Rem List all files from a start point in the database

Dim fRec As FileRecord, tStr As String
Print "File header to retrieve. [Quit to exit] : ";
Input tStr
If UCase(tStr) <> "QUIT" Then
  If GetFileInfo(fRec, tStr) Then
    Do
      Print "       File: "; fRec.Name
      Print "Description: "; fRec.Description
    Loop Until Not(GetNextFile(fRec))
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETNEXTMESSAGE Function
Rem Display the subject heading for this conference

Dim Msg As MessageHeader, tInt As Integer
tInt = InputNumber("Message number: (9999 to Quit) ",0,9999)
If tInt <> 9999 Then
  If GetMessage(Msg, tInt) Then
    Do
      Print "Subject: "; Msg.Subject
    Loop Until Not GetNextMessage(Msg)
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETNEXTUSER Function
Rem Starting from a known position display all users

Dim UserRec As UserRecord, tStr As String
Rem A tStr = "" will start at the beginning of database
Print "Starting user name [Quit to exit] : "; 
Input tStr
If UCase(tStr) <> "QUIT" Then
  If GetUser(UserRec, tStr) Then
    Do
      Print "Name: "; UserRec.Name; Tab(30); UserRec.From
    Loop Until Not GetNextUser(UserRec)
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETNODEINFO Statement
Rem Step through the nodes, display security profiles

Dim nRec As NodeInfoRecord, NodeNum As Integer
Do
  NodeNum = InputNumber("Node: (999 = Quit) ", 0, 999)
  If NodeNum <> 999 Then
    GetNodeInfo nRec, NodeNum
    Print "Node "; NodeNum; " Security "; nRec.Security
  End If
Loop Until NodeNum = 999
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETSECPROFILE Function
Rem Retrieve a security profile and display the results

Dim sRec As SecurityProfile
If GetSecProfile(sRec, "SYSOP") Then
  Print "Name: "; SRec.Name
  Print "Expired name: "; sRec.ExpiredName
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GETUSER Function
Rem Display information on a single user

Dim UserRec As UserRecord, tStr As String
Print "User name [Quit to exit] : "; : Input tStr
If UCase(tStr) <> "QUIT" Then
  If GetUser(UserRec, tStr) Then
    Print "Name: "; UserRec.Name; Tab(30); UserRec.From
  Else
    Print "User name ["; UCase(tStr); "] was not found"
    Beep
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GOODBYE Statement
Rem Gently logoff the caller

GoodBye
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GOSUB Statement
Rem Branching forward/backwards with the GoSub/GoTo

Print "I should always use Sub and Function for branching"
GoSub BadMove
Print "Progam now terminating with the End statement"
End
Rem End of the main program body

BadMove:
  Dim YesSir As String*1
  Print "Do you want to see more of this ";
  Input YesSir
  If UCase(YesSir) = "N" Then 
    Return 
  Else 
    GoTo BadMove
  End If
Rem No Return needed here as the If statement takes care of it
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem GOTO Statement
Rem Branching forward/backwards with the GoSub/GoTo

Print "I should always use Sub and Function for branching"
GoSub BadMove
Print "Progam now terminating with the End statement"
End
Rem End of the main program body

BadMove:
  Dim YesSir As String*1
  Print "Do you want to see more of this ";
  Input YesSir
  If UCase(YesSir) = "N" Then 
    Return Else GoTo BadMove
  End If
Rem No Return needed here as the If statement takes care of it
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem HANGUP Statement
Rem Hang up if incorrect password tried

Dim Ctr As Integer, PWordOk As Integer, PWordStr As String
Do
  Ctr = Ctr + 1
  Print "Enter your password ";
  Input PWordStr
  PWordOk = (UCase(PWordStr) = "SYSOP")
Loop Until (Ctr > 3) Or (PWordOK)
If Ctr > 3 Then
  Print "Illegal access attempted."
  If Not(Local) Then HangUp
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem HELLOFILES Statement
Rem Greet caller with Hello files, then questionnaire #1

HelloFiles
Questionnaire 1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem HELPLEVEL Statement
Rem Allow the user to reset the Help level

If InputYesNo("Tired of cryptic menus? ") Then 
  HelpLevel
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem HEX Function
Rem Demo the use of Hex
Dim HexStr As String : HexStr = Hex(90210)
Print "Hollywood hits hex = "; HexStr
Print "Doing decimal deal = "; Val("$"+HexStr)
Print "The Hex value of 123 is "; Right(Hex(123),2)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem IF Statement
Rem Demonstrate If, Then, Else and ElseIf

Dim NameStr As String, DOB As String
Dim TodayStr As String, Today As Date
Print "Enter your name "; : Input NameStr
Do
  Print "Enter your DOB (mm/dd) "; : Input DOB
Loop Until Len(DOB) = 5
CurrentDate Today
TodayStr = FormatDate(Today, "mm/dd")
If Instr(DOB, TodayStr) = 1 Then
  Print "Happy birthday "; NameStr
ElseIf Instr(DOB,Left(TodayStr,2)) = 1 Then
  Print "Well "; NameStr; " at least it's this month."
Else
  Print "Patience is a game and a virtue "; NameStr
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem IMP Operator
Rem Bitwise implication example

Dim IntA As Integer, IntB As Integer
IntA = 25
IntB = 31
Print "The implication here is "; IntA Imp IntB
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INCOMM Function
Rem Read data from the comm port

Dim tStr As String, KeyIn As String*1
Dim TimeOut As Integer, TimeHolder As Real
tStr = ""
Do
  TimeHolder = Timer + 3
  Do
    KeyIn = InComm
    TimeOut = (Timer = TimeHolder)
  Loop Until (KeyIn > "") Or (TimeOut)
  If TimeOut Then Exit Do
  If KeyIn <> Chr(13) Then
    tStr = tStr + KeyIn
  End If
Loop Until KeyIn = Chr(13)
If TimeOut Then
  Print "Timed out waiting on comm port"
Else
  Print "Received: "; tStr
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem $INCLUDE Directive
Rem MyProg.WCC - This is the main program file

Rem Include standard utility files
'$Include "MyUtils.WCC"

Dim NameStr As String
Input "Enter your first name "; NameStr
Print "Hi "; CapName(NameStr)
Rem End of the main program body

Rem Save as MyUtils.WCC - This file will be included

Function CapName(tNameStr As String) As String
  Dim TempStr As String
  TempStr = LCase(tNameStr) : Rem first convert to all lower case
  tNameStr = UCase(Mid(TempStr, 1, 1))
  tNameStr = tNameStr + Mid(TempStr, 2, Len(TempStr) - 1)
  CapName = tNameStr
End Function
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INDEXADD Statement
Rem Assume the datafile exists

Dim tStr as String, Ctr As Long, tRec As UserRecord
Open "TestData.DAT" For Random As #1 Len = Len(UserRecord)
IndexOpen("TestData.IDX")
While Not(EOF(1)) 
  Ctr = Ctr + 1
  Get #1, Ctr, tRec
  tStr = Trim(tRec.Zip)
  IndexAdd(tStr, Ctr)
Wend
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INDEXCLOSE Statement
Rem Integral part of the Indexing system

IndexClose : Rem Declares no error if no index open
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INDEXLOOKUP Function
Rem Assume the data and index files already exist

Dim tStr1 As String, RecPos As Long
Dim tStr2 As Sting, tRec As UserRecord
tStr1 = "WIL"
Open "Testdata.DAT" For Random as #1 Len = Len(UserRecord)
IndexOpen("TestData.IDX")
tStr2 = IndexLookUp(tStr1)
If tStr1 = tStr2 Then : Rem Retrieve only exact matches
  Do
    RecPos = IndexNextRef   
    If RecPos <> -1 Then
      Get #1, RecPos, tRec
      Print tRec.Name, tRec.Zip
    End If
  Loop Until RecPos = -1
End If
Close #1
IndexClose
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INDEXNEXTKEY Function
Rem Assume the index and data already exist

Dim tStr1 As String, rPos As Long, uRec As UserRecord
tStr1 = "WILD"
Open "TestData.DAT" For Random As #1 len = Len(UserRecord)
IndexOpen("TestData.IDX")
If Instr(IndexLookUp(tStr1),tStr1) <> 0 Then
  While tStr1 <> ""
    Do
      rPos = IndexNextRef
      If rPos <> -1 Then
        Get #1, rPos, uRec
        Print "Found "; uRec.Name
      End If
    Loop Until rPos = -1
    tStr1 = IndexNextKey
  Wend
End If
Close #1 : IndexClose
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INDEXNEXTREF Function
Rem Assume Index and data file exist

Dim tStr As String, Ctr As Integer
Dim RecPos As Long, tRec As UserRecord
Open "Testdata.DAT" For Random As #1 Len = Len(UserRecord)
IndexOpen("TestData.IDX") : Ctr = 1
Do
  tStr = Chr(Ctr + 65) : Rem a full alphabetical search
  tStr = IndexLookUp(tStr)
  While tStr > ""
    Do
      RecPos = IndexNextRef
      If RecPos > -1 Then
        Get #1, RecPos, tRec
      End If
    Loop Until RecPos = -1
    tStr = IndexNextKey : Rem More keys left?
  Wend
  Ctr = Ctr + 1
Loop Until Ctr = 26
Close #1 : IndexClose
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INDEXOPEN Function
Rem Function to open an index with a correct file extension

Function OpenIndex(FName As String) As Integer
  Dim tFName As String
  Const IdxExt = ".IDX"
  tFName = UCase(FName)
  If  (Instr(tFName, IdxExt) = 0) And \
     (Instr(tFName, ".") = 0) Then
      tFName = tFName + IdxExt
      OpenIndex = IndexOpen(tFName)
  End If
End Function
If OpenIndex("TestFile") Then
  Rem Plug in your indexed processing code here
Else
  Print "Could not open the index file"
  Beep
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INDEXQUERY Function
Rem Retrieve keys with BBS and GOOD, but not MAJOR in them

Dim RecPos as Long, tRec As UserRecord
Open "Testdata.DAT" For Random As #1 Len = Len(UserRecord)
IndexOpen("TestData.IDX")
If IndexQuery("BBS And GOOD And Not MAJOR") Then
  Do
    RecPos = IndexQueryNext
    If RecPos <> -1 Then
      Get #1, RecPos, tRec
      Print "User "; tRec.name
    End If
  Loop Until RecPos = -1
End If
Close
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INDEXQUERYNEXT Function
Rem Retrieve keys with BBS and GOOD, but not MAJOR in them

Dim RecPos as Long, tRec As UserRecord
Open "Testdata.DAT" For Random As #1 Len = Len(UserRecord)
IndexOpen("TestData.IDX")
If IndexQuery("BBS And GOOD And Not MAJOR") Then
  Do
    RecPos = IndexQueryNext
    If RecPos <> -1 Then
      Get #1, RecPos, tRec
      Print "User "; tRec.name
    End If
  Loop Until RecPos = -1
End If
Close
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INKEY Function
Rem Make a response file and then use it with Inkey

Open "Inkey.TXT" For Output As #1
Print #1, "YNM";
Close
Open "Inkey.TXT" For Input As #1
Dim Key As String, Prompt(3) As String
Prompt(1) = "Yes "
Prompt(2) = "No "
Prompt(3) = "Maybe "
Dim Ctr As Integer
Ctr = 0
While Not(EOF(1))
  Key = Inkey(1)
  Ctr = Ctr + 1
  Print Prompt(Ctr); Key
Wend
Close #1
Print "Happy with the results? (YN) ";
Do
  Key = UCase(Inkey)
Loop Until Instr("YN",Key) > 0
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INPUT Declaration
Rem Display the contents of a file

Dim tStr As String
Open "Birthday.TXT" For Input As #1
While Not(EOF(1))
  Input #1, tStr
  Print tStr
Wend
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INPUT Statement
Rem Read the keyboard and a file

Dim StrA As String
Print "Enter your access code "; 
Input StrA
If UCase(StrA) <> "SYSOP" Then End
Open "Comments.DAT" For Input As #1 : Rem Assume file exists
While Not(EOF(1)) 
  Input #1, StrA
  Print StrA
Wend
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INPUTMASK Function
Rem Get several formatted strings from the caller

Dim SSNStr As String*11, PhoneStr As String*14
SSNStr = InputMask("Your Social Security # ","999-99-9999")
PhoneStr = InputMask("Your home phone # ","(999) 999-9999")
Print "Thank you for SSN "; SSNStr; " and "; PhoneStr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INPUTNUMBER Function
Rem Get a number in a specified range from the caller
Rem Let Wildcat! take care of the range checking

Dim Answer As Integer, RandNum As Integer
Do
  Answer = InputNumber("Enter a number between 7 and 23 ",7,23)
  RandNum = ((Rnd * 100) Mod 16) + 7
  If RandNum = Answer Then
    Print "Great your time has just been bumped by "; Answer
    AddTime Answer
  ElseIf (RandNum + 1) = Answer Or (RandNum - 1) = Answer Then
    Print "Close, and a little time has been added."
    AddTime Answer \ 2
  Else
    Print "Ooops not even close. Time reduced"
    AddTime -2
  End If
  Print "Time left online: "; TimeLeft
Loop Until Answer = 23
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INPUTYESNO Function
Rem InputYesNo automatically uses YesChar/NoChar

Dim FName As String
Print "Enter the file name to read ";
Input FName
If Exists(FName) Then
  If InputYesNo("Ready to read the text file ") Then
   DisplayTextFile(FName)
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INSTR Function
Rem Identify several occurrences of a sub-string

Dim fPos As Integer
Const tStr = "The moving finger writes, and having writ moves on"
Const sStr = "VING"
fPos = 0 : Rem We need to start somewhere
Print tStr
Do
  fPos = Instr(fPos + 1, UCase(tStr), sStr)
  if fPos > 0 Then
    Locate CsrLin, fPos
    Print Mid(tStr,fPos,Len(sStr));
  End If
Loop until fPos = 0
Print
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INT Function
Rem Fix and Int examples

Dim RealA As Real, IntA As Integer
RealA = 123.456789
IntA = Int(RealA / 13)
Print "RealA divided by 13 = "; IntA;
Print " plus "; Int(RealA) - (IntA * 13); " over"
Print "We could also use Mod "; IntA;
Print " plus "; Int(RealA) Mod 13; " over"
Print
Print "Fix(3.7) = "; Fix(3.7)
Print "Int(3.7) = "; Int(3.7)
Print "Fix(-4.9) = "; Fix(-4.9)
Print "Int(-4.9) = "; Int(-4.9)
Rem This will return 3 and -4 for Fix and 3 and -5 for Int.
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem INTEGER Type
Rem Rudimentary integer declaration

Dim IntA As Integer
IntA = 123
Print "This integer currently equals "; IntA
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem JOIN Statement
Rem Join any valid conference

Dim KeyIn As String*1
Const MenuName = "TECH SUPPORT:"
Print
Print MenuName
Print "[Q]-QModem tech support conference"
Print "[W]-Wildcat tech support conference"
Print "[X]-Exit back to menu"
Print
Print MenuName; " [Q W X] ? ";
Do
  Input KeyIn
Loop Until Instr("QWX",UCase(KeyIn)) > 0
Select Case KeyIn
  Case "Q", "q"
    Join 54 : Rem This conference must exist
  Case "W", "w"
    Join 27 : Rem This conference must exist
  Case Else
     End
End Select
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem KILL Statement
Rem Attempt to delete the Test.DAT file

Const FName = "Test.DAT"
If Exists(FName) Then  : Rem First check to see if it is there
  Kill(FName) 
Else
  Print "Could not find "; FName
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LCASE Function
Rem Capitalize a name

Dim NameStr As String
Print "Enter your first name please ";
Input NameStr
NameStr = LCase(NameStr)
NameStr = UCase(Left(NameStr,1)) + Mid(NameStr,2,Len(NameStr)-1)
Print "G'day "; NameStr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LEFT Function
Rem A Token function, antithesis to one in Right(Str,Num)

Function BeforeChar(TargetCh As String, SearchStr As String) As String
  Dim JunkStr As String
  Rem Add TargetCh to SearchStr just in case there is none
  JunkStr = Left(SearchStr, Instr(SearchStr + \
          TargetCh, TargetCh)-1)
  BeforeChar = JunkStr
End Function

Const ShortStr = "The Wildcat & other bedside stories"
Print ShortStr
Print BeforeChar("&",ShortStr)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LEFTPAD Function
Rem Display a menu in uniform columns

Const MenuWid = 25
Function Dots(Prompt As String, Desc As String) As String
  Dim tStr As String*1, tDesc As String
  If Prompt = "" Then
    tStr = UCase(Left(Desc,1))
    tDesc = tStr + Mid(Desc,2,Len(Desc) - 1)
  Else
    tStr = UCase(Prompt)
    tDesc = Desc
  End If
  Dots = "[" + tStr + "]" + String(MenuWid - \
      Len(tDesc), ".") + tDesc
End Function
Const MenuName = "NEAT MENU:"
Const MenuOffset = MenuWid + 12
Print
Print MenuName
Print
Print Dots("","Be there");
Print LeftPad(Dots("","or be square"), MenuOffset)
Print Dots("","Leaving home");
Print LeftPad(Dots("?","for a far better place"), MenuOffset)
Print
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LEN Function
Rem Len used for strings and user-data types

Const ExactLen = 5
Type UserData
  Name As String*30
  Alias As String*ExactLen
  Age As Integer
End Type
Dim uData As UserData : Rem Assume file exists
Open "Testdata.DAT" For Random As #1 Len = Len(UserData)
Do
  Print "Your "; ExactLen; " character alias: ";
  Input uData.Alias
Loop Until Len(uData.Alias) = ExactLen
Put #1,1,uData
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LET Statement
Rem Let is always implied in assignment

Dim AnInt As Integer, Astring As String

Let AnInt = 32000
Let Astring = "The use of Let is optional"
Print AnInt; ".."; Astring
AnInt = 27
Astring = "This is easier"
Print AnInt; ".."; Astring
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LISTFILES Statement
Rem List the files until told to quit

Function GetKey As String
  Dim tKeyIn As String*1
  Do
    tKeyIn = UCase(InKey)
  Loop Until tKeyIn > ""
  Print tKeyIn;
  GetKey = tKeyIn
End Function

Dim GoHome As Integer, KeyIn As String*1
Do
  Print
  Print "You have selected the Old files section!"
  print
  Print "Press [L].......List files       [Q]..........Quit to menu"
  Print
  Print "Selection: ";
  KeyIn = GetKey
  Select Case KeyIn
    Case "L"
      Print : ListFiles
    Case "Q"
      GoHome = True
    Case Else
      Beep
  End Select
Loop Until GoHome
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LISTFILESDATE Statement
Rem List the files until told to quit

Function GetKey As String
  Dim tKeyIn As String*1
  Do
    tKeyIn = UCase(InKey)
  Loop Until tKeyIn > ""
  Print tKeyIn; : GetKey = tKeyIn
End Function

Dim GoHome As Integer, KeyIn As String*1
Do
  Print : Print "You have selected the Oldfiles section!"
  Print : Print "[L]..List  [N]..New  [Q]..Quit to menu"
  Print : Print "Selection: "; : KeyIn = GetKey
  Select Case KeyIn
    Case "L"
      Print : ListFiles
    Case "N"
      Print : ListFilesDate
    Case "Q"
      GoHome = True
    Case Else
      Beep
  End Select
Loop Until GoHome
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LOC Function
Rem Demonstrate the difference between, LOF and Loc

Const FName = "Birthday.TXT" : Rem Make sure file exists
If Exists(FName) Then
  Open FName For Append As #1
  Print "When opened for 'Append' the Loc and LOF differ by 1"
  Print "Loc = "; Loc(1); " LOF = "; LOF(1)
Else
  Print "Could not find the file"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LOCAL Function
Rem Provide access only if the user is logged on locally

Dim KeyIn As String*1
Do
  Print "AUX MENU:" : Print "[S]..Shell to DOS  [Q]..Quit to menu";
  Print : Print "Select [S Q] : "; : Input KeyIn
Loop Until Instr("SQsq",KeyIn) <> 0
Select Case UCase(KeyIn)
  Case "S"
    If Not(Local) Then
      Print "This option is not available when on-line"
    Else
      Shell
    End If
  Case "Q"
    End
End Select
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LOCATE Statement
Rem Position the cursor, display a prompt as a screen saver

Function ScreenSave As String
  Dim Row As Integer, Col As Integer
  Dim Key As String
  Cls
  Do
    Row = ((Rnd * 100) Mod 24) + 1
    Col = ((Rnd * 100) Mod 69) + 1
    Locate Row, Col
    Print "Waiting...";
    Delay 0.25
    Locate Row, Col
    Print "          ";
    Key = Inkey
  Loop Until Key > ""
  ScreenSave = Key
End Function
ScreenSave : Rem Main body of program here
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LOCATEUSER Statement
Rem Identify a user 

LocateUser
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LOF Function
Rem Add another record to the database

Type BadGuyRec
  Name As String*30
  Alias As String*30
  TimesOnBBS As Integer
End Type
Dim BadGuy As BadGuyRec
Open "BadGuy.DAT" For Random As #1 Len = Len(BadGuyRec)
BadGuy.Name = "Remington Blair"
BadGuy.Alias = "NoOne Home"
BadGuy.TimesOnBBS = 3
Put #1, LOF(1) + 1, BadGuy  : Rem Position after the last record
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LOG Function
Rem The Log of a number

Print "The Log of 1 is "; Log(1)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LONG Type
Rem Typical use of a Long data type

Dim Pay As Long
Const HoursPW = 50, Rate = 33, WeeksPY = 52
Pay = HoursPW * Rate * WeeksPY
Print "My annual salary is $"; Pay
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LOOP Statement
Rem Do something with a Do ... Loop

Dim ByteA As Integer
Const WaitingStr = " I'm still here and working hard"
ByteA = 0
Do
  Print ByteA; WaitingStr
  ByteA = ByteA + 1
Loop Until ByteA > 10
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem LTRIM Function
Rem Strip out all blanks on the left of a string

Dim tStr(6) As String, Ctr As Integer
tStr(1) = "    A little ditty     "
tStr(2) = "  hello Dolly     "
tStr(3) = "I said hello Dolly"
tStr(4) = "It's been good to see       "
tStr(5) = "     you way back when      "
tStr(6) = "        err I don't know any more words"
For Ctr = 1 To 6 Step 2
  Print Pad(LTrim(RTrim(tStr(Ctr))),40);
  Print LTrim(RTrim(tStr(Ctr + 1)))
Next Ctr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem MAXNODE Function
Rem All Wildcat! versions support at least two nodes

Print "The maximum this version can support is "; MaxNode
Print "and don't forget Node zero!"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem MID Function
Rem Extensive demo using in-part, the Mid function

Function GetMins(Prompt As String) As Long
  Dim tStr As String, Hours As Long, Mins As Long
  tStr = InputMask(Prompt, "99:99")
  Hours = Val(Left(tStr, 2))
  Mins = Val(Mid(tStr, 4, 2))
  GetMins = (Hours * 60) + Mins
End Function

Dim StartM As Long, EndM As Long
Dim WorkH As Long, WorkM As Long
Do
  Print "Enter zero time to quit"
  StartM = GetMins("Start time ")
  If StartM <> 0 Then
    EndM = GetMins("End time   ")
    WorkM = EndM - StartM
    WorkH = WorkM \ 60  : Rem Note the backslash for integer division
    WorkM = WorkM - (WorkH * 60)
    Print "hours worked = "; WorkH; ":"; WorkM
  End If
Loop Until StartM = 0
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem MKDIR Statement
Rem Make a new directory for file storage

Function NewDirOk(tStr As String) As Integer
  Rem Error Err_Path : Rem Used for testing Catch
  NewDirOk = True
  MkDir(tStr)
  Catch Err_Path
    NewDirOk = False
    Print "Unable to make "; UCase(tStr)
    WaitEnter
End Function

If NewDirOk("C:\Wildcat\work\Data3") Then
  Print "New path created"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem MOD Operator
Rem Use Mod to provide numbers between 1 and 24, 1 and 69

Function ScreenSave As String
  Dim Row As Integer, Col As Integer
  Dim Key As String
  Cls
  Do
    Row = ((Rnd * 100) Mod 24) + 1
    Col = ((Rnd * 100) Mod 69) + 1
    Locate Row, Col
    Print "Waiting...";
    Delay 0.25
    Locate Row, Col
    Print "          ";
    Key = Inkey
  Loop Until Key > ""
  ScreenSave = Key
End Function
ScreenSave : Rem Main body of program here
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem MOREPROMPT Function
Rem Assume the file is a long text file

Const MaxCtr = 200
Dim Ctr As Integer, KeepGoing As Integer
Dim tStr As String
Open "LongText.TXT" For Input As #1 : Rem Assume it exists
KeepGoing = InputYesNo("Display large lumps at a time? ")
If KeepGoing Then MorePrompt Off
While Not(EOF(1))
  Ctr = Ctr + 1
  Input #1, tStr : Print tStr
    Rem Check every so often if large lumps displayed
  If (KeepGoing) And (Ctr > MaxCtr) Then
    Ctr = 0
    Pause
    If DisplayStopped Then GoTo HadEnough
  End If
Wend
HadEnough:
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem MOVELEFT Statement
Rem Position the cursor under the [Enter] prompt

Function PressEnter As Integer
  Const Prompt = "Press [Enter] to proceed"
  Const OkChars = Chr(13) + Chr(27)
    Rem Enter is ASCII 13 and Esc is ASCII 27
  Dim KeyIn As String*1, Ok As Integer
  Print Prompt;
  MoveLeft Len(Prompt) - Instr(Prompt,"[")
  Do
    KeyIn = Inkey
    Ok = Instr(OkChars, KeyIn) <> 0
    If Not Ok Then Beep
  Loop Until Ok
  PressEnter = Asc(KeyIn)
End Function
If PressEnter = 13 Then 
  Print
  Print "[Enter] Now you're talkin!"
Else
  Print
  Print "[Esc] No escape from Alcatraz Harry!"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem MOVERIGHT Statement
Rem The basis for a line editor.

Dim KeyIn As String, Col As Byte
Dim WorkStr As String, tStr As String
Const LeftArr = Chr(75), RightArr = Chr(77)
Const ExitChars = Chr(13) + Chr(27)
Col = 1 : Print : tStr = "My nifty little editor"
Print tStr; : Locate CsrLin, Col : WorkStr = tStr
Do
  Do
    KeyIn = Inkey
  Loop Until KeyIn > ""
  If KeyIn = Chr(0) Then
    KeyIn = Inkey
    Select Case KeyIn
      Case LeftArr
        If Col > 1 Then
          Col = Col - 1
          MoveLeft 1
        Else 
          Beep
        End If
      Case RightArr
        If Col < 80 Then
          Col = Col + 1
          MoveRight 1
        Else 
          Beep
        End If
    End Select      
  Else
    Select Case KeyIn
      Case " " To "|"
        Print KeyIn;
        tStr = Left(tStr, Col - 1) + KeyIn + \
            Right(tStr, Len(tStr) - Col)
        Col = Col + 1
      Case Chr(27) : Rem The Esc key so put string back
        tStr = WorkStr
      Case Chr(13) : Rem The Enter key
      Case Else
        Beep
    End Select
  End If
Loop Until Instr(ExitChars, KeyIn) > 0
Print
Print tStr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem NAME Statement
Rem Rename or Move a file

Dim BakFName As String, Today As Date
Dim NewFName As String, KeyIn As String
CurrentDate Today
BakFName = FormatDate(Today, "mm-dd") + "Usr.LOG"
Name "User.LOG" As BakFName
If Exists("Backup\" + BakFName) Then
  Print "File exists. [R]..Rename  [D]..Delete  [Q]..Quit ";
  Input KeyIn
  Select Case KeyIn
    Case "Q", "q"
      End
    Case "D", "d"
      Del(BakFName)
    Case "R", "r"
      Print "Old name = "; BakFName; " New name ";
      Input NewFName
      Name "Backup\" + BakFName As "Backup\" + NewFName
  End Select
End If
Name BakFName As "Backup\" + BakFName
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem NEWSLETTER Statemnent
Rem Display the Newsletter to an online caller

If Not(Local) Then
  NewsLetter
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem NEXT Statement
Rem Display a count-down timer

Dim Ctr As Integer, Row As Integer, Col As Integer
Print "Waiting for keyboard response : ";
Row = CsrLin
Col = Pos
For Ctr = 30 To 1 Step -1
  Locate Row, Col
  Print Ctr; " "; : Rem Stomp on extra digit when we get below 10
  Delay 1
  If InKey > "" Then
    Exit For
  End If
Next Ctr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem NOCHAR Function
Rem Use YesChar and NoChar to test a response

Dim KeyIn As String*1
Print "Are you sure you want to do this? ";
Do
  KeyIn = UCase(Inkey)
Loop Until (KeyIn = YesChar) Or (KeyIn = NoChar)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem NODE Function
Rem Simple example of the Node number function

Print "Your are "; User.Name; " connected to "; Node
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem NOT Operator
Rem A comparison using the Not operator

If Not(Exists("Error.LOG")) Then
  Print "Error.LOG seems to be missing!"
Else
  Print "Everything appears in order here."
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem NUMBER Variable field
Rem Number is an integral part of Date variables

Dim DateVar As Date
CurrentDate(DateVar)
Print "The date value: "; DateVar.Number; \
  " is really "; FormatDate(DateVar, "dd/mm/yyyy")
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem OCT Function
Rem Display an octal-base value

Dim OctStr As String
OctStr = Oct(90210)
Print "Oldies but goodies = "; OctStr
Print "The Oct value of 123 is "; Oct(123)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem OPEN Statement
Rem A Little opening and closing going on

Open "Error.LOG" For Append As #1
Print #1, "I should not mess with this file!"
Close #1
Type MyUserRecord
  Name As String*30
  Alias As String*30
  Age As Integer
End Type
Dim MyUser As MyUserRecord
Open "MyUser.DAT" For Random As #1 Len= Len(MyUserRecord)
MyUser.Name = "Slick Harry"
MyUser.Alias = "Everything's for sale"
MyUser.Age = 29
Put #1, 1, MyUser
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem OR Operator
Rem Logical and bitwise manipulations with Or

If (12 > 13) Or (10 < 21) Then
  Print "At least one must be true!"
End If
Print "But 10 ORed with 21 = "; 10 Or 21
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem OUTPUT Declaration
Rem Overwrite a file after opening for output

If Exists("Birthday.XXX") Then
  If Not InputYesNo("The file exists, overwrite it? ) Then
    Print "No message or file was written!"  
    End
  End If
End If
Open "Birthday.XXX" For Output As #1
Print #1, "Happy birthday"
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PAD Function
Rem Using Pad to align data in columns

Dim NameStr(5) As String, Age(5) As Integer, Ctr As Integer
NameStr(1) = "Flair Patterson" : Age(1) = 29
NameStr(2) = "Stephen Queen" : Age(2) = 43
NameStr(3) = "Cindy Cisero" : Age(3) = 55
NameStr(4) = "Talbragard Shrimpton" : Age(4) = 12
NameStr(5) = "Derek Swineborne" : Age(5) = 23
For Ctr = 1 to 5
  Print Pad(NameStr(Ctr),32); Age(Ctr)
Next Ctr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PAGESYSOP Statement
Rem Offer a caller the chance of chatting with the Sysop

Dim KeyIn As String*1
Do
  Print "Press [P]-Page the SysOp  [Q]-Quit back to the menu (PQ) ";
  Do
    KeyIn = UCase(Inkey)
  Loop Until KeyIn > ""
  Select Case KeyIn
    Case "P"
      PageSysOp
    Case "Q"
      Locate CsrLin, 1
      ClrEOL : Print "Bye for now"
      End
    Case Else
      Print
      Print "Invalid response "; KeyIn
      Beep
  End Select
Loop : Rem Condition-less Do...Loop is handled by "Q" selection
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PAGEUSER Statement
Rem Send a four-line notice to a caller

PageUser
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PAUSE Statement
Rem Assume the file is a long text file and Pause the display

Const MaxCtr = 200
Dim Ctr As Integer, KeepGoing As Integer
Dim tStr As String
Open "LongText.TXT" For Input As #1 : Rem Assume it exists
KeepGoing = InputYesNo("Display large lumps at a time? ")
If KeepGoing Then MorePrompt Off
While Not(EOF(1))
  Ctr = Ctr + 1
  Input #1, tStr : Print tStr
    Rem Check every so often if large lumps displayed
  If (KeepGoing) And (Ctr > MaxCtr) Then
    Ctr = 0
    Pause
    If DisplayStopped Then GoTo HadEnough
  End If
Wend
HadEnough:
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem POS Function
Rem Use Pos to control the cursor position

Dim Ctr As Integer, Row As Integer, Col As Integer
Ctr = 20
Print "Select [M]..Menu  [G]..Goodbye"
Print "You have "; Ctr; " seconds to respond ";
Row = CsrLin
Col = Pos
Do
  Locate Row, Col
  Print Ctr; " "; : Rem Stomp on extra characters below 10
  Ctr = Ctr -1
  Delay 1
  Select Case UCase(Inkey)
    Case "M"
      End
    Case "G"
      GoodBye
  End Select
Loop Until Ctr < 1
HangUp
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PRINT Statement
Rem Use Print to display data on the screen

Dim Dt(5) As String*6, Ctr As Integer
Dim DL(5) As Integer, UL(5) As Integer
Rem Pretend we gathered these stats
Dt(1) = "Jun-10" : DL(1) = 605  : UL(1) = 45
Dt(2) = "Jun-11" : DL(2) = 1204 : UL(2) = 602
Dt(3) = "Jun-12" : DL(3) = 306  : UL(3) = 27
Dt(4) = "Jun-13" : DL(4) = 880  : UL(4) = 88
Dt(5) = "Jun-14" : DL(5) = 1046 : UL(5) = 45
Print "Date", "D/L", "U/L",,"Ratio"
Print String(61,"=")
For Ctr = 1 To 5
  Print Dt(Ctr), DL(Ctr), UL(Ctr),,
  Print Int(UL(Ctr) / DL(Ctr)*100); "%"
Next
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PROGNAME Function
Rem Track use of programs. This could be an '$INCLUDE file

Dim DT As DateTime
CurrentDateTime DT
Open "MyUser.DAT" For Append As #1
If LOF(1) = 0 Then
  Print #1, "New user log file: "; 
  Print #1, FormatDate(DT.D, "mm/dd/yyyy")
  Print #1, String(34,"*")
  Print #1,
End If
Print #1, ProgName;
Print #1, " "; FormatDate(DT.D, "mm/dd/yy");
Print #1, " "; FormatTime(DT.T, "hh:mm")
Print #1, " "; User.Name;
Print #1, String(34, "=")
Close
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PROGPATH Function
Rem Store all of your programs in the same directory

Const FName = "MsgBase.WCX"
If InputYesNo("Care to branch to the message base? ") Then
  If Exists (ProgPath + FName) Then 
    Chain ProgPath + FName
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PUSHCOMMAND Statement
Rem On exiting a program, read all unread messages

Rem The bulk of your program in here
Rem ...
Rem ...
PushCommand "M R U A"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem PUT Statement
Rem Gather data and store in a file until told to quit

Type TempRecord
  Name As String*25
  Password As String*14
  Phone As String*15
  SecLevel As String*10
End Type
Dim tRec As TempRecord, ForceUpper As Integer
Dim AllDone As Integer
Const Quit1 = "QUIT-EXIT-END-DONE-FINISH-DUTCH?-"
Const Quit2 = "ZERO-SQUAT-NIX-NONE-ZIP-DOODLEY-"
Sub ClearData(Row As Byte, Col As Byte)
  Locate Row, Col
  ClrEOL
End Sub
Function InputStr(Row As Byte, Col As Byte, \
            Prompt As String) As String
  Dim tStr As String
  ClearData(Row, Col)
  Prompt = Trim(Prompt)
  If Right(Prompt, 1) <> ":" Then
    Prompt = Prompt + ":"
  End If
  Prompt = Pad(Prompt, Len(Prompt) + 1)
  Locate Row, Col
  Print Prompt;
  Input tStr
  If ForceUpper Then
    tStr = UCase(tStr)
    Locate Row, Col + Len(Prompt)
    Print tStr
  End If
  InputStr = tStr
End Function

Rem Start of main program body
Cls
Locate 22, 1
Print "To finish, enter an exit-word for the Name"
Print Quit1; Quit2;
Open "MyUsers.DAT" For Random As #1 Len = Len(TempRecord)
ForceUpper = True
Do
  tRec.Name = InputStr(1, 13, "Name:")
  AllDone = Instr(Quit1 + Quit2, tRec.Name) <> 0
  If Not(AllDone) Then
    tRec.Password = InputStr(3, 9, "Password:")
    Locate 5, 10
    tRec.Phone = InputMask("  Phone: ","999-999-9999")
    tRec.SecLevel = InputStr(7, 9, "Security:")
    Put #1,,tRec  : Rem The two commas force a sequential Put
  End If
Loop Until AllDone
Close
Cls
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem QUESTIONNAIRE Statement
Rem Get a questionnaire for completion

Dim QNum As Integer
Print "Questionnaires:"
Print
Print "[1]..Sysop quiz  [2]..For sale  [3]..Quit"
Print
Print "Number: ";
Input QNum
If QNum = 3 Then End
Questionnaire QNum
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem QUESTIONNAIREMENU Statement
Rem Get a questionnaire for completion

QuestionnaireMenu
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem QUOTEOFTHEDAY Statement
Rem Use YesChar/NoChar, then display the next quote

If InputYesNo("Care for a random thought? ") Then
  QuoteOfTheDay
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RANDOM Declaration
Rem Retrieve data from a file opened for Random access

Type UserRec
  Name As String*30
  Alias As String*30
  LastDate As String*8
  TimesCalled As Integer
End Type
Dim DataF As Integer, URec As UserRec
DataF = FreeFile      : Rem Assume the file exists
Open "Records.DAT" For Random As #DataF Len = Len(UserRec)
While Not(EOF(DataF))
  Get #DataF,, Urec  : Rem Step sequentially from start to end
  Print LeftPad(URec.Name,32); LeftPad(URec.Alias,32);
  Print LeftPad(URec.LastDate,10); URec.TimesCalled
Wend
Close #DataF
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem READMESSAGES Statement
Rem If the caller desires, then read the messages

If InputYesNo("Read messages now? (YN) ") Then ReadMessages
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem READTEXTFILE Statement
Rem Use ViewFile and DisplayTextFile to show file contents

Dim KeyIn As String*1
Do
  Print "Inspect file contents..."
  Print "[V]..View archived  [R]..Text files  [Q]..Quit (VRQ) ";
  Input KeyIn
  Select Case UCase(KeyIn)
    Case "V"
      ViewFile
    Case "R"
      ReadTextFile
  End Select
Loop Until (KeyIn = "Q") Or (KeyIn = "q")
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem REAL Type
Rem A Typical use of the Real data type

Dim PayToday As Real, Rate As Real, Hours As Real
Rate = 17.50
Hours = 10.63
PayToday = Rate * Hours
Print "Today I earned $"; PayToday
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem REM Statement
Rem Different uses of the Comment

Dim KeyIn As String*1    : Rem This comment needs a colon
Print "Press [Y]es or [N]o ";
Do                ' and this one does not
  KeyIn = UCase(Inkey)
Loop Until KeyIn > ""
If Not(Instr("YN", KeyIn)) Then
  Beep            : Rem Keystroke not acceptable
Else 
  Print "Thanks"      : Rem We are on our way again
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RESET Statement
Rem Reset will close all open files

Dim tStr As String
Open "TestIN.DAT" For Input As #1
Open "TestOUT.DAT" For Output As #2
While Not(EOF(1)) 
  Input #1, tStr
  Print #1, tStr
Wend
Reset : Rem Slam them all closed
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RETURN Statement
Rem Branching forward/backwards with the GoSub/GoTo

Print "I should always use Sub and Function for branching"
GoSub BadMove
Print "Progam now terminating with the End statement"
End
Rem End of the main program body

BadMove:
  Dim YesSir As String*1
  Print "Do you want to see more of this ";
  Input YesSir
  If UCase(YesSir) = "N" Then 
    Return Else GoTo BadMove
  End If
Rem No Return needed here as the If statement takes care of it
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RIGHT Function
Rem Handy function, antithesis to one in Left(Str,Num)

Function AfterChar(TargetCh As String, SearchStr As String) As String
  Dim JunkStr As String
    Rem Add TargetCh to SearchStr just in case there is none
  JunkStr = Right(SearchStr, \
        Len(SearchStr)-Instr(SearchStr + TargetCh,TargetCh))
  AfterChar = JunkStr
End Function

Const ShortStr = "The Wildcat & other bedside things"
Print ShortStr
Print Trim(AfterChar("&",ShortStr))
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RIP Statement
Rem Demo the Rip Circle statement

Dim Rad As Integer, Row As Byte, Col As Byte
Cls
Rad = 20
Row = 10 : Col = 40
If RipDetected Then
  Rip Circle Row, Col, Rad
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RIPDETECTED Function
Rem Check caller's RIP status

If RIPDetected Then
  Print "RIP detected!"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RIPENABLED Function
Rem If you can do it then use RIP

If RIPEnabled Then
  Print "RIP enabled!"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RMDIR Statement
Rem Remove a directory complete with files

Function RemoveDir(tStr As String) As Integer
  Dim SRec As SearchRec, Result As Integer
  RemoveDir = False
  If Not InputYesNo("Sure you want " + tStr + " removed? ") Then
    Exit Function
  Else
    If tStr = "" Then
      Print "Cannot work on current directory!"
      WaitEnter
      Exit Function
    End If
    If Right(tStr,1) <> "\" Then
      tStr = tStr + "\"
    End If
    Result = FindFirst(tStr + "*.*", 0, SRec)
    While Result = 0
      Print Pad(tStr + SRec.Name, 16); "Gone."
      Del(tStr + SRec.Name)
      Result = FindNext(SRec)
    Wend
    tStr = Left(tStr, Len(tStr) - 1) : Rem Drop the \
    RmDir(tStr)
    RemoveDir = True : Rem Place here and it 'should' be true
  End If
  Catch Err_Path
  Print "Error removing directory!"
End Function
Dim DirName As String
Print "Directory to remove: ";
Input DirName
If RemoveDir(DirName) Then
  Print "Directory and files are gone!"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RND Function
Rem Demonstrate the various uses of Rnd

Print "Rnd(10) = "; Rnd(10)
Print "Rnd(0)  = "; Rnd(0)
Print "Rnd(-1) = "; Rnd(-1)
Print "Rnd(0)  = "; Rnd(0)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RTRIM Function
Rem Trim all of the blanks, right of the last character

Dim tStr(6) As String, Ctr As Integer
tStr(1) = "    A little ditty     "
tStr(2) = "  hello Dolly     "
tStr(3) = "I said hello Dolly"
tStr(4) = "It's been good to see       "
tStr(5) = "     you way back when      "
tStr(6) = "        err I don't know any more words"
For Ctr = 1 To 6 Step 2
  Print Pad(LTrim(RTrim(tStr(Ctr))),40);
  Print Trim(tStr(Ctr + 1))
Next Ctr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem RUN Statement
Rem Shell to another program

Dim KeyIn As String*1, Row As Byte, Col As Byte
Do
  Print "[L]..List of BBS  [O]..Orders  [Q]..Quit to main menu ";
  Row = CsrLin : Col = Pos
  Do
    KeyIn = UCase(Inkey)
  Loop Until KeyIn > ""
  Locate Row, Col : Print KeyIn;
  Select Case KeyIn
    Case "L"
      Run "WCLIST.WCX"
    Case "O"
      Run "WCORDERS.WCX"
    Case "Q"
      End
    Case Else
      Beep
  End Select
Loop : Rem No condition needed as "Q" exits program
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SCANMESSAGES Statement
Rem If the caller desires, then scan the messages

If InputYesNo("Do you want to scan the messages? (YN) ") Then
  ScanMessages
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SEARCHFILES Statement
Rem Activate the file search system with SearchFiles

SearchFiles
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SEEK Statement
Rem Modify the data created in the Put example

Type TempRecord
  Name As String*25
  Password As String*14
  Phone As String*15
  SecLevel As String*10
End Type
Dim tRec As TempRecord, SeekPos As Long
Dim Prompt As String
Cls
Open "MyUsers.DAT" For Random As #1 Len = Len(TempRecord)
Prompt = Str(LOF(1)) + " records. Get #: "
SeekPos = InputNumber(Prompt, 0, LOF(1))
If SeekPos > 0 Then
  Seek #1, SeekPos
  Get #1,,tRec
  Print "Name: "; tRec.Name
  Print "Password needs changing! "; tRec.Password; " ";
  Input tRec.Password
  tRec.Password = UCase(tRec.Password)
  Put #1, SeekPos, tRec : Rem The alternate use
End If
Close
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SELECT CASE Statement
Rem make a selection and branch using Select Case

Dim SelCh As String*1, SelInt As integer
Dim DosStr(2) As String, SN As String
SN = ProgName : DosStr(1) = "List.COM"
DosStr(2) = "Type " + Left(SN,Instr(SN,".") - 1) + ".WCC"
Do
  Print "[V]........View file         [1]......Dos Shell 1"
  Print "[Q].....Quit to menu         [2]......Dos shell 2"
  Print "Selection [V Q 1 2] : "; : Input SelCh
  Select Case SelCh
    Case Is = " " : Rem Boolean decision
      Print "Enter more than a blank space please!"
      Beep
    Case "V", "v"
      ViewFile
    Case "Q", "q"
      Exit Do
    Case "1" To "2" : Rem Range for decision
      Shell DosStr(Val(SelCh))
    Case Else : Rem If all else fails
      Print "Invalid selection."
      Beep
  End Select
Loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SEND Statement
Rem Reset a Hayes compatible MODEM

Delay(3)
Send "+++" + Chr(13)
Delay(3)
Send "ATZ" + Chr(13)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SENDFILE Function
Rem Send a file after confirming the caller is ready

Dim KeyIn As String*1
Const EnterKey = Chr(13)
Send "Press [Enter] when ready for the file"
Do
  KeyIn = InComm
Loop Until KeyIn > ""
If KeyIn = EnterKey Then
  PushCommand("Y") : Rem Answers the SendFile question
  If SendFile("ORDERS.INF") Then
    Print "File sent OK"
  Else
    Print "SendFile failed!"
    WaitEnter
  End If
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SENDPAGE Statement
Rem Get a node number then page the caller

Dim PageStr As String, NodeNum As Integer
WhoIsOnLine : Rem We need their node number first
Print "Message: ";
Input PageStr
NodeNum = InputNumber("To which node? ", 1, MaxNode)
SendPage NodeNum, PageStr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SGN Function
Rem Return the sign of various values

Print "Sgn -5 = "; Sgn(-5)
Print "Sgn 0  = "; Sgn(0)
Print "Sgn 3  = "; Sgn(3)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SHELL Statement
Rem Run a DOS program and a DOS command

Dim SelCh As String*1, SelInt As integer, DosStr(2) As String
Dim PN As String : PN = ProgName : DosStr(1) = "List.COM"
DosStr(2) = "Type " + Left(PN,Instr(PN,".") - 1) + ".WCC"
Do
  Print "[V]..View file  [1]..Dos Shell 1  [R]..Read file"
  Print "[C]..Chg Setgs. [2]..Dos shell 2  [Q]..Quit to menu"
  Print "Selection [V R C Q 1 2] : "; : Input SelCh
  Select Case SelCh
    Case "V", "v"
      ViewFile
    Case "R", "r"
      ReadTextFile
    Case "C", "c"
      ChangeSettings
    Case "Q", "q"
      Exit Do
    Case "1" To "2"
      Shell DosStr(Val(SelCh))
    Case Else
      Print "Non-valid selection." : Beep
    End Select
Loop
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SIN Function
Rem Print the sine of a value

Print "The sine of 1 radian is equal to "; Sin(1)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SORTADD Statement
Rem An example in four parts, part 2, add to the sort
Rem 1-SortStart, 2-SortAdd, 3-SortNext, 4-SortPrev
Function AddToSort As Integer
  Dim SortItems As Integer
  SortItems = 0
  For Ctr = 1 To MaxCtr
    If Trim(DataArr(Ctr)) > "" Then
      SortItems = SortItems + 1
      SortAdd(DataArr(Ctr), Ctr)
    End If
  Next Ctr
  AddToSort = SortItems
End Function
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SORTNEXT Function
Rem An example in four parts, part 3, retrieve forward
Rem 1-SortStart, 2-SortAdd, 3-SortNext, 4-SortPrev

Function GetTheNext As String
  Dim tSortRet As Long : tSortRet = SortNext
  If tSortRet > 0 Then
    GetTheNext = DataArr(tSortRet)
  Else
    GetTheNext = ""
  End If
End Function
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SORTPREV Function
Rem An example in four parts, part 4, retrieve backward
Rem 1-SortStart, 2-SortAdd, 3-SortNext, 4-SortPrev

Function GetThePrev As String
  Dim tSortRet As Long : tSortRet = SortPrev
  If tSortRet > 0 Then
    GetThePrev = DataArr(tSortRet)
  Else GetThePrev = ""
  End If
End Function
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SORTSTART Statement
Rem An example in four parts, part 1, Set things up
Rem 1-SortStart, 2-SortAdd, 3-SortNext, 4-SortPrev

Const MaxCtr = 40
Dim DataArr(MaxCtr) As String*30, ForwardDir As Integer
Dim RetStr30 As String*30, Ctr As Long
Declare Function AddToSort As Integer : Rem Part 2
Declare Function GetTheNext As String : Rem Part 3
Declare Function GetThePrev As String : Rem Part 4
DataArr(1) = "Jim" : DataArr(2) = "Scott"
DataArr(3) = "Rick" : DataArr(4) = "Greg"
SortStart
ForwardDir = InputYesNo("Return in ascending order ")
If AddToSort > 0 Then
  Do
    If ForwardDir Then
      RetStr30 = GetTheNext
    Else
      RetStr30 = GetThePrev
    End If
    If RetStr30 > "" Then Print RetStr30
  Loop Until RetStr30 = ""
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SOUND Statement
Rem Make a sound at the local console only

Sub AlarmBell
  Sound 3000, 1
  Delay 0.25
  Sound 600, 1
End Sub

Print "@F4@Warning"; DefColor
Do
  AlarmBell
Loop Until Inkey <> ""
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SPACE Function
Rem Neatly pad prompts and data display

Dim FirstN As String, LastN As String
Print LeftPad("First name: ", 18); : Input FirstN
Print LeftPad("Last name: ", 18); : Input LastN
Print Pad(FirstN,20); Space(5); UCase(LastN)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SPC Function
Rem Neatly pad prompts and data display

Dim FirstN As String, LastN As String
Print LeftPad("First name: ", 18); : Input FirstN
Print LeftPad("Last name: ", 18); : Input LastN
Print Pad(FirstN,20); Spc(5); UCase(LastN)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SQR Function
Rem Test the Sqr function for rounding error

Dim tLong As Long
tLong = 16 * 16
Print "16 squared = "; tLong
Print "and the square root of "; tLong; " is "; Sqr(tLong)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem STATIC Statement
Rem Static variables are preserved while the program is active

Function CapName(tStr As String, TimesUsed As Integer) As String
  Dim CapStr As String
  Static NamesCapped As Integer
  CapStr = LCase(tStr) : Rem Copy, don't change the original
  CapName = UCase(Left(CapStr, 1)) + \
        Mid(CapStr, 2, Len(CapStr) - 1)
  NamesCapped = NamesCapped + 1
  TimesUsed = NamesCapped
End Function

Dim NameStr As String, Ctr As Integer
While Ctr < 3
  Print "Enter your name "; : Input NameStr
  Print "Hello "; CapName(NameStr,Ctr);
  Print "The Function CapName has now been used "; Ctr; " times"
Wend
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem STATISTICS Statement
Rem A Wildcat! command to present the statistics information

Dim KeyIn As String
Print "Select [S]-System stats or [Q]-Quit back to menu (SQ) ";
Do
  KeyIn = UCase(Inkey)
Loop Until Instr("QS",KeyIn ) <> 0
If KeyIn = "S" Then Statistics
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem STOP Statement
Rem Stop reports to the Sysop and terminates the program

Dim Ctr As Integer, PwStr As String*5
For Ctr = 1 To 3
  Print "Enter your password "; Ctr; ": ";
  Input PwStr
  If UCase(PwStr) <> "SYSOP" Then
    Stop : Rem Terminate the process right now!
  End If
Next Ctr
Print "Ok so far so good"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem STR Function
Rem Select a single digit from a number 

Function PasswordVal(tStr As String) As Integer
  Dim Ctr As Byte, Accum As Long
  Accum = 0
  For Ctr = 1 To Len(tStr)
    Accum = Accum + (Asc(Mid(tStr,Ctr,1)) XOr Ctr) * Ctr * 17
  Next Ctr
  PasswordVal = Val(Mid(Str(Accum),3,4))
End Function

Dim PW1 As String*10, PW2 As String*10
Print "Enter your password : "; : Input PW1
  Rem Pass by value because of string length in Dim
Print "value = "; PasswordVal((PW1))
Print "Enter again to verify : "; : Input PW2
  Rem Pass by value because of string length in Dim
Print "value = "; PasswordVal((PW2))
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem STRING Function
Rem String with a variety of formats

Const sLen = 65
Dim Lines As String*3
Lines = "-+="
Print String(sLen, Lines)
Lines = Right(Lines,2)
Print "Name"; String(8, 46); "  ";
Print "Address"; String(27, 46); "  ";
Print "Phone"; String(10, 46);
Print
Print String(sLen, Lines)
Print String(sLen, "=")
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem STRING Type
Rem The string data type formats

Type MyStringBag
  Food(50) As String*25
  Cola(5) As String*10
End Type
Dim TestString As String, MSB As MyStringBag
TestString = "Say something George!"
MSB.Food(1) = "Corn chips" : MSB.Cola(1) = "Pepsi"
Print TestString
Print MSB.Food(1); " & "; MSB.Cola(1)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SUB Statement
Rem A small wcCODE-usage file tracker

Sub TrackwcCODE
  Dim DT As DateTime, tStr As String
  CurrentDateTime DT
  tStr = "Program: " + ProgName + " "
  tStr = tStr + FormatDate(DT.D, "mm/dd/yy") + \
           FormatTime(DT.T, " hh:mm")
  ActivityLog tStr
End Sub
TrackwcCODE
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPACTIVITY Statement
Rem A direct Wildcat! command

If User.SecLevel = "SYSOP" Then
  SysOpActivity
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPCHAT Statement
Rem A direct Wildcat! command

If User.SecLevel = "SYSOP" Then
  SysOpChat
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPDOWNLOAD Statement
Rem A direct Wildcat! command

SysopDownLoad "C:\WILDCAT\TEMFILE"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPERASELOG Statement
Rem A direct Wildcat! command

If User.SecLevel = "SYSOP" Then
  SysOpEraseLog
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPEVENTS Statement
Rem A direct Wildcat! command

If User.SecLevel = "SYSOP" Then
  SysOpEvents
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPFILES Statement
Rem A direct Wildcat! command

If User.SecLevel = "SYSOP" Then
  SysOpFiles
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPNODES Statement
Rem A direct Wildcat! command

If User.SecLevel = "SYSOP" Then
  SysOpNodes
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPSTATUS Statement
Rem A direct Wildcat! command

If User.SecLevel = "SYSOP" Then
  SysOpStatus
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPUPLOAD Statement
Rem A direct Wildcat! command

SysopUpLoad "C:\WILDCAT\NEWFILES"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem SYSOPUSERS Statement
Rem A direct Wildcat! command

If User.SecLevel = "SYSOP" Then
  SysOpUsers
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem TAB Function
Rem Columnar Tabbing

Print "Name"; Tab(20); "Address"; Tab(60); "Phone"
Print String(75,".")
Print
WaitEnter
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem TAN Function
Rem The Trigonometrical function

Print "The Tan of 33 is "; Tan(33)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem TEMPPATH Function
Rem Make sure the TEMP directory exists by calling TempPath

Dim tDir As String
tDir = TempPath + "OLX-WORK"
MkDir(tDir)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem TIMELEFT Function
Rem Warn the caller that their time is running short

Sub RunningShort
  If TimeLeft <= 5 Then
    Print "Time left online for "; User.Name; \
        " = "; TimeLeft
    Beep
  End if
End Sub
RunningShort
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem TIMEONLINE Function
Rem A direct Wildcat! command

Print "You have "; TimeLeft; " after being online for ";
Print TimeOnLine
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem TIMER Function
Rem Use the timer function, wait and then proceed

Dim CutOut As Real, Col As Integer, KeyIn As String*1
Const Dur = 30
Print "You have "; Dur; " seconds to select [A] or [B] ";
CutOut = Timer + Dur
Col = Pos
Do
  Locate CsrLin, Col
  ClrEOL
  Print Int(CutOut - Timer);
  KeyIn = UCase(Inkey)
  If Instr("AB",KeyIn) Then Exit Do
Loop Until Timer > CutOut
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem TRIM Function
Rem Make sure the string has no extra spaces

Dim TestStr As String
TestStr = "                  TESTING!                    "
Print "TestStr = "; Len(TestStr); " characters long now"
Print " but just "; Len(Trim(TestStr)); " characters now"
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem TYPE Declaration
Rem Define a user-type within a user type

Type MonthRecord
  Days As Byte
  Name As String*3
End Type
Type YearRecord
  Months(12) As MonthRecord
  ThisYear As Integer
End Type
Const MonthNames = "Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec"
Const MonthDays = "31,28,31,30,31,30,31,31,30,31,30,31"
Dim Ctr As Integer, Year As YearRecord
Year.Thisyear = 1994
For Ctr = 1 To 12 
  Year.Months(Ctr).Name = Mid(MonthNames, ((Ctr - 1) * 4) + 1, 3)
  Year.Months(Ctr).Days = Val(Mid(MonthDays, \
                ((Ctr - 1) * 3) + 1, 2))
Next Ctr
Print "For the year "; Year.ThisYear; " the days per month are..."
For Ctr = 1 To 12
  Print "The month of "; Year.Months(Ctr).Name;
  Print " has "; Year.Months(Ctr).Days; " days"
Next Ctr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem UCASE Function
Rem Capitalize a name

Dim NameStr As String
Print "Enter your first name please ";
Input NameStr
NameStr = LCase(NameStr)
NameStr = UCase(Left(NameStr,1)) + Mid(NameStr,2,Len(NameStr)-1)
Print "G'day "; NameStr
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem UPDATECONFS Statement
Rem A direct Wildcat! command

If InputYesNo("Before you go home shall "+ \
        "I update the conferences? ") Then
  UpdateConfs
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem UPDATEFILE Function
Rem Indicate a new stored path

Dim fRec As FileRecord
Const FName = "ZEEUTIL1.ZIP", NewPath = "D:\LOOKHERE\"
If GetFileInfo(fRec, FName) Then
  fRec.StoredPath = NewPath
  UpdateFile(fRec)
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem UPDATEMESSAGE Function
Rem Change the TO address of all messages

Dim mHdr As MessageHeader
Const OldTo = "ALL", NewTo = "SYSOP"
If GetMessage(mHdr,1) Then
  Do 
    If mHdr.To = OldTo Then 
      mHdr.To = NewTo
      UpdateMessage(mHdr,"")
    End If
  Loop Until Not(GetNextMessage(mHdr))
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem UPDATEUSER Function
Rem Change a user's SecLevel name 

Dim uRec As UserRecord
Const OldSec = "FULLUSER", NewSec = "SYSOP"
uRec.Name = "Rick Heming"
If GetUser(uRec,uRec.Name) Then
  If Instr(OldSec, Trim(uRec.SecLevel)) > 0 Then
    uRec.SecLevel = NewSec
    UpdateUser(uRec)
  End If 
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem UPLOAD Statement
Rem Prepare to receive a file from the caller

If InputYesNo("Ready to send the file? ") Then
  UpLoad
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem USERLIST Statement
Rem Display the current users

If InputYesNo("See the user list again? ") Then
  UserList
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem VAL Function
Rem Various examples in the use of Val

Dim tVal As String*10
tVal = "1234"
Print Val(tVal)
Print Val(tVal) + 1234
Print Val("$B800 Good Hex!")
Print Val("B800 Not so good!")
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem VERSION Function
Rem Save caller's request to a disk file

Dim Today As DateTime
CurrentDateTime(Today)
Open "TechSupp.TXT" For Append As #1
Print #1, "Date: "; FormatDate(Today.D, "mm/dd/yy")
Print #1, "Time: "; FormatTime(Today.T, "hh:mm")
Print #1, "Version: "; Version
Print #1, "Caller: "; User.UserId; "  ";
Print #1, User.Name
Print #1, "I need assistance with the user database"
Close #1
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem VIEWFILE Statement
Rem Read text files or archived ones

Dim KeyIn As String*1
Do
  Print "Inspect file contents..."
  Print "[V]..View archived  [R]..Text files  "+ \
      "[Q]..Quit to menu (VRQ) ";
  Input KeyIn
  Select Case UCase(KeyIn)
    Case "V"
      ViewFile
    Case "R"
      ReadTextFile
  End Select
Loop Until (KeyIn = "Q") Or (KeyIn = "q")
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem WAITENTER Statement
Rem Display 10 lines of text then wait for the caller

Const PageLen = 10 : Dim tStr As String, Ctr As Byte
Cls : Ctr = 0
Open "Birthday.TXT" For Input As #1
While Not(EOF(1))
  Input #1, tStr
  Print tStr
  Ctr = Ctr + 1
  If Ctr = PageLen Then
    WaitEnter
    Ctr = 0
    Cls
  End If
Wend
Close
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem WHOISONLINE Statement
Rem Compare UL/DL ratios before allowing the command

Rem Add one to TotalDK to beat a divide by zero error
If ((User.TotalUK \ (User.TotalDK + 1)) * 100) >= 50 Then
  WhoIsOnline
Else
  Print "Command only available for 50% or better UL/DL ratios! :)"
End If
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem XOR Operator
Rem Process a string with XOr to build a password value

Function PasswordVal(tStr As String) As Integer
  Dim Ctr As Byte, Accum As Long
  Accum = 0
  For Ctr = 1 To Len(tStr)
    Accum = Accum + (Asc(Mid(tStr,Ctr,1)) XOr Ctr) * Ctr * 17
  Next Ctr
  PasswordVal = Val(Mid(Str(Accum),3,4))
End Function

Dim PW1 As String, PW2 As String
Print "Enter your password : "; : Input PW1
Print "value = "; PasswordVal(PW1)
Print "Enter again to verify : "; : Input PW2
Print "value = "; PasswordVal(PW2)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
Rem YESCHAR Function
Rem YesChar and NoChar can change according to the callers 
Rem selected language but the code can handle it

Dim KeyIn As String*1
Print "Are you sure you want to do this? ";
Do
  KeyIn = UCase(Inkey)
Loop Until (KeyIn = YesChar) Or (KeyIn = NoChar)
 =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
End of code fragments...
MSI