Category : Communication (modem) tools and utilities
Archive   : ASPHST.ZIP
Filename : SUBS1.INC

 
Output of file : SUBS1.INC contained in archive : ASPHST.ZIP
;**************************************************************************
;* *
;* SUBS1.INC (C) 1992 DATASTORM TECHNOLOGIES, INC. *
;* An ASPECT header file containing procedures facilitating user *
;* login for the 2.0x scripted host mode. *
;* *
;**************************************************************************

;**************************************************************************
;* ÉÍÍÍ» *
;* º A.º SETUP *
;* ÈÍÍͼ *
;**************************************************************************

proc Setup

$ifdef DEBUG ; set some vars if debugging:
set ASPDEBUG ON ; Put offsets in error Msgs
set RANGECHK ON ; Do range checking
$endif

set KEYS ON ; we do all keys
set RXDATA ON ; we do all incoming data
set DUPLEX FULL ; expect remote to echo
set EMULATION ANSI ; set emulation to ansi

set ZMODEM AUTODLOAD OFF ; Don't autodownload on host
set ZMODEM ERRDETECT CRC32 ; Use 32-bit CRC
set ZMODEM RECVCRASH PROTECT ; Don't let users overwrite
set ZMODEM SENDCRASH NEGOTIATE ; Let user recover downloads
set ZMODEM TIMESTAMP OFF ; Stamp files w/system date/time
set ZMODEM TXMETHOD STREAMING ; Use fastest transmit method

fetch HOST GOODBYE HOSTGBYE ; Get Goodbye Action
fetch HOST ULDIR HOSTuldir ; Get Upload Directory
fetch ASCII DN_TO ATIMEOUT ; Get ASCII Timeout
fetch CDINXFER HOSTCDXFER ; Monitor CD?
fetch HOST AUTOBAUD HAUTOBAUD ; Get autobaud detect

fetch HOST SYSTYPE SYSTEMTYPE ; Get SystemType (OPEN|CLOSED)
fetch BAUDRATE SU_BAUDRATE ; Get initial baudrate
; This is necessary in
; order to restore maximum
; baudrates.
fetch PORT N0 ; Get current port
strfmt HostShellPort "COM%i" N0 ; Define Host Port
FilterCtrl = 1 ; Filter incoming control chars
endproc

;****************************************************************************
;* Setup modem & various system variables *
;****************************************************************************

proc ModemInit
string Temp

statMsg "Configuring Host"
LoginFail = 0 ; Reset failed login flag
fetch HOST CONNECTION ConType ; Fetch Connection Type
; privileged user.
set REMOTECMD OFF
strfmt S0 "CD %s" St_Dir ; Format string
dos S0 NoClear ; Change to startup dir

LCFlag = 0 ; Reset Lost Carrier Flag
if ConType == DirectType ; Check for direct connection
return
endif

statMsg "Initializing Modem - Please Wait ..."
if !CONNECTED
set BAUD SU_Baudrate ; Set/Restore Baudrate
endif ; Check CD in case it's a

;********************************************************************
;* The following If CONNECTED test can be used to force the modem *
;* to hang up, every time host is started. It's commented out to *
;* allow privileged users to abort host, then restart with a remote *
;* command. *
;********************************************************************
; if CONNECTED ; Online?
; call hosthangup ; If so, hangup
; endif

if CONNECTED ; Connected?
return ; return, could be user
endif ; starting w/ remote command

transmit "AT^M" ; to set modem speed
waitfor "OK" 3 ; waitfor the "OK"

fetch MODEM AUTOANSON Temp ; Get Autoanswer String
transmit Temp ; Send Autoanswer String
waitfor "OK" 3 ; waitfor the "OK"
endproc


;**************************************************************************
;* ÉÍÍÍ» *
;* º B.º WAITFORCALL *
;* ÈÍÍͼ *
;**************************************************************************
proc WaitForCall

string ConnectMsg ; connect message
integer ConnectSpd ; connection speed
integer AnyKey ; Keystrokes
integer Char
integer Normal,Inverse,hilite ; Color variables
string Start ; Start Blanker Time
long LTemp ; Long Temporary Variable

fetch HOST DLDIR HostDlDir ; Get Download Directory
ODir = HostDlDir ; Get Original DL directory
ONam = "Default Access" ; Set Original DL Name
HostDlNam = ONam ; Set Default DL Name

fetch HOST MESSAGE HOSTWELCOM ; Fetch Host Welcome Message
fetch TERMNORM CNorm ; Fetch Normal Color Attribute
time Start 0 ; Get Current Time
LLogin=0 ; Set local login off
; in case previous login
; was local
call GetTermColors with &Normal &Inverse &Hilite

Next:

clear CNorm ; Clear with Normal attributes
box 4 17 19 67 0 ; Shadow Box
box 3 15 18 65 Normal ; Info Box

fatsay 3 29 Normal "] Scripted Host - %s [" version ;* Information
atsay 18 29 Normal "] Connect Type - [" ;* bars

atsay 17 17 Normal " Log:"
if LogIt ;*
atsay 17 23 Hilite "ON " ;** If Log active,
else ;** display active
atsay 17 23 Hilite "OFF " ;*
endif

