Category : Communication (modem) tools and utilities
Archive   : TMHOST22.ZIP
Filename : TMHOST22.SCR

 
Output of file : TMHOST22.SCR contained in archive : TMHOST22.ZIP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HOST.SCR by Tsung Hu, 21 May, 1990
;; Modified by Richard Bailey Dec 1990
;; Renamed TMHOST2, see comments throughout file explaining changes.
;; Modified by Bob Wiatr Aug. 1992 to use with Telemate 3.02 & 3.10
;; Renamed TMHOST21.
;; Modified by Bob Wiatr April 18, 1993 to use with Telemate 4.0
;; Renamed TMHOST22

#include "SCREENIO.SCR"

;
; constants
;
EchoToLocal = 1 ; variables set to TRUE
EchoToRemote = 1 ; for SCREENIO routines
TRUE = 1
FALSE = 0
FOREVER = TRUE
TMLOG = "\TMDIR\TM.USE"
FILEDIR = "\HOST.DIR" ; temp. file for F)ile command
MENUCOMMAND = " Minutes left. Enter Command  "
XPERTCOMMAND = " Minutes left. Enter Command (? for help)  "
TMHOST = "*** TMHOST BBS VER. 2.2 beta ***"

;
; global variables
;
integer access,addmsg,areanum,exist,mail,mins,msgmail,msgread,msgs,ontime
integer reply,savedmsg,timeleft,userlevel,xpert
integer NEWUSERLEVEL,NUSERLEVEL,SYSOPLEVEL,DETECTBAUD,INITIALBAUD,YELLTIME
integer YELLSOUND,LOCAL,COUNT

string area,ch,filename,logontime,name,now,password,subject,today
string GENBKCOL,HEADERBKCOL,GENTEXTCOL,HEADERTEXTCOL,HILITECOL,MSGBASE
string totalmsgs,username,wdate
string SPECIALTEXTCOL,LOCALBOXCOL,LOCALCOL,TMDIR,HOSTDIR,DOWNLOADDIR
string MSBASE0,MSBASE1,MSBASE2,MSBASE3,MSBASE4,MSBASE5,MSBASE6,MSBASE7
string MSBASE8,MSBASE9
string area0,area1,area2,area3,area4,area5,area6,area7,area8,area9


Procedure HostConfig ; read the configuration file
string s,ch ; TMHCFG.HST from the current directory
open "TMHCFG.HST"
if success
read s
atoi s,NEWUSERLEVEL ; new user level
read s
atoi s,NUSERLEVEL ; normal user level
read s
atoi s,SYSOPLEVEL ; sysop level
read s
atoi s,DETECTBAUD ; detect baud rate
read s
atoi s,INITIALBAUD ; initial baud rate
read s
atoi s,YELLTIME ; yell time
read s
atoi s,YELLSOUND ; yell sound
read TMDIR
read HOSTDIR ; directory containing H*.HST
read DOWNLOADDIR ; download directory
; (upload always go to Telemate
; downlaod directory)
read GENBKCOL ; general background colour
read GENTEXTCOL ; general text colour
read HILITECOL ; hilite colour
read HEADERBKCOL ; header background colour
read HEADERTEXTCOL ; header text colour
read SPECIALTEXTCOL ; e.g. questionnaire text colour
read LOCALBOXCOL ; local box colour e.g. starting Host mode
read LOCALCOL ; local text colour
read s
atoi s,COUNT ; number of message areas
read area0 ; message areas
read MSBASE0 ; and files
read area1
read MSBASE1
read area2
read MSBASE2
read area3
read MSBASE3
read area4
read MSBASE4
read area5
read MSBASE5
read area6
read MSBASE6
read area7
read MSBASE7
read area8
read MSBASE8
read area9
read MSBASE9
read s
atoi s,ANSILOCAL
close
set alarmtime,YELLTIME ; setup yell alarm
set alarmsound,YELLSOUND
else
print "Cannot open TMHCFG.HST in the current directory"
print
print "Do you want to setup host mode (y/n)? ",
repeat
inputch ch
until success
if ch="y"
print ch
script "TMHCFG" ; chain to TMHCFG.SCR
else
print "n" ; abort host mode
print "Host mode aborted"
stop
endif
endif
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function to calculate time difference in minutes between time1 and time2
;; for calculation of time left for user, ties in and
;; Modification of Difftime function from Toolbox3.scr
;;

Procedure CalcTime string time1,time2,integer minutes
integer h1,m1,h2,m2 ; and in "HH:MM:SS" format
string hh,mm
substr time1,1,2,hh ; get hour part
substr time1,4,2,mm ; get minute part
atoi hh,h1 ; convert to integer
atoi mm,m1
substr time2,1,2,hh ; get hour,minute and second from
substr time2,4,2,mm
atoi hh,h2
atoi mm,m2
if h2

pass mid-night
h2 = h2 + 24
endif
minutes = (h2-h1)*60 + (m2-m1)
EndProc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure FULLDATE
;; Setup a date string
;; When full is TRUE, date format e.g. 'Friday December 14, 1990'
;; When full is FALSE, date format DD-MM-YY e.g. '14-12-90'
;; Telemate version of date is MM-DD-YY e.g '12-14-90'
;;

Procedure FullDate string strdate,integer full
string datestr,mm,dd,yy,day,month,year,century
integer y1,d1,daynum,totaldays,numdays
date datestr ; get date string
substr datestr,1,2,mm ; month
substr datestr,4,2,dd ; date
substr datestr,7,2,yy ; year
atoi yy,y1
atoi dd,d1
if not full
concat dd,"-" ; DD-MM-YY
concat dd,mm
concat dd,"-"
concat dd,yy
strdate = dd
else
switch mm
case " 1":
month = " January "
numdays = 0
case " 2":
month = " February "
numdays = 31
case " 3":
month = " March "
numdays = 59
case " 4":
month = " April "
numdays = 90
case " 5":
month = " May "
numdays = 120
case " 6":
month = " June "
numdays = 151
case " 7":
month = " July "
numdays = 181
case " 8":
month = " August "
numdays = 212
case " 9":
month = " September "
numdays = 243
case "10":
month = " October "
numdays = 273
case "11":
month = " November "
numdays = 304
case "12":
month = " December "
numdays = 334
endswitch
century = " 19"
if y1 > 99
century = " 20"
endif
totaldays = (y1-80)*365+1+(y1-80)/4+numdays+d1
daynum = totaldays-((totaldays/7)*7)
switch daynum
case 0: day = " Monday"
case 1: day = " Tuesday"
case 2: day = " Wednesday"
case 3: day = " Thursday"
case 4: day = " Friday"
case 5: day = " Saturday"
case 6: day = " Sunday"
endswitch
concat day," "
concat day,month
concat day,dd
concat day,","
concat day,century
concat day,yy
strdate = day ; DAY MONTH DD, CENTURY YY
endif
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New graphic delay routine used in message saving etc.
;;

