'This program works in conjunction with :
'Novell SEND v1.11 and USERLIST v2.10 for use in Saber (and other)
'menu shells.
'
'It should work with any version of SEND v1.11 or greater, but (since it
'depends upon the text output formatting of USERLIST) may have to be edited
'for different versions. Better yet, get the DOS or C calls and poll
'NetWare directly.
'
' (C)opyright 08/08/90 by Bob Welker. Written in QB v4.5
' with code from Crescent Software QuickPak Professional library v3.14
'
'   Disclaimer : Caveat emptor! No guarantees! You are on your own!
'   Released into the user community ... if you use code from this
'   please give mention to the few hours I spent writing it.
'
'   Variables collected for other USERLIST stats, although not used
'   in this version.
'
DEFINT A-Z

DECLARE SUB Calc (ULRow, ULCol, FG, BG)
DECLARE SUB BarPrint (Choice$(), Stat%())
DECLARE SUB HideCursor ()
DECLARE SUB InitMouse (MouseThere%)
DECLARE SUB MQPrint (x$, colr%)
DECLARE SUB PullDnMs (Menu$(), Stat(), Menu%, Choice%, Ky$, Action%)
DECLARE SUB SetCursor (Row, Col)
DECLARE SUB ShowCursor ()
DECLARE SUB TextCursor (FG%, BG%)
DECLARE SUB PickList (items$(), picked%(), NPicked%, Cnf AS ANY)
DECLARE SUB ReadFile (BYVAL Address)
DECLARE SUB TextIn (T$, Max, NumOnly, CapsOn, ExitCode, colr)
DECLARE SUB SysTime (T$)
DECLARE SUB MQPrint (Work$, colr%)
DECLARE SUB MPaintBox (ULRow%, ULCol%, LRRow%, LRCol%, colr%)
DECLARE SUB MsgBox (message$, With%, Cnf AS ANY)
DECLARE SUB ReplaceChar2 (Work$, Old$, New$)
DECLARE SUB Calendar (Month, Day, Year, ULRow, ULCol, Colr1, Colr2, Action)
DECLARE SUB GetQuery (Query$, ScanCode, ExitCode)
DECLARE SUB WaitKey ()

DECLARE FUNCTION PullMenKey% (Ky$, Menu$(), Stat())
DECLARE FUNCTION Monitor% ()            'Used in SetCnf.Bi
DECLARE FUNCTION OneColor% (FG, BG)
DECLARE FUNCTION Peek1% (Segment, Address)
DECLARE FUNCTION Exist% (FileName$)
DECLARE FUNCTION MinInt% (Var1%, Var2%)
DECLARE FUNCTION Delimit% (Work$, Delimiter$)

' you'll have to change where the include files are looked for.
'
'$INCLUDE: 'c:\pro\DefCnf.BI'
'$INCLUDE: 'c:\pro\SetCnf.BI'
'a$INCLUDE: 'T:DefCnf.BI'
'a$INCLUDE: 'T:SetCnf.BI'

CONST FALSE = 0
CONST true = NOT FALSE
DIM UserName$(100): DIM ConnectionNum$(100): DIM LoginDate$(100): DIM LoginTime$(100)

'$DYNAMIC
DIM items$(100)                 ' set up dynamic array for user names

ON ERROR GOTO DOShandler        ' trap DOS errors
ErrorMsg$ = ""                  ' no error message

TopLine$ = "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
MidLine$ = "³                                                     ³ "
BottomLine$ = "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

BottomMsg$ = " F1=Help   F3=Calc  F5=Calendar   F10=Exit "

'   note : This program is not particularly color aware insofar as it
'          is being written on a monochrome system.

GOSUB SetColor                       ' determine if the monitor is mono or color
GOSUB ResetScreen                    ' initial screen setup
GOSUB GetEnv                         ' get Saber Menu environment strings

TOP:                                 ' begin

SLEEP 1