atsay 17 33 Inverse "F2"
atsay 17 36 Normal "- Local Login"

if ConType == ModemType ;*
atsay 18 46 Normal "Modem" ;** Display connection
else ;** type, from setup
atsay 18 46 Normal "Direct" ;*
endif

box 4 28 6 54 Normal
atsay 5 30 hilite "LAST CALLER INFORMATION";*
atsay 7 20 Normal "Name:" ;**
atsay 8 20 Normal "Baud:" ;***
atsay 9 19 Normal "Level:" ;****
atsay 10 17 Normal "Elapsed:" ;*****
atsay 11 18 Normal "Online:" ;****
atsay 12 17 Normal "Offline:" ;*** Display Title, Options
atsay 14 17 Normal "Current:" ;** and Constants
atsay 16 17 Normal "Page:" ;*
atsay 17 18 Normal "Log:"

atsay 17 18 Inverse "L"
atsay 16 17 Inverse "P" ;*** Highlight Option Keys

if LogIt ;*
atsay 17 23 Hilite "ON " ;** If Log active,
else ;** display active
atsay 17 23 Hilite "OFF" ;*
endif

if Pager ;*
atsay 16 23 Hilite "ON " ;** If Pager active,
else ;** display active
atsay 16 23 Hilite "OFF" ;*
endif

if H_Level > -1 ; H_Level < 0 No Last Caller
atsay 7 26 Inverse H_Name ;*
fatsay 8 26 Inverse "%ld" H_Baud ;**
fatsay 9 26 Inverse "%d " H_Level ;***
call elaps with &H_Elapsed H_Online H_Offline ;**** Last call info
atsay 10 25 Inverse H_Elapsed ;***
atsay 11 26 Inverse H_Online ;**
atsay 12 26 Inverse H_Offline ;*
else
atsay 7 26 Inverse "Not Available ";*
atsay 8 26 Inverse " " ;**
atsay 9 26 Inverse " " ;*** No Last caller,
atsay 10 26 Inverse " " ;*** display blank fields
atsay 11 26 Inverse " " ;**
atsay 12 26 Inverse " " ;*
endif

set KEYS ON ; Let script handle KeyStrokes
set RXDATA ON ; and incoming data

if ConType == ModemType ; If connection is modem
if CONNECTED ; If CD already high, presume
; connection has already
; been established &
; proceed to login.
fetch BAUDRATE LTemp ; Get autobaud setting
goto LogOn ; Jump to login
endif
rflush ; Flush receive buffer
while 1 ; Loop forever
strfmt S0 "%s %s " $TIME0 $DATE ; format time/date string
atsay 14 26 Inverse S0 ; display time/date string
; Calculate elapsed time
call Elapsed with &Blanktime Start $TIME0
if ((BlankTime > BlankTimeout) && !CONNECTED) && Blanker
call BlankIt with &Start ; blank screen if needed
endif

if HITKEY ; Look for keyhit
keyget AnyKey ; Get key
call ProcKey with &AnyKey Inverse ; Process key, return value in
; AnyKey, if needed
if !SUCCESS ; Problem?
LLogin = 0 ; Reset Local Login
call FlushIt ; Flush buffers
goto next ; reset for next caller
endif

if AnyKey == 0
loopwhile
endif

if AnyKey == -999 ; Look for logon,set by proc_key
atsay 0 1 Inverse "Local Login" ; Display local login
goto Logon ; Goto Logon
else
AnyKey = 0 ; Reset AnyKey
endif

if AnyKey == -111 ; Look for start reset
Start = $TIME0 ; Reset Start timer
AnyKey = 0 ; Reset AnyKey
endif
endif

;********************************************************************
;* This is the AUTOBAUD function. Get the MODEM CONNECT message, *
;* ATOI will strip out Alpha characters and leave a number. Use *
;* this integer for the SWITCH to set the actural baudrate. *
;* *
;* Note: You may have to change the "CONNECT" message to reflect *
;* the messages returned by your particular modem. You may also *
;* have to change the timeout on the WAITFOR command line. *
;********************************************************************
if COMDATA ; If data at port
waitfor "ONNECT" 10 ; waitfor MODEM connect Msg
; wait up to 10 seconds.
; We drop the First char
; in the waitfor string
; because we lose 1 char
; with to the comdata.
if !WAITFOR ; If waitfor timedout
rflush ; flush receive buffer
goto Next ; reloop.
endif

if !HAutobaud
goto Logon
endif

rget ConnectMsg 40 ; get speed from connect Msg
atoi ConnectMsg ConnectSpd ; convert message into integer
if HAUTOBAUD ; if MODEM AUTOBAUD is ON then
; set new baudrate.
switch ConnectSpd ; Use C_Speed to set baudrate

case 0
set BAUD 300
endcase
case 1200
set BAUD 1200
endcase
case 2400
set BAUD 2400
endcase
case 4800
set BAUD 4800
endcase
case 9600
set BAUD 9600
endcase
case 19200
set BAUD 19200
endcase
endswitch
endif ; End of AUTOBAUD section
exitwhile
endif
endwhile
else ; Direct Connect
while 1
set CDINXFER NO ; Don't worry about CD during
; a file transfer, because
; a lot of direct connections
; don't support CD
strfmt S0 "%s %s " $TIME0 $DATE; Format date time string
atsay 14 26 Inverse S0 ; Display