Procedure Save
integer i
i = 0
while i < 15
Echo "."
delay 3
i = i+1
endwhile
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New procedure LOCALVIEW
;; who's online
;;

Procedure LocalView ; shows user on line locally
EchoHilite
EchoColor LOCALBOXCOL
at 0,0
print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵ ÆÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
print "º ONLINE: DATE: º"
print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ^M^J"
EchoColor LOCALCOL
at 31,0
print TMHOST
at 68,1
print today
at 10,1
print username ; user online
EchoNormal
Endproc

Procedure HostBegin
set zautodownload,off
set zrecovery,off
set usagelog,on
set baud,INITIALBAUD
clear key ; clear keyboard buffer
clear com ; clear com buffer
clear text ; clear screen
print
print
print "Initializing modem"
put "^)","~ATQ0E0X4^M~", ; send modem answer string
delay 5
clear text
EchoColor LOCALBOXCOL
print "^M^J^M^J^M^J^M^J"
print " ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ "
print " ÕÍÍ͵ Host Mode ÆÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸ "
print " ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³ "
print " ³ : Waiting for call..... ³ "
print " ³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ³ "
print " ³ : Press [ ] to exit Host Mode ³ "
print " ³ ' ' for configuration ³ "
print " ³ ' ' for local mode ³ "
print " ³ [ ] to terminate user ³ "
print " ³ ³ "
print " ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ; "
print
EchoColor LOCALCOL
at 14,6
print "TELEMATE"
at 14,8
print "STATUS"
at 13,10
print "OPTIONS"
at 29,10
print "ESC"
at 23,11
print "C"
at 23,12
print "L"
at 23,13
print "Alt-H"
at 44,8
clear key ; clear keyboard buffer
clear com ; clear com buffer

; Do calculations before answering call

FullDate today,FALSE ; string right way round, not full date
FullDate wdate,TRUE ; full date string for welcome
MSGBASE = MSBASE0 ; message to sysop base
area = area0
areanum = 1 ; message area number (command line)
access = TRUE
usage "Switched to Host mode"
Endproc

Procedure HostEnd
set zautodownload,on
set zrecovery,on
clear key ; clear keyboard buffer
clear com ; clear com buffer
clear text
print
print "Ending host mode"
put "^(","~", ; send modem init string
print
chdir HOSTDIR ; change to Host dir
delete FILEDIR ; delete temp file
chdir TMDIR ; change back to Telemate dir
usage "Terminating Host mode"
set usagelog,off
stop
Endproc

Procedure Disconnect ; end session
delay 10
if not LOCAL ; if remote
hangup
endif
set connection,modem
LOCAL = FALSE
Endproc

Procedure InputChar string ch ; input and display locally
repeat
if not LOCAL ; get remote characters
getch ch
endif
if LOCAL or not success
inputch ch
if success
if ch = "^["
HostEnd
endif
print ch,
endif
endif
until success or not connected
Endproc

Procedure InputEcho string ch ; input and echo to remote
InputChar ch
if not LOCAL
put ch,
endif
if ch = "^M" ; add line feed
Echo "^J"
endif
Endproc

Procedure DotEcho string ch ; input and echo "." to remote
InputChar ch
if not LOCAL
if ch="^H" or ch="^M"
put ch,
else
put ".", ; echo with "."
endif
endif
if ch = "^M" ; add line feed
Echo "^J"
endif
Endproc

Procedure InputString string str ; input a string
string ch
str = ""
repeat
InputEcho ch
if ch <> "^M" ; if return
if ch = "^H" ; if backspace
if str = "" ; if string empty
Echo " "
else
Echo " ^H"
endif
endif
concat str,ch
endif
until ch = "^M" or not connected
if str="" or not connected
success = FALSE
else
success = TRUE
endif
Endproc

Procedure InputFilename string filename,dir
string fname
integer pos
InputString fname ; input a filename
repeat
strpos fname,":",pos ; strip drive part
if pos>0 ; only view file
strdel fname,1,pos ; in download dir
endif
until pos=0 or not connected
repeat
strpos fname,"\",pos ; strip directory part
if pos>0
strdel fname,1,pos
endif
until pos=0 or not connected
if fname="" or not connected
success = FALSE
filename = ""
else
success = TRUE
filename = dir
concat filename,"\" ; concat
strpos filename,"\\",pos
if pos>0
strdel filename,pos,1 ; avoid root directory
endif
concat filename,fname
endif
Endproc

Procedure Pause ; request a key
string ch
Echo "Press [ENTER] to continue "
InputEcho ch
Echo "^M^J"
if ch<>"^M"
Echo "^M^J"
endif
Endproc

Procedure InputPassword string password
password = ""
repeat ; input password
DotEcho ch
if ch <> "^M"
if ch = "^H"
if password = ""
Echo " "
else
Echo " ^H"
endif
endif
concat password,ch
endif
until ch = "^M" or not connected
if password="" or not connected
success = FALSE
else
success = TRUE
endif
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Added choice of y/n to [more] in Typefile procedure
;;

Procedure TypeFile string filename,integer more
string ch ; display a file
integer i
i = 0
open filename
if not success
Echo "File not found!^M^J"
else
while success
inputch ch
if success and ch = "^C" ; operator break
clear com
Echo "^M^J"
exit
endif
if not LOCAL
getch ch
if success and ch = "^C" ; caller break
clear com
Echo "^M^J"
exit
endif
endif
read s ; display a line
Echo s
Echo "^M^J"
i = i+1
if i = 22 and more ; pause if is TRUE
i = 0
Echo " More [y/N] "
InputChar ch
if ch = "^C" or ch = "N" ; if no, stop
clear com
Echo "^M^J"
exit
endif
Echo "^M ^M"
endif
endwhile
close
if more
Pause
endif
endif
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure READMAIL
;; MSGBASE = message area.
;; At logon a choice is provided to read personal mail from
;; messages areas. Checks the 'To : name' field of message header
;; and displays appropriate message. An 'R' is placed in the
;; 'To :' string --> 'To R :' which serves 2 purposes:
;; 1) The same messages are not displayed at future logons,
;; string now changed.
;; 2) The Sysop can edit out the message once it has been rec'd.
;;