InitMouse Temp                         'Define the Mouse cursor
TextCursor -2, 4                       'Inverse foreground red background
SetCursor 1, 1                         'Locate it at upper right of screen
ShowCursor                             'Turn it on

GetServer1:
SRING1$ = " What server to send message to (default = "
SRING2$ = ") ? "
LOCATE 5, 2: CALL MQPrint(SRING1$ + Server$ + SRING2$, 3)
GetServer2:
	 Max = 15: NumOnly = 0: CapsOn = 1
	 LOCATE 8, 5
	 CALL TextIn(Server$, Max, NumOnly, CapsOn, XCode, TextColr)

	 IF XCode = 0 OR XCode = 1 THEN
		LOCATE 10, 5
		PRINT " Do you wish to (E)dit or (A)ccept the server name? "
		CALL GetQuery(Query$, ScanCode, XCode)
		IF ScanCode > 58 THEN GOSUB SelectScanCode
		SELECT CASE Query$
			CASE "A"
				GOSUB ResetScreen
			CASE "E"
				GOSUB ResetScreen
				GOTO GetServer1
			CASE ELSE
				GOTO GetServer2
		END SELECT

	 ELSEIF XCode = 2 THEN
	GOTO ExitNice
	 ELSEIF XCode > 58 THEN        ' function key pressed

		ScanCode = XCode
		GOSUB SelectScanCode
		IF ScanCode >= 59 AND ScanCode <= 69 THEN GOTO GetServer1

	 END IF

IF LEN(Server$) < 1 THEN    ' no server name given
	GOSUB ClearArea
	BEEP
	LOCATE 14, 5: CALL MQPrint(" Please enter a server name ... ", 4)
	SLEEP 4
	GOSUB ResetScreen
	GOTO GetServer1
END IF

	 GOSUB ResetScreen

GetMessage1:
	T$ = SPACE$(11)     ' create empty string for date information
	CALL SysTime(T$)    ' get system time
	LOCATE 4, 65: CALL MQPrint(" " + LEFT$(T$, 5) + " ", 3)' display truncated time stamp
	LOCATE 2, 65: CALL MQPrint(" " + DATE$ + " ", 3)    ' display date stamp
	LOCATE 5, 2: CALL MQPrint(" Enter the message you wish to send ", 3)
	LOCATE 7, 5: CALL MQPrint(" ESC to abort; ENTER to submit message ", 3)

GetMessage2:
	MaxMessLen = 45    ' maximum allowable length of Novell SEND message
	NumOnly = 0 ' accept mixed alphanumeric symbols
	CapsOn = 0  ' do not capitalize all message characters
	LOCATE 10, 5

	MaxMessLen = MaxMessLen - LEN(CurrentUser$)   'truncate message for user's name
	CALL TextIn(SendMessage$, MaxMessLen, NumOnly, CapsOn, XCode, TextColr)

	 IF XCode = 0 OR XCode = 1 THEN
		 LOCATE 12, 5: PRINT " Do you wish to (E)dit or (S)end the message? "

		 CALL GetQuery(Query$, ScanCode, XCode)
		 IF ScanCode > 58 THEN GOSUB SelectScanCode
		 SELECT CASE Query$
			 CASE "S"
				 GOSUB ResetScreen
			 CASE "E"
				 GOSUB ResetScreen
				 GOTO GetMessage1
			 CASE ELSE
				 GOTO GetMessage1
		 END SELECT

  ELSEIF XCode = 2 THEN         ' back up to last option
     GOSUB ResetScreen
     GOTO GetServer1
  ELSEIF XCode > 58 THEN        ' function key pressed

	 ScanCode = XCode
	 GOSUB SelectScanCode
	 IF ScanCode >= 59 AND ScanCode <= 69 THEN GOTO GetMessage1

  END IF

  GOSUB ResetScreen