call Elapsed with &BlankTime Start $TIME0 ; Calculate elapsed time
if (Blanktime > Blanktimeout) && Blanker ; If Blanker true
call BlankIt with &Start ; Blank screen
endif

comgetc Char ; Look at port, ComGetC will
; return the value of
; character at port, if no
; character exists, it
; returns a -1.
if Char >= 0 ; if return is => 0
exitwhile ; exit loop
endif

if HITKEY
keyget AnyKey ; Get key
call ProcKey with &AnyKey Inverse ; Process key

if !SUCCESS ; Problem?
LLogin = 0 ; Reset Local Login
goto Next ; Reset for next caller
endif

if AnyKey == 0
loopwhile
endif

if AnyKey == -999 ; Look for logon,set by proc_key
return ; Return
else
AnyKey = 0 ; Reset AnyKey
endif

if AnyKey == -111 ; Look for start timer reset
start = $TIME0 ; Reset Start timer
AnyKey = 0 ; Reset AnyKey
endif
endif
endwhile
endif

logon:

pause 1 ; Give everything time to
; "sync" up

call ClearScreen

rflush
call DisplayFile with HostOpenFile 23 ; If Opening exists,display

fetch Baudrate H_Baud ; Get current baudrate
if ConType == ModemType ; If modem connection
strfmt Msg "Remote User Online - %-5li`n" H_Baud
message Msg
if !HAutobaud ; If autobaud is off
fetch BAUDRATE LTemp ; get current baud & display
message "Autobaud detect disabled"
message "Port Settings Not Changed"
endif
else ; If direct connection
strfmt Msg "Remote User Online - Direct Connect`n"
message Msg
endif

call ClearScreen

call DisplayFile with HostNWSFile 23 ; If News file exists, display

call ClearScreen

message $NULL
call HostPutS with "`r`n"
call HostPutS with HOSTWELCOM
call SetSuccess
endproc

;**************************************************************************
;* Function: ProcKey *
;* Purpose: Interpret KeyStroke at main screen *
;* Input: Interger - Key scan code *
;* return: Set key to -999 for local login, else no return *
;* Notes: *
;**************************************************************************

proc ProcKey
intparm KeyStroke ; Key scancode
intparm Inverse ; Inverse video attr
integer AnyKey

call SetSuccess ; Set success true
switch KeyStroke ; Use KeyStroke for switch
; NOTE: The following case
; statements all use
; Keystroke as the test
; variable.

case 0x1B ; "ESC"
call ExitHost with 2 ; Call Exithost
endcase
case 0x3C00 ; "F2"
LLogin = 1 ; Set local login to true
time OnTime 0 ; Set OnTime
clear CNorm ; Clear with Normal colors
curon
atsay 1 1 CNorm "Login as Sysop (Y/n)? "

while 1
locate 1 23 ; Place cursor
keyget AnyKey ; Get key
if (AnyKey==0x6E) || (AnyKey==0x4E) || \
(AnyKey==0x79) || (AnyKey==0x59)
exitwhile ; If (N,n,Y,y) exit loop
endif
endwhile

clear
if (AnyKey==0x6E) || (AnyKey==0x4E) ; Is it "N" or "n"
call HostPutS with HOSTWELCOM
call GetUser ; login Normally
if !SUCCESS ; if failed login
H_Level = -1 ; set no user
call SetFailure ; set Failure flag
LLogin = 0 ; Reset Local Login on Failure
return ; return
endif
else
Access = "2" ; Give priveleged user level
First = "Sysop" ; First Name "Sysop"
Last = "" ; Last NULL
endif

Name = First ; *
strcat Name " " ; ** Build full Name
strcat Name Last ; *

H_Name = Name ; *
strcat H_Name " - Local Login" ; ** Set Waiting screen info
atoi access H_Level ; **
time H_Online 0 ; *

strfmt S0 "%s - Logged On Locally with Level %s" Name Access
call HostLog with "" S0

KeyStroke = -999 ; Jump to logon
message "`n"
endcase

case 0x0070 ; "P"
case 0x0050 ; Toggle page options
if !Pager
Pager = 1 ; Set active
atsay 16 23 Inverse "ON "
else
Pager = 0 ; Set inactive
atsay 16 23 Inverse "OFF"
endif
KeyStroke = 0 ; Reset key
endcase

DEFAULT ;*
sound 300 5 ;**
KeyStroke = 0 ;** reset KeyStroke
endcase ;*
endswitch
endproc

;**************************************************************************
;* Function: NonChar *
;* Purpose: Strip all non alpha/numeric charaters (A-Z,a-z,0-9) *
;* Input: String Variable *
;* return: Stripped String Variable *
;* Notes: *
;**************************************************************************

proc NonChar
strparm Original ; Original string parm
string Temp ; Temp string variable
integer Len,NPos ; Length, & Position integers
integer Char
; Set accepted ranges
integer Range1Low = 65, Range1High = 90 ; 65 = 'A', 90 = 'Z'
integer Range2Low = 97, Range2High = 122 ; 97 = 'a', 122 = 'z'
integer Range3Low = 48, Range3High = 57 ; 48 = '0', 57 = '9'
integer ECRng1Low = 128, ECRng1High = 154 ; * additinal range checking
integer ECRng2Low = 160, ECRng2High = 165 ; * for EC community