Procedure ReadMail string MSGBASE
string toname,s
integer found,pos,filepos,len,i,more
savedmsg = FALSE
chdir HOSTDIR
open MSGBASE
if not success
Echo "^M^JSystem Error - no messages available at this time!^M^J"
print "SYSOP: Cannot find ",MSGBASE," file"
alarm "SYSOP: Cannot find MESSAGE file, disk full ?"
return
endif
repeat
found = FALSE
read s
while success and not found ; locate message 'To:' field
strpos s,"To :",pos
if pos>0
substr s,pos+9,30,toname
if toname=username ; username?
length toname,len ; length of name
found = TRUE
msgread = TRUE
tell filepos ; save file position
seek filepos-len-8 ; back to middle of 'To :' string
write "R", ; 'R'means message received
endif ; won't be shown on future
endif ; logons - can be deleted by
if not found ; Sysop
read s
endif
endwhile
if found
i = 0
mail = mail+1
seek filepos-90 ; start of message
EchoNormal
Echo "^M^J"
repeat
read s ; display message
Echo s
Echo "^M^J"
more = TRUE
i = i+1
if i = 22 and more
i = 0
Echo " More [y/N] " ; pause if long message
InputChar ch
if ch = "^C" or ch = "N"
clear com
Echo "^M^J"
exit
endif
Echo "^M ^M"
endif
until s = " End of Message" ; end of message
EchoHilite
EchoColor SPECIALTEXTCOL
Echo "Continue [Y/n] " ; read more mail?
InputEcho ch
if ch = "N"
success = FALSE
endif
endif
until not success
close
chdir TMDIR
msgmail = TRUE
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Changed record length in Checkuser routine, added expert menu
;; variable TRUE or FALSE for logon 'Menu Mode' and how many
;; messages left for user.
;; Padded with spaces to provide for different password size
;; when changed by 'Change Password routine'.
;;

Procedure CheckUser string username,password,integer level,xpert,msgs,valid
integer found,pos1,pos2
string record,recordname,pass,lev,x,m
strpos username,";",pos1 ; record format: "first last;password#level
strpos username,"#",pos2 ; %xpert&msgs"
if pos1>0 or pos2>0
valid = FALSE
return
endif
strpos password,";",pos1 ; check password for invalid character
strpos password,"#",pos2 ; prevent "#2" etc
if pos1>0 or pos2>0
valid = FALSE
return
endif
chdir HOSTDIR
open "PASSWORD.HST" ; passwords in PASSWORD.HST
if not success
create "PASSWORD.HST"
endif
if not success
Echo "System error, please call again later^M^J"
print "SYSOP: Cannot create PASSWORD.HST"
Disconnect
alarm "SYSOP: Cannot create PASSWORD.HST, disk full ?"
return
endif
found = FALSE
read record
while success and not found
strpos record,";",pos1 ; get fields from the record
strpos record,"#",pos2
if pos1>0 and pos2>0
substr record,1,pos1-1,recordname
substr record,pos1+1,pos2-pos1-1,pass
if recordname=username
found = TRUE
if pass=password
valid = TRUE
substr record,pos2+1,1,lev
atoi lev,level ; get userlevel
substr record,pos2+3,1,x
atoi x,xpert ; get menu mode
substr record,pos2+5,3,m
atoi m,msgs ; how many personal messages
else
valid = FALSE
endif
endif
endif
if not found
read record
endif
endwhile
if not found ; new users
open "PASSWORD.HST" ; else add new user
seek -1
write username,";",password,"#",NEWUSERLEVEL,"%",0,"&",0," "

; user information record with extra spaces for 'password
; change' length and any further addition of variables
; at a later date. Field length - varies with length of
; name or password, however 70 spaces at end

usage "Newuser added to password file"
level = 1
xpert = FALSE
valid = TRUE
endif
close
chdir TMDIR
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure WRITENEWRECORD
;; Routine to update PASSWORD.HST file for change of password, menu
;; mode status or 'add to' or 'take away' number of personal messages.
;;
;; ReadMail procedure adds number of messages read at logon,
;; Entermsg procedure sets addmsg to 1 which is added to msgs.
;;
;; rname = 'username' or 'name' for No. of personal messages
;; Reads original record and then updates
;;

Procedure WriteNewRecord string rname
integer found,filepos,len,pos1,pos2
string recordname,record,pass,lev,x,m
chdir HOSTDIR
open "PASSWORD.HST"
if not success
Echo "System error, please call again later^M^J"
print "SYSOP: Cannot locate PASSWORD.HST"
Disconnect
alarm "SYSOP: Cannot locate PASSWORD.HST, disk full ?"
return
endif
filepos = 0
found = FALSE
read record
while success and not found ; locate record
strpos record,";",pos1
strpos record,"#",pos2
if pos1>0 and pos2>0
substr record,1,pos1-1,recordname ; locate name
substr record,pos1+1,pos2-pos1-1,pass
if recordname=rname ; is it correct
found = TRUE
substr record,pos2+1,1,lev ; get level etc
substr record,pos2+3,1,x
substr record,pos2+5,3,m
atoi m,msgs
if msgmail
msgs = msgs - mail
endif
if savedmsg
msgs = msgs + addmsg
endif
endif
endif
length record,len ; find length of record
filepos = filepos+len+2 ; add 2 for carriage return
if not found ; and linefeed bytes
read record
endif
endwhile
if found
seek filepos-len-2 ; write over record
if rname = username ; logged on user? if another user,
; keep record update messages
write rname,";",password,"#",userlevel,"%",xpert,"&",msgs," ",
else
write rname,";",pass,"#",lev,"%",x,"&",msgs," ",
endif ;
; it is important when editing password file
; that field length is kept 'as is'.
; spaces are needed in case 'password' is shorter
; than original when change of password made.

endif
close
chdir TMDIR
msgmail = FALSE
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure ENTERMSG
;; addmsg variable increments number of personal messages
;; being left to another user. Number of messages for user is checked
;; in PASSWORD.HST and updated by WriteNewRecord routine
;; Messages saved in a a message base file depends on MSBASE variable.
;; Updates number of messages at head of file.
;; End of message marker used to detect end of message when reading.
;; If replying to messages, To 'Name' entry is automatic,
;; optional same 'Subject'
;; Save and Kill message commands.
;;

Procedure EnterMsg ; leave message
integer x,y,num,delpos,filepos
integer msgnumber
string msg,str
filepos = 0
savedmsg = FALSE
clear text
clear com
EchoClearScreen ; see screenio.scr
Echo "^M^J"
chdir HOSTDIR
open MSGBASE ; open message file
if not success ; e.g Message to Sysop
create MSGBASE
endif
if not success
Echo "System error, please call again later^M^J"
print "SYSOP: Cannot create ",MSGBASE," file"
Disconnect
alarm "SYSOP: Cannot create MESSAGE file, disk full ?"
return
endif
read totalmsgs ; read number of existing messages
atoi totalmsgs,num ; in message file, convert to an
msgnumber = num ; integer to write new message No.
EchoHilite
EchoBkColor HEADERBKCOL
EchoColor HEADERTEXTCOL
Echo area ; display message base
Echo "......Press to End"
EchoBkColor GENBKCOL
Echo "^M^JFrom: "
Echo username
if MSGBASE = MSBASE0 ; if message to sysop
name = "Sysop" ; put To Sysop
Echo "^M^J"
else
str = ""
Echo "^M^JTo: "
EchoNormal
if name = "" ; enter name of person to
InputString name ; send message
else
Echo name
Echo "^M^J"
endif
EchoHilite
EchoColor HEADERTEXTCOL
endif
if subject = "" ; no subject?
Echo "Subject: (30 characters max.) "
EchoNormal
InputString subject
else
Echo "Subject - Press [ENTER] for same or (S) for new subject: "
EchoNormal ; previous subject or new one?
InputEcho ch
if ch = "^M"
EchoHilite
EchoColor HEADERTEXTCOL
Echo "Subject: "
EchoNormal
Echo subject ; old subject
else
Echo "^M^J"
EchoHilite
EchoColor HEADERTEXTCOL
Echo "Subject: (30 characters max.) "
EchoNormal
InputString subject ; new subject
endif
Echo "^M^J"
endif
msgnumber = msgnumber + 1 ; next message
seek filepos ; go to head of file
write msgnumber," ", ; update number of messages
seek -1 ; go to end of file
tell delpos ; save file pointer for K)ill msg
write "^M^J <--------> "