IF LEN(SendMessage$) < 1 THEN
	GOSUB ClearArea
	BEEP
	LOCATE 14, 5: CALL MQPrint(" Must have at least one character in your message ... ", 4)
	SLEEP 4
	GOSUB ResetScreen
	GOTO GetMessage1
END IF

ReplaceChar2 SendMessage$, CHR$(32), CHR$(255)  ' replace spaces in message

CLS
MPaintBox 1, 1, 25, 80, Cnf.NonMen   ' initialize background color
LOCATE 2, 5: CALL MQPrint("Getting user list ... please wait", 3)
PRINT
SLEEP 1

' get current directory, and save for cleanup routine

drive$ = CHR$(GetDrive%) ' returned as decimal equiv of UCASE drive letter
						 ' then changed to drive letter

StartDir$ = GetDir$(GetDrive%)    ' get current default directory string

StartPath$ = drive$ + ":" + StartDir$' full default directory spec

IF TempFilePath$ = "" THEN        ' make temp files in current dir
	TempFilePath$ = StartPath$    ' if S_FILEDIR not set in env
ELSE
	CALL CDir(TempFilePath$)
END IF

n = 1   ' if a temp file already exists then increment the last character
        ' of the extension by one. Note : this will crap out on large
        ' (>99 user) network if everyone were to send a message at the
        ' same time.
DO
	n$ = STR$(n)
	TempFileName$ = TempFilePath$ + "usertemp." + LTRIM$(RTRIM$(n$))
	IsHere = Exist%(TempFileName$)  ' create unique temp file

	IF IsHere% = true THEN
		n = n + 1
	ELSE
		EXIT DO
	END IF
LOOP

SHELL "userlist >" + TempFileName$      ' get user names from USERLIST
										' C API or DOS calls would be nicer here
count = 1

' pull data from USERLIST apart, and place into variables

		OPEN TempFileName$ FOR INPUT AS #1         ' get user names

		LINE INPUT #1, InString$            ' throw away 1st line
		LINE INPUT #1, ServerName$          ' get server name
				ServerName$ = MID$(ServerName$, 29, 15)
		LINE INPUT #1, InString$            ' throw away 3rd line
        LINE INPUT #1, InString$            ' throw away 4th line

		DO
				LINE INPUT #1, InString$                        ' get body of data
			 
				ConnectionNum$(count) = MID$(InString$, 4, 2)   ' connection number
				UserName$(count) = MID$(InString$, 13, 15)      ' user name

				LoginInStatus$ = MID$(InString$, 11, 1)         ' get status
						'IF LogInStatus$ = "*" THEN
						'        UserName$(count) = CurrentUser$
						'END IF
						' not used in this version - getting info from environment

				LoginDate$(count) = MID$(InString$, 29, 8)       ' user login date
				LoginTime$(count) = MID$(InString$, 40, 8)       ' user login time

				count = count + 1
		LOOP UNTIL EOF(1)

CLOSE #1

'clean up temporary files, and reset original directory

CALL KILLFILE(TempFileName$)

IF TempFilePath$ <> StartPath$ THEN
	CALL CDir(StartPath$)
END IF

GetUserNames:
REDIM items$(count + 1)               'Dim the "Items$" array

FOR n = 1 TO count              'Pad elements to 15 for names
    items$(n) = SPACE$(18)            ' plus three for check marks
NEXT

FOR n = 1 TO (count)            ' feed userlist info into ITEM
    items$(n) = UserName$(n)
NEXT
items$(count) = "EVERYONE"          ' for global messages

MaxNum = MinInt%(20, count)             'Allow up to 20 users to be picked
REDIM picked(MaxNum)                    'Dim the array

'----- Print instructions
CLS
LOCATE 2, 30: CALL MQPrint(" Select users who will receive message with ", 3)
LOCATE 3, 30: CALL MQPrint(" ENTER or SPACEBAR keys, and/or mouse. ", 3)
SRING1$ = " Choose up to "
SRING2$ = " users. "
LOCATE 5, 30: CALL MQPrint(SRING1$ + STR$(MaxNum) + SRING2$, 3)
LOCATE 7, 30: CALL MQPrint("Press [ESC] when done.", 3)
LOCATE 3, 2, 0                           'Turn the cursor off
PRINT