strLen Original Len ; Get Length of Original
NPos = 0 ; Set string pointer 0
while (NPos < Len) && (Len>0) ; while (pointer < Length) &
; (Length > 0)
strpeek Original NPos Char ; Look at character

; If value is within the
; acceptable ranges move on
; to next character.
; Note: the backslash '\'
; allows the command
; to continue on to
; the next line.

if (((Char>=Range1Low)&&(Char<=Range1High)) || \
((Char>=Range2Low)&&(Char<=Range2High)) || \
((Char>=Range3Low)&&(Char<=Range3High)) || \
Char==32)

if ECFlag
if !(((Char>=ECRng1Low) && (Char<=ECRng1High)) || \
((Char>=ECRng2Low) && (Char<=ECRng2High)) || \
((Char>=Range1Low) && (Char<=Range1High)) || \
((Char>=Range2Low) && (Char<=Range2High)) || \
((Char>=Range3Low) && (Char<=Range3High)) || \
(Char==32))
goto StripIt
endif
endif

inc NPos ; Inc pointer
loopwhile ; Loop to While
endif

StripIt:

substr Temp Original 0 NPos ; Set Temp = to characters
; upto invalid character
inc NPos ; Inc pointer past invalid char
substr Original Original NPos Len ; Set Orig to all characters
; past invalid character
dec NPos ; Dec pointer, account for lost
; character, the invalid one
dec Len ; Dec Length
strcat Temp Original ; Concatenate Temp & Original
Original = Temp ; Set Original to Temp
endwhile
endproc

;**************************************************************************
;* *
;* Function: GetUser *
;* Purpose: Wait for user to connect and login. *
;* Input: None *
;* return: Script aborts if ESC pressed. Otherwise, the function *
;* won't return without a user. ` *
;* Notes: *
;* *
;**************************************************************************
proc GetUser
while FOREVER ; Loop forever
if HITKEY ; Allow ESC key to exit loop
call XKeyGet with &Tempkey ; Get key if one is hit
endif

if (!CONNECTED) && (ConType==ModemType) && (LLogin == 0)
; If connect type is modem
; && not connect
; && not a local login
Call HostLog with padit "Lost Carrier`n"
call SetFailure
return
endif

call GetUserName ; Get the users Name
if success
call GetUserPswd ; Get the users Password
if success
call ParseUsrRec ; Find and parse user Record
if success ; If found and parsed
time OnTime 0 ; Set OnTime
H_Online = Ontime ; Set H_Online to OnTime
call SetSuccess
return
else
call SetFailure ;Error getting user Record
call HostPutS with "`n`r`n`rInvalid Login AtTempt!`r`n"
LoginFail = 1
return
endif
else
call SetFailure ;Error getting Password
call HostPutS with "`n`r`n`rInvalid Login AtTempt!`r`n"
LoginFail = 1
return
endif
else ;Error getting user Name
call HostPutS with "`n`r`n`rInvalid Login AtTempt!`r`n"
call SetFailure
LoginFail = 1
return
endif
endwhile
endproc

;**************************************************************************
;* *
;* Function: GetUserName *
;* Purpose: Input a user Name *
;* Input: None *
;* return: success if user Name obtained *
;* FAILURE if user not obtained *
;* Notes: *
;* *
;**************************************************************************
proc GetUserName
integer i, Len, tries

tries = 0 ; Init tries to 0
First = $NULL
Last = $NULL

if (!CONNECTED) && (ConType==ModemType) && (LLogin == 0)
; If connect type is modem
; && not connect
; && not a local login
Call HostLog with padit "Lost Carrier`n"
call SetFailure ; set !SUCCESS
return ; return
endif

rflush ; Flush input buffer
while tries < 3 ; while tries < 3
tries++ ; inc tries
call HostPutS with "`r`n`r`nFirst Name: " ; prompt for First Name
call HostGetS with &First NAMEMAX DISP ; Get First (and optionally
; Last Name)
if !SUCCESS ; return FAILURE if CD drops
exitwhile
endif

strLen First Len ; Len = Length of First Name
if Len < 1 ; If Length is < 1
loopwhile ; go to top of loop
endif

strupr First
strcmp First "SYSOP"
if success
Last = " "
goto bypass
endif

find First " " i ; Is there a Last Name? (SPACE)
if not found
find First ";" i ; (Look for SEMICOLON
; if no SPACE)
endif

if found ; YES, there is a Last Name:
strpoke First i 0 ; terminate the First Name
i++ ; i -> 1st character in Last Name
substr Last First i 80 ; uLast is Last Name
else
call HostPutS with "`r`n Last Name: "
call HostGetS with &Last NAMEMAX DISP ; Get Last Name
if !SUCCESS ; return FAILURE if CD drops
exitwhile
endif

strLen Last Len ; Get Length of Last Name
if Len < 1 ; if Length < 1
loopwhile ; loop to while
endif
endif