write " Msg#:",msgnumber
write " From : ",username
write " To : ",name
write " Date : ",today," Time: ",now," Subject: ",subject
write ; write header to file
tell filepos ; save file pointer to
repeat ; control layout of message
InputEcho msg ; get character
wherex x
if msg = " " and x>70
Echo "^M^J"
msg = "^M^J " ; space needed in message for
filepos = filepos+2 ; placement of linefeed character
else ; in file
if msg = "^H" ; if backspace character, go back
filepos = filepos-1 ; 1 byte and write space
seek filepos
msg = " "
else
seek filepos ; else go back and write character
filepos = filepos+1
endif
if msg = "^M" ; if carriage return
msg = "^M^J" ; linefeed in file
filepos = filepos+1
endif
endif
write msg,
until msg = "^Z" ; end message
seek filepos-1 ; write over end of file character
write "^M^J^M^J "
; record area for reply numbers
write " End of Message" ; marker for read message routine
EchoHilite
EchoColor HEADERTEXTCOL
repeat
Echo "^M^J^M^J S)ave or K)ill Message? "
InputEcho ch
if ch = "K" ; write over message
clear com
num = 0
seek delpos
read str
while success
num = num+1
read str
endwhile
seek delpos ; file position to delete from
write "^M^J"
while num>0
write "............................................................."
num = num-1 ; file can be edited later
endwhile
msgnumber = msgnumber-1 ; reduce message number
seek 0
write msgnumber," ", ; spaces required in case of 10 -> 9 etc
Echo "^M^JMessage Deleted "
Save
elseif ch = "S"
clear com
Echo "^M^JMessage Saved "
Save
If MSGBASE <> MSBASE0 ; if not Message to Sysop
addmsg = addmsg + 1
savedmsg = TRUE ; variables for WriteNewRecord
endif
endif
until ch = "S" or ch = "K"
close
chdir TMDIR
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure READMSG
;; S)can message headers, V)iew a selected message or press
;; [ENTER] for next message, also can R)eply to message or Q)uit.
;; Total number of messages in selected message base displayed.
;; Keep 'Name' and 'Subject' for R)eply.
;; Number of replies to message shown as 'See Msg: #1, #2, #3 etc'.
;;

Procedure ReadMsg ; read messages
integer num,total,found,len,filepos,n,i,more,pos
string line1,line2,line3,line4,s,selnum,nextmsg

Procedure ShowMsg ; show message, used by V)iew
read s ; and [ENTER] for next message
while success and not found
strpos s,"Msg#:",pos ; find message No.
if pos>0
substr s,pos+5,4,msgnum
if msgnum = selnum ; correct message?
found = TRUE
endif
endif
if not found ; no read next
read s
endif
endwhile
if found
i = 0
name = ""
subject = ""
repeat
read s ; display message
strpos s,"From :",pos
if pos>0 ; who entered message for reply
substr s,pos+9,30,name
endif
strpos s,"Subject:",pos ; get existing subject
if pos>0
substr s,pos+9,30,subject
endif
Echo s
Echo "^M^J"
more = TRUE
i = i+1
if i = 22 and more
i = 0
Echo " More [y/N] " ; pause if long message
InputChar ch
if ch = "^C" or ch = "N"
clear com
Echo "^M^J"
exit
endif
Echo "^M ^M"
endif
until s = " End of Message" ; end of message
EchoHilite
EchoColor HEADERTEXTCOL
Echo "^M^JR)eply ? or [ENTER] to continue " ; reply to message?
InputEcho ch
repeat
if ch = "R"
clear com
n = total+1
itoa n,nextmsg ; next message number for reply field
tell filepos
seek filepos-70 ; start of reply number field
read s
strpos s, "See Msg:",pos ; check for earlier reply
if pos>0
strpos s," ",pos ; yes locate spaces
if pos > 2 ; i.e. after See Msg #
length s,len ; find toal length including spaces
strdel s,pos,len-pos+1 ; delete spaces
concat s,", " ; add comma
concat s,nextmsg ; add next reply message number
seek filepos-70 ; head of field
write s,
endif
else ; empty string (all spaces)
seek filepos-70 ; head of record
write " See Msg: ",n, ; message number of first reply
endif
reply = TRUE ; for return to message base
addmsg = 0
EnterMsg
WriteNewRecord name ; update mail
else
clear com
exit
endif
until ch = "R" or ch = "^M"
endif
Endproc

clear com ; main routine
clear text
EchoClearScreen
reply = FALSE
num = 0
pos = 0
chdir HOSTDIR
open MSGBASE
if not success
Echo "^M^JSorry no messages available at this time!^M^J"
print "SYSOP: Cannot find ",MSGBASE," file"
alarm "SYSOP: Cannot find MESSAGE file, disk full ?"
return
endif
while success
clear text
clear com
seek 0 ; go to head of file
read totalmsgs ; get total No. of messages
atoi totalmsgs,total
EchoClearScreen
EchoHilite
EchoColor HEADERTEXTCOL
Echo " Number of Messages : " ; display number of messages
Echo totalmsgs
Echo "^M^J S)can Q)uit V)iew or [ENTER] for next msg : "
InputEcho ch
Echo "^M^J^M^J"
switch ch
case "S": ; scan through messages
EchoNormal
i = 0
while success