CALL TextCursor(-2, -2)                 'set mouse colors to inverse
CALL ShowCursor                         'Turn it on


'----- pick network user names
PickList items$(), picked(), NPicked, Cnf
CALL HideCursor                         'Turn the Mouse cursor off


'----- Show what they picked
IF NPicked <= 0 THEN
	 BEEP
	 LOCATE 20, 5: PRINT SPC(75);
	 LOCATE 20, 5: CALL MQPrint(" No users selected ... exiting ", 4)
	 SLEEP 4
	 SYSTEM
END IF

GOSUB ResetScreen

IF NPicked THEN
	FOR n = 1 TO NPicked                 'check that EVERYONE and individuals aren't coincident
	     IF items$(picked(n)) = "EVERYONE" AND NPicked > 1 THEN
		 BEEP
		 LOCATE 20, 5: PRINT SPC(75);
		 LOCATE 20, 5: CALL MQPrint(" Do not select both individual users and the group EVERYONE! ", 4)
		 SLEEP 4
		 GOSUB ResetScreen
		 GOTO GetUserNames
	    END IF
	NEXT n
END IF

LOCATE 6, 18: CALL MQPrint(MidLine$, 8)                    ' draw message box/display message
LOCATE 8, 18: CALL MQPrint(MidLine$, 8)
LOCATE 6, 20: CALL MQPrint("Current message reads  :", 3)
LOCATE 5, 18: CALL MQPrint(TopLine$, 8)

LOCATE 7, 18: CALL MQPrint(MidLine$, 8)

LOCATE 9, 18: CALL MQPrint(BottomLine$, 8)
LOCATE 8, 20: CALL MQPrint(SendMessage$, 3)
LOCATE 12, 20: CALL MQPrint("Sending message ...", 3)
SLEEP 4

LOCATE 7, 2                               'Place window on line 7
IF NPicked THEN
	FOR n = 1 TO NPicked                 'send message to each user name picked
	CLS
	ShellLine$ = "SEND " + CHR$(34) + SendMessage$ + CHR$(34) + " " + Server$ + "/" + items$(picked(n))
	SHELL ShellLine$
	NEXT
END IF
SLEEP 5         'wait a few seconds to allow text from SEND command (error messages
CLS             'and conformation of message sends) to display


GetOut:
CLS
SYSTEM

'\*  subroutines \*

ExitNice:
GOSUB ClearArea
	
	IF LEN(ErrorMsg$) = 0 THEN
		LOCATE 14, 5: CALL MQPrint("Returning to system ...", 20)
		CLOSE
		SLEEP 2
		GOTO GetOut
	ELSE
		LOCATE 12, 5: CALL MQPrint(ErrorMsg$, 4)
		LOCATE 14, 5: CALL MQPrint("Returning to system ...", 20)
		LOCATE 15, 5: CALL MQPrint("Hit any key to exit", 4)
		WaitKey
		CLOSE
		GOTO GetOut
	END IF

SetColor:
	IF Peek1%(0, &H463) = &HB4 THEN      'mono monitor
	   FG = 0
	   BG = 7
	ELSE                                 'color
	   FG = 7
	   BG = 1
	END IF

	colr = OneColor%(FG, BG)             ' pack FG and BG into a single byte
	TextColr = colr + 26                 ' color of text input bars
	CLS
	MPaintBox 1, 1, 25, 80, Cnf.NonMen   ' initialize background color
RETURN

ResetScreen:
	CLS
	MPaintBox 1, 1, 25, 80, Cnf.NonMen   ' initialize background color
	LOCATE 2, 2: CALL MQPrint(" Novell SEND front end ", 3)
	LOCATE 23, 5: CALL MQPrint(BottomMsg$, 3)   'function key menu