call NonChar with &First ; Strip non_alpha/numeric chars
call NonChar with &Last ; from First & Last Names
strupr First ; Convert to uppercase
strupr Last ; Convert to uppercase
Name = First ; Name = First
strcat Name " " ; Add space
strcat Name Last ; Append Last

call HostPutS with "`r`n "
call HostPutS with Name

BYPASS:

call HostPutS with "`r`nIs this correct (Y/N)? "
call HostGetYN ; Confirm Name
if success
return
else ; if user says NO
tries-- ; don't count it as a try
endif
endwhile ; Loop to while, if tries < 3
call HostHangup ; Hangup
call SetFailure ; Set Failure
endproc

;**************************************************************************
;* *
;* Function: GetUserPswd *
;* *
;* Purpose: Input a user Password *
;* Input: None *
;* return: success if user Password obtained *
;* FAILURE if Password not obtained *
;* Notes: *
;* *
;**************************************************************************
proc GetUserPswd
integer i, tries

tries = 0 ; Init tries to 0
call HostPutS with "`r`n"
while tries < 3 ; Loop while tries < 3

if (!CONNECTED) && (ConType==ModemType) && (LLogin == 0)
; If connect type is modem
; && not connect
; && not a local login
Call HostLog with padit "Lost Carrier`n"
call SetFailure ;
return ;
endif

call HostPutS with "`r`nPassword: " ; Prompt for Password
strset Password 0 79 ; Set Password to NULL
call HostGetS with &Password PSWDMAX HIDE ; Get Password
call NonChar with &Password ; Strip non alpha characters

if Expose ; if Expose is true
message $NULL ; drop a line
strfmt S0 " %s" Password ; format output
message S0 ; display Password locally
endif

if !SUCCESS ; Problem getting Password
exitwhile ; return
endif

strLen Password i ; Get Length of Password
if i > 0 ; If Length > 0
strupr Password ; convert to uppercase
call SetSuccess ; set success
return ; return
endif
tries++ ; Inc tries
endwhile ; Loop while, until tries > 3
call HostHangup ; hangup
call SetFailure ; set !SUCCESS
LoginFail = 1
endproc

;**************************************************************************
;* *
;* Function: HostGetS *
;* Purpose: Input a character string from the port or local keyboard *
;* Input: string parameter for return value *
;* return: If success, string variable contains the string *
;* FAILURE if connection lost *
;* *
;**************************************************************************
proc HostGetS
strparm S
intparm Max, DoDisp
integer I
string Response

S = $NULL ; Clear s
I = 0 ; i = 0
rflush
while FOREVER ; loop forever
call HostGetC with &Response ; get char, store in Response
if !SUCCESS ; problem?
call SetFailure ; set !SUCCESS
exitwhile ; exit the loop
endif
switch Response ; switch on Response
case "`r" ; Carriage Return?
call SetSuccess ; set success
exitwhile ; exit the loop
endcase
case "`b" ; Backspace ?
if I != 0 ; if i not equal to 0
call HostPutS with "`b `b" ; clear char
I-- ; dec i
strpoke s I 0 ; poke a NULL into s
endif
endcase
case " " ; This SPACE case must immed-
if I == 0 ; iately precede the default so
loopwhile ; it will fall through
endif
DEFAULT ; If not matched above
if i < Max ; if i < max
if DoDisp ; if DoDisp
call HostPutS with Response ; send it to hostputs
else ; if not DoDisp
call HostPutS with "*" ; send "*" to mask it
endif
strcat S Response ; add Response to s
I++ ; inc i
endif
endcase
endswitch
endwhile
endproc

;**************************************************************************
;* *
;* Function: HostGetYN *
;* Purpose: Input a "Y" or a "N" Response *
;* Input: None *
;* return: success if Yes *
;* FAILURE if No or connection lost *
;* *
;**************************************************************************
proc HostGetYN
string Response

while forever ; Loop forever
call HostGetC with &Response ; Get Character
if !SUCCESS ; Problem?
return ; return
endif
strupr Response ; Convert to uppercase
switch Response ; Switch
case "`r" ; Carriage Return
case "Y" ; is it a "Y"
call HostPutS with Response ; Display Char
call SetSuccess ; SetSuccess
exitwhile ; exit loop
endcase
case "N" ; is it a "N"
call HostPutS with Response ; Display Char
call SetFailure ; SetFailure
exitwhile ; exit
endcase
endswitch
endwhile
endproc

;**************************************************************************
;* *
;* Function: HostGetC *
;* Purpose: Input a character from the port or local keyboard *
;* Input: string parameter for return value *
;* return: If success, string variable contains the character. *
;* FAILURE is returned if the connection is lost. *
;* *
;* Notes: *
;* *
;**************************************************************************
proc HostGetC
strparm c
integer i = -1 , tout
string stime

stime = $time0
while i < 0
call elapsed with &tout stime $time0

if tout == WTimeOut ; If elapsed = Warning Timeout
call hostputs with "`r`n`a`aInactivity Warning, you must respond!"
pause 1 ; Pause for 1 sec, allow clock
; to reach next second
endif

if tout == Htimeout ; If elapsed = Hangup Timeout
call hostputs with "`r`n`a`a`aInactivity Timeout, disconnecting... "
call SetFailure ; Timeout
return ; return
endif