read line1 ; start at line 1
strpos line1,"Msg#:",pos ; and locate message No. line
if pos > 0
read line2
read line3
read line4
Echo line1 ; show header of message
Echo "^M^J"
Echo line2
Echo "^M^J"
Echo line3
Echo "^M^J"
Echo line4
Echo "^M^J^M^J"
i = i + 5
endif
more = TRUE
if i >= 20 and more ; pause if more messages
i = 0
Echo " More [y/N] "
InputChar ch
if ch = "^C" or ch = "N"
clear com
Echo "^M^J"
exit
endif
Echo "^M ^M"
endif
endwhile
Pause
case "Q": ; quit message base
close
chdir TMDIR
return
case "^M": ; [ENTER] for next message
num = num + 1 ; increment to next message
if num > total ; last message?
EchoHilite
Echo HEADERTEXTCOL
Echo "^M^JThere are no more messages"
delay 10
else ; else show message
EchoNormal
found = FALSE
itoa num,selnum
Echo "Msg#: "
Echo selnum
Echo "^M^J"
ShowMsg
if reply
return
endif
endif
case "V": ; view message
Echo "^M^JMsg No.? "
Inputstring selnum ; select number of message
atoi selnum,num
EchoColor HILITECOL
if num > total or num = 0 ; check validity of selection No.
print "^M^JThere are ",totalmsgs," messages only!!!"
delay 10
else
EchoNormal
found = FALSE
Echo "^M^J"
seek 6 ; up to 5 figures (total msgs)
ShowMsg ; show message
if reply
return
endif
endif
endswitch
endwhile
close
chdir TMDIR
Endproc


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure ACCESSMSG
;; Allows access to Message Areas, keeps selection
;; Only displays configured message areas.
;; Once selected can R)ead, E)nter or Q)uit, ? for help
;;

Procedure AccessMsg ; message area listing
string a
integer c,n,quit
c = 1
clear com
clear key
clear text
EchoClearScreen
EchoHilite
EchoColor SPECIALTEXTCOL
Echo "^M^J ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿^M^J"
Echo " ³ Message Area Listings ³^M^J"
Echo " ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ^M^J"
EchoNormal
while c < COUNT+1 ; only display areas as read
switch c ; from TMHCFG.HST
case 1:
Echo "^M^J 1. "
Echo area0
case 2:
Echo "^M^J 2. "
Echo area1
case 3:
Echo "^M^J 3. "
Echo area2
case 4:
Echo "^M^J 4. "
Echo area3
case 5:
Echo "^M^J 5. "
Echo area4
case 6:
Echo "^M^J 6. "
Echo area5
case 7:
Echo "^M^J 7. "
Echo area6
case 8:
Echo "^M^J 8. "
Echo area7
case 9:
Echo "^M^J 9. "
Echo area8
case 10:
Echo "^M^J 10. "
Echo area9
endswitch
c = c+1
endwhile
n = areanum ; save area number
Echo "^M^J^M^JSelect Area Number desired, press [Enter]: "
EchoHilite
InputString a
atoi a,areanum
if areanum > COUNT
Echo "^M^JArea NOT available!!"
areanum = n ; original areanum
delay 10
return
else ; once selected
switch areanum ; setup message base and
Case 1: ; appropriate file
MSGBASE = MSBASE0
area = area0
areanum = 1 ; command line area number
Case 2:
MSGBASE = MSBASE1
area = area1
areanum = 2
Case 3:
MSGBASE = MSBASE2
area = area2
areanum = 3
Case 4:
MSGBASE = MSBASE3
area = area3
areanum = 4
Case 5:
MSGBASE = MSBASE4
area = area4
areanum = 5
Case 6:
MSGBASE = MSBASE5
area = area5
areanum = 6
Case 7:
MSGBASE = MSBASE6
area = area6
areanum = 7
Case 8:
MSGBASE = MSBASE7
area = area7
areanum = 8
Case 9:
MSGBASE = MSBASE8
area = area8
areanum = 9
Case 10:
MSGBASE = MSBASE9
area = area9
areanum = 10
endswitch
quit = FALSE
while not quit
EchoClearScreen
EchoHilite
EchoColor SPECIALTEXTCOL
Echo "^M^J^M^JMESSAGE AREA - "
Echo area
Echo "^M^JE)nter R)ead Q)uit ( ? for commands):"
InputEcho ch
switch ch
Case "E": ; Enter a message
name = ""
subject = ""
addmsg = 0
EnterMsg
WriteNewRecord name
Case "R": ; read message
if MSGBASE = MSBASE0 ; message to sysop
If userlevel = SYSOPLEVEL ; read by sysop only
ReadMsg
else
Echo "^M^J^M^JThese are PRIVATE messages!"
delay 10
endif
else
ReadMsg ; other areas
endif
Case "?": ; show available commands
EchoNormal
Echo "^M^J^M^JE)nter Messages --> S)ave or K)ill"
Echo "^M^JR)ead Messages --> S)can Q)uit V)iew or"
Echo "^M^J --> [ENTER] for next Message"
Echo "^M^J --> Msg# and/or R)eply"
Echo "^M^JQ)uit --> Quit message base"
Echo "^M^J? --> This help screen^M^J^M^J"
Pause
Case "Q":
quit = TRUE
endswitch
endwhile
endif
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure TRASH
;; Checks for bad passwords in TRASHCAN.HST
;; Sysop edited file - just add passwords not to be accepted
;; by system
;;

Procedure Trash ; test for bad passwords
string s
chdir HOSTDIR
open "TRASHCAN.HST" ; trash password file
if not success
Echo "System error, please call again later^M^J"
print "SYSOP: Cannot open TRASHCAN.HST"
Disconnect
alarm "SYSOP: Cannot open TRASHCAN.HST, disk full ?"
return
endif
while success
read s ; read word
if password = s ; if password trash, hangup
access = FALSE
endif
endwhile
close
chdir TMDIR
Endproc

Procedure Directory ; display download directory
string cmd
cmd = "DIR >"
clear com
clear text
concat cmd,FILEDIR ; DIR >\HOST.DIR
dos cmd ; shell to DOS
TypeFile FILEDIR,TRUE ; display \HOST.DIR
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Addition of Bimodem to Protocol selection.
;;

Procedure Bimod ; bimodem transfer
clear text
clear com
EchoColor GENTEXTCOL
Echo "Set-up YOUR end NOW........I am Ready for the transfer.^M^J"
Echo "When your end prompts to start my end: press [ENTER]..."
InputEcho ""
dos "BIMODEM "
clear text
dos "del Bimodem.Pth"
alarm " * Bimodem Transfer(s) Completed * "
Echo "^M^J ** Bimodem Transfer Completed ** "
Endproc

Procedure FileTransfer string mode,protocol,filename
print "^M^JPlease start your transfer procedure or press Ctrl-X to abort^M^J"
if mode = "r"
if filename="" ; receive batch files
receive protocol
else
receive protocol,filename ; receive single file
endif
else
send protocol,filename ; send multiple files
endif
clear com
if success
Echo "File transfer completed!^M^J"
else
Echo "File transfer aborted!^M^J"
endif
Pause
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure QUESTIONNAIRE
;; Newuser fills out questionnaire, saved to file USER.HST.
;; Keep list of users, can be edited if status changes.
;;