RETURN

SelectScanCode:

SELECT CASE ScanCode

	 CASE 59                ' F1  - help
		 GOSUB HelpMessage
		 GOSUB ResetScreen
     CASE 61                ' F3  - calculator
	 Row = 4: Column = 55
	 SELECT CASE Monitor%            'see what type of monitor is present
	    CASE 3, 5, 7, 9, 10, 12      'CGA, EGA, VGA color
	       FG = 11
	       BG = 1
	    CASE ELSE                    'monochrome
	       FG = 15
	       BG = 0
	 END SELECT

	 CALL NumOn              'turn on the NumLock key
	 CALL Calc(Row, Column, FG, BG)
	 CALL NumOff
     CASE 63                ' F5  - calendar
	 SELECT CASE Monitor%            'see what type of monitor is present
	    CASE 3, 5, 7, 9, 10, 12      'CGA, EGA, VGA color
	       Colr1 = 1
	       Colr2 = 14
	    CASE ELSE                    'monochrome
	       Colr1 = 2
	       Colr2 = 15
	 END SELECT
'         Colr1 = 2: Colr2 = 15   'b/w calendar colors (try 66 and 77 for CGA/EGA)
	 ULRow = 3: ULCol = 52   'upper left corner of calendar

	 Month = VAL(LEFT$(DATE$, 2))    'take today's date from DOS
	 Year = VAL(RIGHT$(DATE$, 4))
	 Day = VAL(MID$(DATE$, 4, 2))

	 Action = 1                      'display the calendar
	 CALL Calendar(Month, Day, Year, ULRow, ULCol, Colr1, Colr2, Action)
	 CALL WaitKey

	 Action = 0                      'remove the calendar
	 CALL Calendar(Month, Day, Year, ULRow, ULCol, Colr1, Colr2, Action)
	 CASE 68                ' F10 - exit
		 GOTO ExitNice
	 CASE ELSE
		 GOSUB ResetScreen
	 END SELECT

RETURN

GetEnv:

GetEnvMsg1$ = "and bypass these informational messages."

'  Saber Menu environment strings used in this program
'  S_SERVER=SERVERNAME      current server
'  S_USER=SUPERVISOR        current user
'  S_FILEDIR=F:\TRASH\      this is where temporary files will be written
'                           F:\TRASH is a directory with all but parental
'                           rights for the creation of transient files

	Server$ = ENVIRON$("S_SERVER")             ' Saber Menu's format
	IF LEN(Server$) = 0 THEN
		BEEP
		GOSUB ClearArea
		LOCATE 14, 5: CALL MQPrint("Cannot find S_SERVER environment string for default server", 3)
		LOCATE 15, 5: CALL MQPrint("setting. If you wish, you can add one to your login script", 3)
		LOCATE 16, 5: CALL MQPrint(GetEnvMsg1$, 3)
		CALL GetQuery(Query$, ScanCode, XCode)
		GOSUB SelectScanCode
	END IF

	CurrentUser$ = ENVIRON$("S_USER")           ' Saber Menu's format
	IF LEN(CurrentUser$) = 0 THEN
		BEEP
		GOSUB ClearArea
		LOCATE 14, 5: CALL MQPrint("Cannot find S_USER environment string for current user", 3)
		LOCATE 15, 5: CALL MQPrint("setting. If you wish, you can add one to your login script", 3)
		LOCATE 16, 5: CALL MQPrint(GetEnvMsg1$, 3)
		CALL GetQuery(Query$, ScanCode, XCode)
		GOSUB SelectScanCode
	END IF

	TempFilePath$ = ENVIRON$("S_FILEDIR")      ' Saber Menu's format
	IF LEN(TempFilePath$) = 0 THEN
		BEEP
		GOSUB ClearArea
		LOCATE 14, 5: CALL MQPrint("Cannot find S_FILEDIR environment string for temporary", 3)
		LOCATE 15, 5: CALL MQPrint("file directory. If you wish, you can add one to your login script", 3)
		LOCATE 16, 5: CALL MQPrint(GetEnvMsg1$, 3)
		LOCATE 18, 5: CALL MQPrint("Will use the default directory, but you may have insufficient", 3)
		LOCATE 19, 5: CALL MQPrint("rights to continue.", 3)
		CALL GetQuery(Query$, ScanCode, XCode)
		GOSUB SelectScanCode
	END IF