if hitkey ; If a key is pressed
call XKeyGet with &i ; get the key
endif
if comdata && (LLogin == 0) ; If data available at port
comgetc i ; get the next character
endif
if (!CONNECTED) && (ConType==ModemType) && (LLogin == 0)
; If connect type is modem
; && not connect
; && not a local login
call HostLog with padit "Lost Carrier`n"
call SetFailure ; set error return code
return ; and return to caller
endif

if filterctrl && ((i>-1) && (i<32)) ; Do we filter control chars?
; and is it a control char
if (i!=8) && (i!=13) ; Yes? Let Backspace (8),
; and Enter (13) thru
loopwhile ; Yes? Get next char
endif
endif
endwhile

key2ascii i c ; Convert scancode to ascii
call SetSuccess
endproc

;**************************************************************************
;* *
;* Function: HostPutS *
;* Purpose: Output a string to the port and the local screen *
;* Input: string to output *
;* return: None *
;* *
;**************************************************************************
proc HostPutS
strparm StrOut
integer Char,Idx

if !LLogin
transmit StrOut ; Transmit to user
endif

Idx = 0 ; Set Idx to 0
strpeek StrOut Idx Char ; Look at First character
while Char > 0 ; if it's not a NULL
writec Char ; write character to screen
Idx++ ; inc Idx
strpeek StrOut Idx Char ; look at next character
endwhile ; loop while
endproc

;**************************************************************************
;* Function: ParseUsrRec *
;* Purpose: Lookup user in .USR file and parse Record into globals *
;* Input: Name is the Name of the user to lookup *
;* return: success if user found and parsed. *
;* FAILURE if user not found or error parsing Record. *
;* Notes: These variables are initialized: *
;* access - User's access level ("0", "1", or "2") *
;* comment - User's comment field *
;* First - User's First Name *
;* Last - User's Last Name *
;* Name - User's full Name (First and Last) *
;* Password - User's Password *
;* Record - Raw Record (terminated with a line feed) *
;* PCPLUS.USR Record: * *
;* LastName;FirstName;Password;n;comment....... *
;* (n is the access level {'0','1',or '2'}) *
;**************************************************************************

proc ParseUsrRec
integer i,atts
string Tmp, Tmp2, VPass

atts = 0

Next_Try:

strcmp First "SYSOP"
if success
Last = $NULL
goto checkit
endif

find Name " " i ; i = index of blank Name separator
strcpy First Name i ; copy First Name
i++ ; i = index of Last Name
substr Last Name i 79 ; extract Last Name

strset H_Name 0 79 ; Clear H_Name
H_Name = First ; H_Name = First
strcat H_Name " " ; Add space
strcat H_Name Last ; Append Last Name

CHECKIT:

strfmt Tmp "%s;%s" Last First ;'Tmp' is what we're looking for
strfmt Tmp2 "%s;%s;%s" Last First Password ;'Tmp2' is new Record
strLen Tmp i ; i = Length of Name part
fopen 1 HOSTUSRFILE "at+" ; Try to open user file
if !SUCCESS
fopen 1 HOSTUSRFILE "WT+" ; Try to open user file
endif
if SUCCESS ; If opened
while not EOF 1 ; loop until end of file
fgets 1 Record ; Get Record
strupr Record ; Convert Record uppercase
strcmp Record Tmp i ; Scan Record for user
if success ; If this is our guy,

n2=i+1 ; Set n2 to 1st letter of Password
inc i ; Set I (index) 1st of pword
n3= 0 ; Set n3 (end of Password) to 0
n1= 0 ; Null Char Check
while (n1 != 59) && (n1 != 32) ; Check for `!` or space
i++ ; Inc Index
n3++ ; Inc End of Pword
strpeek Record i n1 ; Look for at char
endwhile
substr VPass Record n2 n3 ; Extract Password

strLen Tmp2 i

strcmp VPass Password
if success
call CopySFld with &Password Record &i FLD_SEP ; Copy Password
call CopySFld with &access Record &i FLD_SEP ; Copy access level
atoi Access H_Level
if H_Level == 2
set REMOTECMD ON ; Set Remote Commands on
endif
call CopySFld with &Remarks Record &i FLD_SEP ; Copy comment
call AccessRights
call ParseAccess
call SetSuccess ; set return code to TRUE
return ; exit
else
call HostPutS with "`n`rPassword incorrect."
atts++
if atts > 2 ; Give 3 tries at Password
H_Level= -1
call hostputs with "`n`n`rExcessive AtTempts`n`r"
call hostputs with "Logging Off!`r`n`a`a`a`a`r`n"
call HostHangup ; Screwed up, hangup on them
call SetFailure ; Set !SUCCESS
LoginFail = 1 ; Set failed login
return ; Return
endif
call GetUserPswd ; Get his Password
goto Next_Try ; Try again
endif
endif
endwhile
fclose 1 ; Close user file
if SYSTEMTYPE==0 ; if it's a closed system
call HostPutS with "`n`rSorry, this is a closed system.`n`r"
call HostHangup ; Hangup
call SetFailure ; Set !SUCCESS
return
endif
call AddUser ; Add new user
return
else
message "Error opening user file."
endif
call SetFailure
endproc