Procedure Questionnaire ; new users file
string address,city,pcode,modemnum,phonenum,datanum,check
integer filepos
clear com
clear text
EchoColor GENTEXTCOL
repeat
If userlevel < NUSERLEVEL
Echo "^M^J You are not found in the user file.^M^J"
endif
Echo " Would you like to register? [Y/n] : "
InputEcho ch
if ch = "Y"
clear com
clear text
EchoClearScreen
EchoHilite
EchoColor SPECIALTEXTCOL
Echo "^M^J ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿^M^J"
Echo " ³ Registration Questionnaire ³^M^J"
Echo " ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ^M^J"
chdir HOSTDIR
open "USER.HST" ; user information file
if not success
create "USER.HST"
endif
if not success
Echo "System error, please call again later^M^J"
print "SYSOP: Cannot create USER.HST"
Disconnect
alarm "SYSOP: Cannot create USER.HST, disk full ?"
return
endif
seek -1
write "**** NEW USER *****"
write "NAME: ",username
tell filepos
write "PASSWORD: ",password," "
write "LEVEL: ",userlevel
repeat
Echo "^M^JWhat is your street address ?"
Echo "^M^J--->"
InputString address
Echo address
Echo " [y/N] "
InputEcho check
if check = "N"
address = ""
endif
until check = "Y"
write "ADDRESS: ",address
repeat
Echo "^M^J^M^JWhat City are you calling from ? --> "
InputString city
Echo city
Echo " [y/N] "
InputEcho check
if check = "N"
city = ""
endif
until check = "Y"
write "CITY: ",city
repeat
Echo "^M^J^M^JWhat is your zip code ? --> "
InputString pcode
Echo pcode
Echo " [y/N] "
InputEcho check
if check = "N"
pcode = ""
endif
until check = "Y"
write "ZIPCODE: ",pcode
repeat
Echo "^M^J^M^JModem Brand & Speed? --> "
InputString modemnum
Echo modemnum
Echo " [y/N] "
InputEcho check
if check = "N"
modemnum = ""
endif
until check = "Y"
write "MODEM BRAND & SPEED. ",modemnum
repeat
Echo "^M^J^M^JVoice phone No. ? --> "
InputString phonenum
Echo phonenum
Echo " [y/N] "
InputEcho check
if check = "N"
phonenum = ""
endif
until check = "Y"
write "PHONE No. ",phonenum
repeat
Echo "^M^J^M^JData Phone No. or None? --> "
InputString datanum
Echo datanum
Echo " [y/N] "
InputEcho check
if check = "N"
datanum = ""
endif
until check = "Y"
write "DATA No. ",datanum
write "^M^JÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
repeat
Echo "^M^J^M^JPick a password (4 - 16 characters max): "
Echo "^M^J--->"
InputString password
Echo password
Echo " [y/N] "
InputEcho check
if check = "N"
password = ""
endif
until check = "Y"
seek filepos ; update password
write "PASSWORD: ",password,
close
chdir TMDIR
clear com
clear text
Echo "^M^JRegistration information saved "
Save
Echo "^M^J^M^JThankyou for filling out the questionnaire.^M^J^M^J"
Usage "User filled out Questionnaire......"
if userlevel < NUSERLEVEL
Echo "If you have provided the correct information, you^M^J"
Echo "will be elevated to User STATUS within a day or so.^M^J^M^J^M^J"
endif
Pause
else
exit
endif
Echo "^M^J"
until ch = "Y" or ch = "N" ; repeat until either Y/N
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure WELCOMEUSER
;; welcome user after logon, show time, date and No. of personal
;; messages.
;; choice of reading personal messages at logon

Procedure WelcomeUser
string wname,message
integer len,c,pos
c = 1
time now
strdel now,6,3
wname = username
length wname,len
strpos wname," ",pos
if pos>0 ; welcome user by
strdel wname,pos+1,len-pos ; first name
endif
EchoClearScreen
EchoHilite
EchoColor SPECIALTEXTCOL
Echo "^M^J^M^JHello "
EchoColor HILITECOL
Echo wname
EchoColor SPECIALTEXTCOL
Echo "welcome to the "
Echo TMHOST
print "^M^J^M^JThe time is ",now," on", wdate ; show time and date
put "^M^J^M^JThe time is ",now," on", wdate
if msgs = 0 ; any mail?
Echo "^M^JSorry there is no mail for you today"
else
if msgs > 1 ; yes, show how many
message = " messages "
print "^M^JYou have ",msgs," personal",message,"to read"
put "^M^JYou have ",msgs," personal",message,"to read"
else
message = " message "
print "^M^JYou have ",msgs," personal",message,"to read"
put "^M^JYou have ",msgs," personal",message,"to read"
endif
Echo "^M^J^M^JRead personal mail [Y/n] " ; offer choice
InputEcho ch ; to read mail
if ch = "Y"
mail = 0
msgread = FALSE
while c < COUNT+1 ; check all available
switch c ; message areas
case 1:
Echo "^M^JMessage area 1 - "
Echo area0
ReadMail MSBASE0
case 2:
Echo "^M^JMessage area 2 - "
Echo area1
ReadMail MSBASE1
case 3:
Echo "^M^JMessage area 3 - "
Echo area2
ReadMail MSBASE2
case 4:
Echo "^M^JMessage area 4 - "
Echo area3
ReadMail MSBASE3
case 5:
Echo "^M^JMessage area 5 - "
Echo area4
ReadMail MSBASE4
case 6:
Echo "^M^JMessage area 6 - "
Echo area5
ReadMail MSBASE5
case 7:
Echo "^M^JMessage area 7 - "
Echo area6
ReadMail MSBASE6
case 8:
Echo "^M^JMessage area 8 - "
Echo area7
ReadMail MSBASE7
case 9:
Echo "^M^JMessage area 9 - "
Echo area8
ReadMail MSBASE8
case 10:
Echo "^M^JMessage area 10 - "
Echo area9
ReadMail MSBASE9
endswitch
c = c+1
endwhile
if msgread
Echo "^M^JEnd of personal messages"
endif
WriteNewRecord username ; update record (msgs left)
endif ; 0 if read all msgs
endif
Echo "^M^J^M^J"
EchoNormal
Pause
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Modified WaitForCall procedure with ANSI variable ANSIREMOTE
;; to detect use of Ansi Graphics at logon.
;; Beefed up password checking routine, e.g. look for rubbish
;; passwords, too may attempts at password.
;; Set time on line variable depending on user level.
;;