RETURN

HelpMessage:
	FOR x = 1 TO 14
	READ L$
	message$ = message$ + L$
	NEXT x

	DATA "This program is a front end to the Novell Advanced Netware v2.15 SEND command. "
	DATA "It expects Saber MENU v4.00+ compatable "
	DATA "S_FILEDIR, S_SERVER, and S_USER environment variables to be "
	DATA "available in the DOS environment, but may work without them (if the user has sufficient "
	DATA "rights in the default directory). The 'default server' field is filled from "
	DATA "S_SERVER, and temporary files are created in S_FILEDIR. You can edit, and have the "
	DATA "opportunity to re-edit the server name. Once accepted, you are prompted to enter a "
	DATA "message (which you can re-edit before sending). Finally, USERLIST is run "
	DATA "to list the network users currently online, and allow you to send the message to whomever "
	DATA "you select. The default group name EVERYONE is also included for global message "
	DATA "broadcasts. This program has been tested on an EGA Packard Bell PB286 running DOS v3.30, "
	DATA "SEND v1.11, and USERLIST v2.10. Legal text input box commands are {home}, {left}, {right}, {up}, {end}, "
	DATA "{del}, {backspace}, {tab}, and {AltC} (which erases all text). "
	DATA "As an added bonus, both a simple calculator and calendar are provided. "

	Wdth = 64               'a box 68 characters wide will be centered on screen
	LOCATE 3                'the top of the box goes on line 3

	CALL MsgBox(message$, Wdth, Cnf)
	CALL WaitKey            ' retrun after a key is pressed
	CALL MsgBox("", 0, Cnf) 'reset msgbox
	message$ = ""
	RESTORE HelpMessage
RETURN
   
ClearArea:
	LOCATE 11, 1: PRINT SPC(80);    ' clear away any displayed text
	LOCATE 12, 1: PRINT SPC(80);    ' to accentuate message
	LOCATE 13, 1: PRINT SPC(80);
	LOCATE 14, 1: PRINT SPC(80);
	LOCATE 15, 1: PRINT SPC(80);
	LOCATE 16, 1: PRINT SPC(80);
	LOCATE 17, 1: PRINT SPC(80);
	LOCATE 18, 1: PRINT SPC(80);
	LOCATE 19, 1: PRINT SPC(80);
	LOCATE 20, 1: PRINT SPC(80);
RETURN


DOShandler:
	' DOS error trapping
	GOSUB ClearArea
	SELECT CASE ERR
		CASE 5
		ErrorMsg$ = "Illegal function call"
		GOTO ExitNice
		CASE 6
		ErrorMsg$ = "Overflow ... "
		GOTO ExitNice
		CASE 7
		BEEP: BEEP
		ErrorMsg$ = "Insufficient memory space"
		GOTO ExitNice
		CASE 9
		BEEP: BEEP
		ErrorMsg$ = "Subscript out of range"
		GOTO ExitNice
		CASE 11
		BEEP: BEEP
		ErrorMsg$ = "Division by zero"
		GOTO ExitNice
		CASE 13
		BEEP
		ErrorMsg$ = "Type mismatch"
		GOTO ExitNice
		CASE 14
		BEEP
		ErrorMsg$ = "Out of string space"
		GOTO ExitNice
		CASE 24
		ErrorMsg$ = "DOS reports a device timeout."
		GOTO ExitNice
		CASE 25
		BEEP
		ErrorMsg$ = "DOS reports a device fault."
		GOTO ExitNice