;**************************************************************************
;* *
;* Function: CopySFld *
;* Purpose: Copy a string field (SFLD) from any position within *
;* the source string, to the destination string. Also, *
;* increment the index by the Length of the field copied. *
;* Input: (&destination,source,&index,field_separator) *
;* return: destination and int are updated. *
;* Notes: Terminates when a field_separator or line feed is *
;* encountered. If neither is encountered, the rest of the *
;* field is copied. *
;* *
;**************************************************************************
proc CopySFld
strparm dst
strparm src
intparm index
intparm fldsep
integer newidx
string endstr,Tmp

substr endstr src index 79 ; copy end of string / local var
key2ascii fldsep Tmp ; Tmp = field separator string
find endstr Tmp newidx ; see if separator is in string
if not found ; If separator not found:
find endstr "\n" newidx ; is a line feed in string?
if not found ; If not:
strLen endstr newidx ; use the whole string
endif
endif
strcpy dst endstr newidx ; copy field
index = index + newidx + 1 ; set caller's index
endproc

;**************************************************************************
;* *
;* Function: HostHangup *
;* Purpose: hangup the MODEM (try several times) *
;* return: Nothing *
;* Notes: *
;* *
;**************************************************************************
proc HostHangup
integer hanguptries=3

if ((!CONNECTED) && (ConType==ModemType)) || (ConType==DirectType)
; If connect type is modem
; && not CONNECTED
call hostputs with "`r`n`r`n`r`n" ; Clear host lines
return ; Return
endif
while hanguptries-- ; While Hangup tries > 0,
; & decrement on every loop
pause 1 ; pause 1
hangup ; Hangup
if !CONNECTED ; If not CONNECTED
exitwhile ; exit while loop
endif
endwhile
if CONNECTED ; If still CONNECTED after
; all of the above, warn
; sysop.
call HostPutS with "`r`n`r`nERROR: Unable to hangup.`r`n"
endif
endproc

;**************************************************************************
;* *
;* Function: BuildDFile *
;* Purpose: Add data directory to start of data files *
;* Input: DataFileString *
;* return: DataDir + DataFileString *
;* *
;**************************************************************************

proc BuildDFile
strparm DataFile
string Temp
integer Len
integer Char

Temp = DataDir ; Temp = path to data files
strLen Temp Len ; Get Length of Temp
dec Len ; Dec by 1 (string index
; starts at 0)
strpeek Temp Len Char ; Check Last character
if !(Char == 92) ; If no `\`
strcat Temp "\" ; Add it
endif

strcat Temp DataFile ; Add backslash to Temp
DataFile = Temp ; Dfile = Temp
endproc

;**************************************************************************
;* *
;* Function: SetFailure *
;* Purpose: set FAILURE to TRUE (same as success not TRUE) *
;* Input: None *
;* return: None *
;* *
;**************************************************************************
proc SetFailure
strcmp "X" "" ; Sets !SUCCESS flag true
endproc

;**************************************************************************
;* *
;* Function: SetSuccess *
;* Purpose: set success to TRUE (same as FAILURE not TRUE) *
;* Input: None *
;* return: None *
;* *
;**************************************************************************

proc SetSuccess
strcmp "" "" ; Sets success flag true
endproc

;**************************************************************************
;* *
;* Function: XKeyGet *
;* Purpose: Pause until a key is pressed and exit script if ESC *
;* Input: None *
;* return: None *
;* *
;**************************************************************************

proc XKeyGet
intparm Key

Keyget Key
if Key == ESC ; Escape Key hit
call ExitHost with 0 ; Exit Host
Key = 0 ; Reset Key
endif

if Key == BSPACE ; Convert backspace Key
Key = 0x08 ; to backspace character
endif

if Key == GREYENTER ; Gray CR
Key = 0x0D ; CR character
endif

if Key> 0x3729 ; Grey Key
Key = Key - 0x3700 ; Normal Key
endif

if Key == 0x3B00
call HostPuts with "`r`n`r`n SYSOP has initiated Chat Mode`r`n"
call Chat
Key = 0
endif

if Key > 255 ; Filter out any high
Key = 0 ; bit Key codes has to be Last
endif ; if/then, so earlier ifs take
; effect.
endproc

;**************************************************************************
;* *
;* Function: GetNewPswd *
;* Purpose: Input a user Password *
;* Input: None *
;* return: success if user Password obtained *
;* FAILURE if Password not obtained *
;* *
;**************************************************************************
proc GetNewPswd

integer i, tries
string NewPswd

tries = 0 ; Set tries to 0
while tries < 3 ; Give them 3 shots at it
call HostPutS with "`n`rPlease verify: " ; Verify Password prompt
call HostGetS with &NewPswd PSWDMAX HIDE ; Get Password
if !SUCCESS ; Problem?
exitwhile
endif
strLen Password i ; Get Length of Password
if i > 0 ; Verify Length > 0
strupr Password ; Convert to uppercase
strupr NewPswd ; Convert to uppercase
strcmp Password NewPswd ; Make sure they match
if success ; OK?
call SetSuccess
return ; Boogey
endif
endif
tries++ ; Inc tries
endwhile ; Loop
call HostHangup ; Hangup on them
call SetFailure ; Set Failure
endproc

;**************************************************************************
;* *
;* Function: AddUser *
;* Purpose: Adds a new user into the PCPLUS.USR file *
;* return: Nothing *
;* Notes: *
;* *
;**************************************************************************
proc AddUser

call GetNewPswd ; Verify Password
if success ; ok
fopen 1 HOSTUSRFILE "at" ; open host user file for append
if success ; ok
strfmt Record "%s;%s;%s;%i;* NEW USER *`n" Last First Password HOSTNEWUSR
itoa HOSTNEWUSR access ; get new user level
H_Level = HOSTNEWUSR ; Set H_Level
fputs 1 Record ; Write Record
fclose 1 ; Close user file
isfile hostnufile ; Does NewUserFile exist?
if success ; It does
call hostputs with "`r`n" ; Space down for NewUserFile
call displayfile with HostNUFile 23 ; Display New User File
call HostPutS with "`r`nHit any key"
call HostGetC with &s0 ; Waitfor Response
call HostPutS with "`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b"
endif
call HostLog with padit "New user added to USR file"
call SetSuccess ; Set success
return
else
message "Error opening user file."
endif
endif
call SetFailure
endproc