Procedure WaitForCall ; wait for connected
integer i,len,valid,exist,baudrate
set connection,modem
LOCAL = FALSE
xpert = FALSE
while not connected ; wait for carrier signal
inputch ch ; sysop commands
if success
switch ch
case "^[": ; abort
HostEnd
case "L": ; local mode
set connection,computer ; this will set connected = 1
LOCAL = TRUE
case "C": ; configuration
script "TMHCFG" ; chain to TMHCFG.SCR
endswitch
endif
endwhile
if not LOCAL and DETECTBAUD
waitfor "CONNECT^M","CONNECT 1200","CONNECT 2400","CONNECT 9600","CONNECT 19200","CONNECT 38400",10
if found
switch found
case 1: baudrate = 300
case 2: baudrate = 1200
case 3: baudrate = 2400
case 4: baudrate = 9600
case 5: baudrate = 19200
case 6: baudrate = 38400
endswitch
set baud,baudrate
Echo "Connected at "
if not LOCAL
put baudrate,"^M^J"
endif
print baudrate
endif
endif
Echo "^M^J"
delay 5
clear com
clear text
delay 5
EchoNormal
chdir HOSTDIR
TypeFile "WELCOME.HST",FALSE ; display welcome message
repeat
Echo "Does your Terminal support ANSI Graphics Y/N ?: "
InputEcho ch
if ch = "Y"
ANSIREMOTE = TRUE ; for ansi display to remote
else
ANSIREMOTE = FALSE
endif
Echo "^M^J"
until ch = "Y" or ch = "N" ; repeat until either Y/N
chdir TMDIR
i = 1
len = 0
username = "" ; enter name (at most 3 times)
while i<=3 and len<4 and connected
EchoColor GENTEXTCOL
Echo "Please enter your First and Last name: "
EchoHilite
EchoColor HILITECOL
InputString username
i = i+1
length username,len ; check the length of name
if len<4
Echo "Name too short, please try again^M^J^M^J"
else
EchoNormal
EchoColor GENTEXTCOL
Echo username
Echo " [Y/n]? "
EchoHilite
EchoColor HILITECOL
InputString ch
if ch="n"
len=0
endif
endif
endwhile
if len<4 and connected
Echo "Goodbye^M^J"
Disconnect
Usage "User disconnected - name too short"
else
i = 1
len = 0
password = "" ; enter password (at most 3 times)
while i<=3 and len<4 and connected
EchoNormal
EchoColor GENTEXTCOL
Echo "Password: "
EchoHilite
EchoColor HILITECOL
InputPassword password
Trash
if not access
Echo "^M^JGarbage Passwords not accepted, access denied!^M^J"
Disconnect
Usage "User not accepted - garbage password!"
return
endif
i = i+1
length password,len ; check the length of password
if len<4
Echo "Password too short, please try again^M^J^M^J"
endif
endwhile
if len>=4 ; check password and get user level
i = 1
while i<=3
CheckUser username,password,userlevel,xpert,msgs,valid
if not valid ; check validity, 3 attempts
Echo "Does not match password on file, try again : "
InputPassword password
endif
i = i+1
endwhile
endif
if len<4 and connected ; length wrong, disconnect
Echo "Invalid password, access denied^M^J^M^J"
Disconnect
return
Usage "User disconnected - invalid password"
endif
if not valid and connected ; not valid, disconnect
Echo "Too many attempts, access denied^M^J^M^J"
Disconnect
return
Usage "User disconnected - Too many attempts at password"
else
if userlevel = SYSOPLEVEL ; set logon time
ontime = 180
elseif userlevel = NUSERLEVEL
ontime = 90
elseif userlevel < NUSERLEVEL
ontime = 20
Questionnnaire
endif
usage "Logon by:"
usage username
time logontime ; time at user's logon
EchoNormal
clear com
clear text
chdir HOSTDIR ; display notice
FileExist "HNOTICE.HST",exist
if exist
Echo "^M^J"
TypeFile "HNOTICE.HST",TRUE
endif
endif
endif
chdir TMDIR
WelcomeUser
Endproc

Procedure ChatMode ; chat mode
integer x
string rch,lch
Echo "^M^JChat mode begin:^M^J"
repeat
if not LOCAL
getch rch
if success
put rch,
if rch = "^M" ; line feed
Echo "^J"
endif
wherex x
if rch = " " and x > 70
Echo "^M^J"
endif
endif
endif
inputch lch
if success and lch<>"^[" ; abort if sysop press [Esc]
Echo lch
if lch = "^M"
Echo "^J"
endif
wherex x
if lch = " " and x > 70
Echo "^M^J"
endif
endif
until lch="^[" or not connected
Echo "^M^JChat mode end.^M^J^M^J"
Pause
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure STATISTICS
;; Shows user statistics and enables change of 'Password' or 'Menu Mode'.
;;

Procedure Statistics ; view statistics and
integer len ; change password choice
clear com
clear text
EchoClearScreen
EchoColor HILITECOL
Echo "^M^J"
Echo username
Echo " - your statistics are:^M^J"
EchoColor GENTEXTCOL
Echo "For this call you have "
print timeleft, ; integers
put timeleft,
Echo " minutes remaining.^M^J"
Echo "Userlevel: "
if userlevel = 1 ; show statistics
Echo "New User"
elseif userlevel = 2
Echo "Normal User"
elseif userlevel = 3
Echo "Priviledged User"
endif
Echo "^M^JMenu Mode: "
if xpert
Echo "Expert (No Menus)"
else
Echo "Full Menus"
endif
Echo "^M^JYour password is: "
Echo password
Echo "^M^J^M^J"
len = 0
EchoNormal
EchoHilite
Echo "Change Password ? [y/n] "
InputEcho ch
if ch = "Y"
while len<4
Echo "^M^JNew Password: "
EchoNormal
InputPassword password
Trash
if not access
EchoHilite
Echo "^M^JGarbage Passwords not accepted, access denied!^M^J"
Disconnect
Usage "User not accepted - garbage password!"
return
endif
length password,len ; check the length of password
if len<4
Echo "Password too short, please try again^M^J"
else
WriteNewRecord username
Echo "^M^J^M^JNew Password saved "
Save
Echo "^M^JWrite it down, it is your new logon password!^M^J^M^J"
endif
endwhile
else
EchoNormal
Echo "^M^JOriginal Password valid............^M^J^M^J"
endif
EchoHilite
Echo "^M^JIf you have changed your 'Menu Mode' since"
Echo "^M^Jlogging on it can be saved for future logons."
Echo "^M^JSave ? [y/n] "
EchoNormal
InputEcho ch
if ch = "Y"
WriteNewRecord username ; update record
Echo "^M^JMenu Mode Saved "
Save
endif
Echo "^M^J^M^J"
Pause
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New Procedure TIMEUP
;; Warns then disconnects user if out of time.
;;

Procedure Timeup ; disconnect if over time
if timeleft <= 3
EchoHilite
at 2,20 ; warning
Echo "WARNING - disconnection imminent!"
EchoNormal
endif
if timeleft = 0
EchoHilite
Echo "^M^JOut of Time. Connection Terminated^M^J"
Disconnect
Usage "User disconnected - out of time"
endif
Endproc

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Modified DoCommand procedure for control of 'Menu mode',
;; Ansi menus, calculation of time on, etc.
;;