'        CASE 27     'printer out of paper. Don't care in this applicaton
		CASE 52
		BEEP
		ErrorMsg$ = "A 'bad file name or number' fault has occured"
		GOTO ExitNice
		CASE 53
		ErrorMsg$ = "A 'file not found' fault has occured."
		GOTO ExitNice
		CASE 54
		ErrorMsg$ = "A 'bad file mode' fault has occured."
		GOTO ExitNice
		CASE 55
		ErrorMsg$ = "A 'file already open' error has occured."
		GOTO ExitNice
		CASE 56
		 ErrorMsg$ = "DOS error - FIELD statement active"
	CASE 57
		 ErrorMsg$ = "DOS reports 'Device I/O error'"
		 GOTO ExitNice
		CASE 58
		 ErrorMsg$ = "DOS reports 'file already exists'"
		 GOTO ExitNice
		CASE 59
		 ErrorMsg$ = "DOS reports 'bad record length'"
		 GOTO ExitNice
		CASE 61
		 BEEP: BEEP: BEEP
		 ErrorMsg$ = "DOS reports 'disk full' "
		 GOTO ExitNice
		CASE 62
		 ErrorMsg$ = "DOS reports 'input past end of file'"
		 GOTO ExitNice
		CASE 63
		 ErrorMsg$ = "DOS reports 'bad record number'"
		 GOTO ExitNice
		CASE 64
		 ErrorMsg$ = "The 'bad file name' error has occured"
		 GOTO ExitNice
		CASE 75 TO 76
		 ErrorMsg$ = "Bad path"
		 GOTO ExitNice
	CASE ELSE
		 CLS
		 'GOSUB ClearArea
		 LOCATE 11, 5: CALL MQPrint("An untrapped error has occured. Please note the error", 4)
		 LOCATE 12, 5: CALL MQPrint("code, and report it to me. Hit any key to continue.", 4)
		 LOCATE 14, 5: CALL MQPrint("The error code is" + STR$(ERR), 4)
		 PRINT
		 CALL WaitKey
	END SELECT
GOTO ExitNice


'revision history
'
'08/08/90   Wrote initial version to fix problem with using SEND
'v1.00á     from a batch file (i.e. - as with Saber Menu).
'           Bare minimum .. could be improved w/o too much effort
'
'08/09/90   Added support for Saber Menu environment strings
'v1.10á     Changed temporary file creation for unique filenames (to avoid
'           problems when multiple users are sending messages simultaneously)
'           Added group EVERYONE as 'built-in' global SEND recipient
'
'08/11/90   Added display of current time and date at message input screen
'v1.20á     Added command line parameter handling (not tested)
'           Added help and error message boxes    (not tested)
'           Experimented with color combinations
'
'08/22/90   Truncated date display to hr:min format. Rework help screen.
'v1.30á     Drop command line parameter options. Rework input routines.
'           Comment source code. Tested on 3270 graphics adaptor. Added
'           calculator and calendar. Final beta. Released into user community.
'           Note : Made changes in QPRO TEXTIN.BAS module. Renamed TEXTIN2.BAS

REM $STATIC
SUB GetQuery (Query$, ScanCode, XCode)
	DO
	Query$ = INKEY$
	LOOP WHILE Query$ = ""
	Query$ = UCASE$(Query$)

   IF LEN(Query$) > 1 THEN      ' scan code, not character
	  Query$ = RIGHT$(Query$, 1)
	  IF XCode > 58 THEN
		  ScanCode = VAL(LTRIM$(RTRIM$(STR$(XCode))))
	  ELSEIF ASC(Query$) > 58 THEN
		  ScanCode = ASC(LTRIM$(RTRIM$(Query$)))
	  END IF
   ELSE
	  ScanCode = VAL(Query$)
   END IF

   XCode = 0
END SUB