;**************************************************************************
;* *
;* Function: Elaps *
;* Purpose: Calculate Elapsed Time Online *
;* return: Elapsed Time String *
;* Notes: *
;* *
;**************************************************************************

proc Elaps
strparm tot,onl,ofl
integer onh,onm,ons,ofh,ofm,ofs
long toton,totoff,totonl
string Temp


substr Temp onl 0 2 ;*
atoi Temp onh ;** Extract Hrs, Mins, & Secs
substr Temp onl 3 2 ;*** convert to integer
atoi Temp onm ;*** store in OnH,OnM,OnS
substr Temp onl 6 2 ;**
atoi Temp ons ;*
substr Temp onl 8 1 ; Extract "AM" or "PM"
strcmp Temp "P" ; Check for PM
if success
onh=onh + 12 ; Add 12 to hours
endif
toton = ons + (onm * 60) + (onh * 3600) ; Total Secs from midnight

substr Temp ofl 0 2 ;*
atoi Temp ofh ;**
substr Temp ofl 3 2 ;***
atoi Temp ofm ;****
substr Temp ofl 6 2 ;*****
atoi Temp ofs ;****** Same as above, except
substr Temp ofl 8 1 ;****** results save in
strcmp Temp "P" ;***** OfH,OfM,OfS
if success ;****
ofh=ofh + 12 ;***
endif ;**
totoff = ofs + (ofm * 60) + (ofh * 3600) ;*

totonl = totoff - toton ; Elapsed time

onh = totonl / 3600 ;*
totonl = totonl%3600 ;**
onm = totonl / 60 ;***Split elapsed components
totonl = totonl%60 ;**
ons = totonl ;*

tot = " " ; Set tot = to a space

if onh > 9 ; if onh > 9
itoa onh Temp ; convert to ascii
strcat tot Temp ; append to tot
endif
if (onh > 0) && (onh < 10) ; if onh between 0 & 10
strcat tot "0" ; add "0" to tot, pads hours
itoa onh Temp ; convert onh to string
strcat tot Temp ; append string to tot
endif
if onh > 0 ; if onh > 0
strcat tot " Hr " ; append HR
endif ;

if onm > 9 ;*
itoa onm Temp ;**
strcat tot Temp ;***
endif ;****
if (onm > 0) && (onm < 10) ;*****
itoa onm Temp ;****** Same procedure as above
strcat tot "0" ;****** results in Mins
strcat tot Temp ;*****
endif ;****
if onm > 0 ;***
strcat tot " Min " ;**
endif ;*

if ons > 9 ;*
itoa ons Temp ;**
strcat tot Temp ;***
endif ;****
if ons > 0 && ons < 10 ;***** Same as above
itoa ons Temp ;***** results in secs
strcat tot "0" ;****
strcat tot Temp ;***
endif ;**
strcat tot " Sec" ;*
endproc

;**************************************************************************
;* *
;* Function: FlushIt *
;* Purpose: Flush Keyboard Buffer, Flush Receive Buffer *
;* return: None *
;* Notes: None *
;* *
;**************************************************************************

proc FlushIt
kflush ; Flushes Keyboard buffer
rflush ; Flushes Receive buffer
endproc

;**************************************************************************
;* Function: ReScreen *
;* Purpose: Restores screen & videomodes *
;* return: *
;* Notes: *
;**************************************************************************

proc Rescreen
switch VidMode ;*
case 1 ;**
set SCREEN 25x80 ;***
endcase ;****
case 2 ;*****
set SCREEN EXTRAX80 ;******
endcase ;******* Reset video mode
case 3 ;******
set SCREEN USERMODE ;*****
endcase ;****
case 4 ;***
set SCREEN extraxuser ;**
endcase ;*
endswitch

if HostCDXfer
set CDINXFER YES
else
SET CDINXFER NO
endif
clear CNorm ; Clear & set video attribute
endproc


  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : ASPHST.ZIP
Filename : SUBS1.INC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/