Procedure DoCommand ; do a command
integer pos
clear com
clear text
time now ; current time
strdel now,6,3
CalcTime logontime,now,mins ; compare times
timeleft = ontime - mins ; time left online
if ANSIREMOTE
if xpert ; expert mode
Timeup
EchoClearScreen
LocalView
EchoColor GENTEXTCOL
print "^M^J^M^JCurrent Message Area #",areanum," - ",area
put "^M^J^M^JCurrent Message Area #",areanum," - ",area
print "^M^J",timeleft,XPERTCOMMAND,
put "^M^J",timeleft,XPERTCOMMAND,
else
chdir HOSTDIR
TypeFile "MENUANS.HST",FALSE ; display ansi menu
chdir TMDIR
Timeup
LocalView
EchoColor GENTEXTCOL
at 0,20
print "Current Message Area #",areanum," - ",area
put "Current Message Area #",areanum," - ",area
print timeleft,MENUCOMMAND,
put "^M^J",timeleft,MENUCOMMAND,
endif
else
if xpert
Timeup
LocalView
print "^M^J^M^JCurrent Message Area #",areanum," - ",area
put "^M^J^M^JCurrent Message Area #",areanum," - ",area
print "^M^J",timeleft,XPERTCOMMAND,
put "^M^J",timeleft,XPERTCOMMAND,
else
chdir HOSTDIR
TypeFile "MENUTXT.HST",FALSE ; display text menu
chdir TMDIR
Timeup
LocalView
at 0,20
print "Current Message Area #",areanum," - ",area
put "Current Message Area #",areanum," - ",area
print timeleft,MENUCOMMAND,
put "^M^J",timeleft,MENUCOMMAND,
endif
endif
if userlevel = SYSOPLEVEL
Echo "(H,V) "
endif
InputEcho ch
if ch<>"^M"
Echo "^M^J"
endif
switch ch
case "F": ; file directory
EchoClearScreen
chdir DOWNLOADDIR
Directory
case "T": ; type a file
clear com
EchoClearScreen
chdir DOWNLOADDIR
Directory
EchoColor GENTEXTCOL
Echo "^M^JListing of files in host directory...."
Echo "^M^JOnly files with extension .TXT should be typed.^M^J^M^J"
Echo "Enter filename: "
EchoColor HILITECOL
InputFilename filename,DOWNLOADDIR
strpos filename,"TXT",pos
if pos = 0
Echo "^M^JFile must have .TXT extension"
Delay 20
else
if success
chdir DOWNLOADDIR
EchoNormal
TypeFile filename,TRUE
endif
endif
case "C": ; chat
clear com
clear text
EchoClearScreen
Echo "Paging the Sysop, hang on a second!^M^J"
alarm "User would like to chat...^JPress [Enter] to accept, [Esc] to deny"
if success
print "^M^JSYSOP: press [Esc] to terminate chat mode"
ChatMode
else
Echo "^M^JSorry, Sysop is not here^M^J"
endif
case "U": ; upload a file
clear com
clear text
chdir HOSTDIR
if ANSIREMOTE
Typefile "PROTOANS.HST",FALSE ; ansi file
EchoColor GENTEXTCOL
else
TypeFile "PROTOTXT.HST",FALSE
endif
at 5,20
Echo "Select protocol: "
InputEcho protocol
Echo "^M^J"
if LOCAL
Echo "Function not available in local mode^M^J"
delay 10
else
switch protocol
case "I":
Bimod
case "X","R":
Echo "Enter filename: "
InputFilename filename,""
if success
FileTransfer "r",protocol,filename
endif
case "Z","S","T","M","Y","B","G":
FileTransfer "r",protocol,""
endswitch
endif
case "D": ; download a file
clear com
clear text
chdir HOSTDIR
if ANSIREMOTE
Typefile "PROTOANS.HST",FALSE
EchoColor GENTEXTCOL
else
TypeFile "PROTOTXT.HST",FALSE
endif
chdir DOWNLOADDIR
at 5,20
Echo "Select protocol: "
InputEcho protocol
Echo "^M^J"
if LOCAL
Echo "Function not available in local mode^M^J"
delay 10
else
switch protocol
case "I":
Bimod
case "X","Y","Z","S","T","M","R","B","G":
Echo "Enter filename: "
InputFilename filename,DOWNLOADDIR
if success
FileTransfer "s",protocol,filename
endif
endswitch
endif
case "X": ; toggle expert mode
xpert = not xpert
case "A": ; access, change area and
AccessMsg ; read or enter message.
case "E": ; enter message in base already selected
name = ""
subject = ""
addmsg = 0
EnterMsg
WriteNewRecord name
case "R": ; read messages
if MSGBASE = MSBASE0 ; message to sysop
If userlevel = SYSOPLEVEL ; read by sysop only
ReadMsg
else
Echo "^M^J^M^JThese are PRIVATE messages!"
delay 10
endif
else
ReadMsg ; other areas
WriteNewRecord name
endif
case "M": ; or leave message to Sysop
areanum = 1
area = area0
MSGBASE = MSBASE0
subject = ""
EnterMsg ; leave message
case "G": ; goodbye
chdir HOSTDIR
if ANSIREMOTE
Typefile "BYEANS.HST",FALSE
InputEcho ""
else
TypeFile "BYETXT.HST",FALSE
InputEcho ""
endif
Disconnect
Usage "User logged off"
chdir TMDIR
case "Q":
Questionnaire
case "B": ; show bulletins
EchoClearScreen
EchoNormal
chdir HOSTDIR
Typefile "BULLETIN.HST",TRUE
chdir TMDIR
Usage "User read bulletins......"
case "Y": ; user statistics
Statistics
case "S": ; shell to DOS
if userlevel Echo "Sorry, this command is for Sysop only^M^J"
delay 10
else
chdir HOSTDIR
if LOCAL ; local mode shell to DOS
Echo "Shelling to DOS ... ^M^J"
dos
Echo "Return from DOS shell^M^J"
else
fileexist "hshell.bat",exist ; check for HSHELL.BAT
if exist
Echo "Shelling to DOS ... ^M^J"
dos "hshell.bat"
Echo "Return from DOS shell^M^J"
else
Echo "SYSOP: Cannot find HSHELL.BAT^M^J"
endif
endif
endif
case "V": ; view log when remote
if userlevel Echo "Sorry, this command is for Sysop only^M^J"
delay 10
else
EchoClearScreen
EchoNormal
dos "C:"
chdir TMLOG
Typefile "TM.USE",TRUE ; view log
dos "C:"
chdir TMDIR
endif
case "?": ; show help file of available
chdir HOSTDIR ; commands
Typefile "HELP.HST",TRUE
chdir TMDIR
case "H": ; shut down host mode
if userlevel Echo "Sorry, this command is for Sysop only^M^J"
delay 10
else
Echo "Are you sure [y/N]? "
InputString ch
if ch="y"
Echo "Shutting down host mode^M^J"
Disconnect
HostEnd
endif
endif
endswitch
Endproc

;
; begin main program
;
while FOREVER
HostConfig ; read configuration file TMHCFG.HST
HostBegin ; initial mode
WaitForCall ; wait for a call
while connected
DoCommand ; do commands
endwhile
endwhile



  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : TMHOST22.ZIP
Filename : TMHOST22.SCR

  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/