home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
t
/
tm400-3.zip
/
HOST.EXE
/
HOST.SCR
< prev
next >
Wrap
Text File
|
1993-01-01
|
21KB
|
725 lines
;
; HOST.SCR by White River Software, 1 January, 1993
;
;
; constant
;
TRUE = 1
FALSE = 0
FOREVER = TRUE
FILEDIR = "\HOST.DIR" ; temp. file for F)ile command
;
; global variable
;
integer local,userlevel,exist,xport
string username,password,filename,ch,file
integer NEWUSERLEVEL,SYSOPLEVEL,DETECTBAUD,INITIALBAUD,YELLTIME,YELLSOUND,CLOSESYSTEM
string HOSTDIR,DOWNLOADDIR,UPLOADDIR
integer oldAlarmTime,oldAlarmSound,oldZAuto,oldZRecovery,oldBaud,oldConnection
string oldDirUpload
procedure StoreOptions
query alarmtime,oldAlarmTime
query alarmsound,oldAlarmSound
query dirupload,oldDirUpload
query zautodownload,oldZAuto
query zrecovery,oldZRecovery
query baud,oldBaud
query connection,oldConnection
endproc
procedure RestoreOptions
set alarmtime,oldAlarmTime
set alarmsound,oldAlarmSound
set dirupload,oldDirUpload
set zautodownload,oldZAuto
set zrecovery,oldZRecovery
set baud,oldBaud
set connection,oldConnection
endproc
procedure CheckDirectory string dir
integer l
string ch
length dir,l
if l>0
substr dir,l,1,ch
if ch<>"\" and ch<>":"
concat dir,"\"
endif
endif
endproc
procedure HostConfig ; read the configuration file
string s,ch ; HCONFIG.HST from the current directory
open "HCONFIG.HST"
if success
read s
atoi s,NEWUSERLEVEL ; new 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 HOSTDIR ; directory containing H*.HST
read DOWNLOADDIR ; download directory
read UPLOADDIR ; upload directory
read s
atoi s,CLOSESYSTEM ; open or close system
close
CheckDirectory HOSTDIR
CheckDirectory DOWNLOADDIR
CheckDirectory UPLOADDIR
set alarmtime,YELLTIME ; setup yell alarm
set alarmsound,YELLSOUND
set dirupload,UPLOADDIR ; setup upload directory
else
print "Cannot open HCONFIG.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
RestoreOptions
script "HCONFIG" ; chain to HCONFIG.SCR
else
print "n" ; abort host mode
print "Host mode aborted"
stop
endif
endif
endproc
procedure HostBegin
set zautodownload,off
set zrecovery,off
set baud,INITIALBAUD
clear key ; clear keyboard buffer
clear com ; clear com buffer
clear text
print
print "Initializing modem"
put "^)", ; send modem answer string
if connected
print "Carrier signal is high, trying to make it reflect the online status"
put "~AT&C1^M~", ; make carrier signal reflect online status
if connected
print "Carrier signal is still high, host mode may not work correctly"
print "Please check your modem manual for correct DIP switch setting"
else
print "Carrier signal is now correct"
endif
print
endif
put "~ATQ0E0X4^M~", ; disable responds from modem
print
print
print "Host mode, waiting for call"
print
print "Press 'L' for local mode, 'C' for configuration,"
print " [Esc] to exit and [Alt-H] to terminate user."
print
clear key ; clear keyboard buffer
clear com ; clear com buffer
endproc
procedure HostEnd
clear key ; clear keyboard buffer
clear com ; clear com buffer
print
print "Ending host mode"
put "^(","~", ; send modem init string
print
delete FILEDIR ; delete temp file
RestoreOptions
stop
endproc
procedure Disconnect ; end session
delay 10
if not local
hangup
endif
set connection,modem
local = FALSE
endproc
procedure Output string s
print s,
if not local
put s,
endif
endproc
procedure InputChar string ch ; input and display locally
repeat
if not local
getch ch
endif
if local or not success
inputch ch
if success
if ch = "^["
HostEnd ; abort by operator
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
Output "^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
Output "^J"
endif
endproc
procedure InputString string str ; input a string
string ch
str = ""
repeat
InputEcho ch
if ch <> "^M"
if ch = "^H"
if str = ""
Output " "
else
Output " ^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 name
integer pos
InputString name ; input a filename
repeat
strpos name,":",pos ; strip drive part
if pos>0
strdel name,1,pos
endif
until pos=0 or not connected
repeat
strpos name,"\",pos ; strip directory part
if pos>0
strdel name,1,pos
endif
until pos=0 or not connected
if name="" or not connected
success = FALSE
filename = ""
else
success = TRUE
filename = dir
concat filename,"\" ; concat <dir>
strpos filename,"\\",pos
if pos>0
strdel filename,pos,1 ; avoid root directory"
endif
concat filename,name
endif
endproc
procedure InputPassword string password ; input password
password = ""
repeat
DotEcho ch
if ch <> "^M"
if ch = "^H"
if password = ""
Output " "
else
Output " ^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
procedure CheckUser string username,password,integer level,valid
integer found,pos1,pos2
string record,name,pass,lev
strpos username,";",pos1 ; record format: "first last;password#level"
strpos username,"#",pos2
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
file = HOSTDIR
concat file,"HUSER.HST"
open file ; passwords in HUSER.HST
if not success
create file
endif
if not success
Output "System error, please call again later^M^J"
print "SYSOP: Cannot create HUSER.HST"
Disconnect
alarm "SYSOP: Cannot create HUSER.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,name
substr record,pos1+1,pos2-pos1-1,pass
if name=username
found = TRUE
if pass=password
valid = TRUE
substr record,pos2+1,1,lev
atoi lev,level
else
valid = FALSE
endif
endif
endif
if not found
read record
endif
endwhile
if not found ; new users
if CLOSESYSTEM
valid = FALSE
else
seek -1 ; add user if open system
write username,";",password,"#",NEWUSERLEVEL
level = 1
valid = TRUE
endif
endif
close
endproc
procedure Pause ; request a key
string ch
Output "Press [Enter] to continue "
InputEcho ch
Output "^M^J"
if ch<>"^M"
Output "^M^J"
endif
endproc
procedure TypeFile string filename,integer more
string ch ; display a file
integer i
i = 0
open filename
if not success
Output "File not found.^M^J"
else
while success
inputch ch
if success and ch = "^C" ; operator break
clear com
Output "^M^J"
exit
endif
if not local
getch ch
if success and ch = "^C" ; caller break
clear com
Output "^M^J"
exit
endif
endif
read s ; display a line
Output s
Output "^M^J"
i = i+1
if i = 22 and more ; pause if <more> is TRUE
i = 0
Output "-- More --"
InputChar ch
if ch = "^C"
clear com
Output "^M^J"
exit
endif
Output "^M ^M"
endif
endwhile
close
if more
Pause
endif
endif
endproc
procedure Directory string dir ; display download directory
string cmd
cmd = "DIR " ; DIR
concat cmd,dir ; DIR \DOWNLOAD\
concat cmd,"*.* >" ; DIR \DOWNLOAD\*.* >
concat cmd,FILEDIR ; DIR \DOWNLOAD\*.* >\HOST.DIR
dos cmd ; shell to DOS
TypeFile FILEDIR,TRUE ; display \HOST.DIR
endproc
procedure FileTransfer string mode,protocol,filename
print "^M^JPlease start your transfer procedure or press Ctrl-X to abort^M^J"
delay 20
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
if success
Output "File transfer completed^M^J"
else
Output "File transfer aborted^M^J"
endif
Pause
endproc
procedure WaitForCall ; wait for connected
integer i,len,valid,exist,baudrate
string file
set connection,modem
local = FALSE
xport = 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
RestoreOptions
script "HCONFIG" ; chain to HCONFIG.SCR
endswitch
endif
endwhile
if not local and DETECTBAUD
waitfor "CONNECT^M","CONNECT 1200","CONNECT 2400","CONNECT 9600","CONNECT 19200",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
endswitch
set baud,baudrate
Output "Connected at "
if not local
put baudrate,"^M^J"
endif
print baudrate
endif
endif
Output "^M^J"
delay 5
clear com
delay 5
file = HOSTDIR
concat file,"HWELCOME.HST"
TypeFile file,FALSE ; display welcome message
i = 1
len = 0
username = "" ; enter name (at most 3 times)
while i<=3 and len<4 and connected
Output "Please enter your First and Last name: "
InputString username
i = i+1
length username,len ; check the length of name
if len<4
Output "Name too short, please try again^M^J^M^J"
else
Output username
Output " [Y/n]? "
InputString ch
if ch="n"
len=0
endif
endif
endwhile
if len<4 and connected
Output "Goodbye^M^J"
Disconnect
else
i = 1
len = 0
password = "" ; enter password (at most 3 times)
while i<=3 and len<4 and connected
Output "Password: "
InputPassword password
i = i+1
length password,len ; check the length of ot
if len<4
Output "Password too short, please try again^M^J^M^J"
endif
endwhile
if len>=4 ; check password and get user level
CheckUser username,password,userlevel,valid
endif
if (len<4 or not valid) and connected
Output "Invalid password, access denied^M^J^M^J"
Disconnect
else
file = HOSTDIR
concat file,"HNOTICE.HST"
FileExist file,exist ; display notice
if exist
Output "^M^J"
TypeFile file,TRUE
endif
endif
endif
endproc
procedure ChatMode ; chat mode
integer x
string rch,lch
Output "^M^JChat mode begin:^M^J"
repeat
if not local
getch rch
if success
put rch,
if rch = "^M"
Output "^J"
endif
wherex x
if rch = " " and x > 65
Output "^M^J"
endif
endif
endif
inputch lch
if success and lch<>"^[" ; abort if sysop press [Esc]
Output lch
if lch = "^M"
Output "^J"
endif
wherex x
if lch = " " and x > 65
Output "^M^J"
endif
endif
until lch="^[" or not connected
Output "^M^JChat mode end.^M^J^M^J"
Pause
endproc
procedure DoCommand ; do a command
if xport
Output "Command F,U,D,T,C,X,G,(S,R,Z): " ; export mode
else
Output "^M^J^M^J"
file = HOSTDIR
concat file,"HMENU.HST"
TypeFile file,FALSE ; display menu
Output "Command: "
endif
InputEcho ch
if ch<>"^M"
Output "^M^J"
endif
switch ch
case "F": ; file directory
Directory DOWNLOADDIR
case "T": ; type a file
Output "Enter filename: "
InputFilename filename,DOWNLOADDIR
if success
TypeFile filename,TRUE
endif
case "U": ; upload a file
Output "^M^J"
file = HOSTDIR
concat file,"HPROT.HST"
TypeFile file,FALSE
Output "Select protocol: "
InputEcho protocol
Output "^M^J"
if local
Output "Function not available in local mode^M^J"
else
switch protocol
case "X","R":
Output "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
Output "^M^J"
file = HOSTDIR
concat file,"HPROT.HST"
TypeFile file,FALSE
Output "Select protocol: "
InputEcho protocol
Output "^M^J"
if local
Output "Function not available in local mode^M^J"
else
switch protocol
case "X","Y","Z","S","T","M","R","B","G":
Output "Enter filename: "
InputFilename filename,DOWNLOADDIR
if success
FileTransfer "s",protocol,filename
endif
endswitch
endif
case "C": ; yell
Output "Yelling Sysop, please wait ... ^M^J"
alarm "User is yelling ...^JPress [Enter] to accept, [Esc] to deny"
if success
print "^M^JSYSOP: press [Esc] to terminate chat mode"
ChatMode
else
Output "^M^JSorry, Sysop is not here^M^J"
endif
case "X": ; toggle export mode
xport = not xport
case "G": ; goodbye
file = HOSTDIR
concat file,"HGOODBYE.HST"
TypeFile file,FALSE
Disconnect
case "S": ; shell to DOS
if userlevel<SYSOPLEVEL
Output "Sorry, this command is for Sysop only^M^J"
else
if local ; local mode shell to DOS
Output "Shelling to DOS ... ^M^J"
dos
Output "Return from DOS shell^M^J"
else
file = HOSTDIR
concat file,"HSHELL.BAT"
fileexist file,exist ; check for HSHELL.BAT
if exist
Output "Shelling to DOS ... ^M^J"
dos file
Output "Return from DOS shell^M^J"
else
Output "SYSOP: Cannot find HSHELL.BAT^M^J"
endif
endif
endif
case "R": ; run remote program
if userlevel<SYSOPLEVEL
Output "Sorry, this command is for Sysop only^M^J"
else
file = HOSTDIR
if local ; run HLOCAL.BAT if local mode
concat file,"HLOCAL.BAT"
fileexist file,exist
if exist
Output "Loading external program ... ^M^J"
dos file
Output "Return from external program^M^J"
else
Output "SYSOP: Cannot find HLOCAL.BAT^M^J"
endif
else ; run HREMOTE.BAT if remote mode
concat file,"HREMOTE.BAT"
fileexist file,exist
if exist
Output "Loading remote program ... ^M^J"
dos file
Output "Return from remote program^M^J"
else
Output "SYSOP: Cannot find HREMOTE.BAT^M^J"
endif
endif
endif
case "Z": ; shut down host mode
if userlevel<SYSOPLEVEL
Output "Sorry, this command is for Sysop only^M^J"
else
Output "Are you sure [y/N]? "
InputString ch
if ch="y"
Output "Shutting down host mode^M^J"
Disconnect
HostEnd
endif
endif
endswitch
endproc
;
; begin main program
;
StoreOptions
HostConfig ; read configuration file HCONFIG.HST
while FOREVER
HostBegin ; initial mode
WaitForCall ; wait for a call
while connected
DoCommand ; do commands
endwhile
endwhile