Category : Communication (modem) tools and utilities
Archive   : ASPHOST.ZIP
Filename : HOST.ASP

;**************************************************************************
;* *
;* HOST.ASP *
;* Copyright (C) 1992 Datastorm Technologies, Inc. *
;* All rights reserved. *
;* *
;* An ASPECT script file that emulates the builtin functions of *
;* host mode. It was written to allow users more flexibility and *
;* control of their host mode functions. *
;* *
;* This ASPECT SCRIPT is intended only as a sample of ASPECT programming. *
;* DATASTORM makes no warranty of any kind, express or implied, including *
;* without limitation, any warranties of mechantability and/or fitness *
;* for a particular purpose. Use of this program is at your own risk. *
;* *
;* Author: Michael Schamberger - 1992 *
;* *
;**************************************************************************

;**************************************************************************
;* *
;* *
;* GLOBAL PROCOMM PLUS DEFINES *
;* *
;* *
;**************************************************************************

string HOSTWELCOM
integer HAUTOBAUD,H_Level,ATimeout,LLogin = 0
integer ANSI_ON,vidmode,hostcdxfer,filterctrl
integer Pager ; Allow Host Paging
integer Log_It ; Activity Log
integer expose ; show user password locally
integer blanktime,blanktimeout,blanker ; Screen Blanker Vars
integer HTimeOut,WTimeOut ; Inactivity timers
integer cnorm ; Normal Color
integer LCFlag = 0 ; Lost Carrier Flag
long su_baudrate ; Startup Baudrate

integer MSG_Number ; Number of Messages
integer msg_length, msg_flag, blocksize ; *
long chars_to_read ; ** Message Vars
string _DATE,_TIME ; *

string DDir ; Data Directory
string Adir1,Adir2,Adir3,Adir4,Adir5 ; Alternate Directories
string Anam1,Anam2,Anam3,Anam4,Anam5 ; Alternate Directories
string Odir,Onam ; Original Dir & Name
string St_Dir ; Startup Dir
string H_Name
long H_Baud
integer SYSTEMTYPE ; (OPEN=1 | CLOSED=0)
string H_Elapsed,H_Online,H_Offline
string HOSTULDIR,HOSTDLDIR,HOSTDLNAM
string ClrStr = "^[[1;1H^[[2J" ; ANSI Clear Screen/Home Cursor
string HostShellPort = "COM2" ; (COM1-COM4) COM for shell
string VERSION = "1.0" ; script version
string PadIt = " " ; Padding for log file
string SearchStr ; Search String

string HOSTPARMFILE = "HOST.PRM" ; Host parameter file
string HOSTUSRFILE = "PCPLUS.USR" ; User data file
string MSGFILE = "HOST.MSG" ; Message File
string HDRFILE = "HOST.HDR" ; Header File
string TEMPFILE = "~HOST.TMP" ; Temp file for Mail Processing
string HOSTNWSFILE = "HOST.NWS" ; News file
string HOSTNUFILE = "HOST.NUF" ; New user file
string HOSTLOGFILE = "HOST.LOG" ; Log of Host activity
string HOSTOPENFILE = "HOST.OPN" ; Opening Display File
string HOSTHELPFILE = "HOST.HLP" ; Help File

define PUBLIC 0 ;*
define PRIVATE 1 ;** Mail
define NEWMAIL 2 ;** Flag values
define DELETED 4 ;*

;**************************************************************************
;* *
;* *
;* INTERNAL DEFINES *
;* *
;* *
;**************************************************************************


define DEBUG 1 ; for testing, see PROC SETUP

define NAMEMAX 30 ; maximum length for user name
define PSWDMAX 8 ; maximum user password length

define DISP 1 ; display - used for HOSTGETS
define HIDE 0 ; mask - used for HOSTGETS

define MODEM_CON 0 ; Connection type is MODEM
define DIRECT_CON 1 ; Connection type is DIRECT

define HOSTNEWUSR 1 ; (0 | 1) New user level

; access levels for users
define NEWUSER 0 ; new - can't do file xfers
define REGUSER 1 ; normal - can do file xfers to upload/download areas
define SUPERUSER 2 ; super - can do file xfers to/from any drive

define FLD_SEP 59 ; Field separator is ACSII 59 (semi-colon)

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º 3.º GLOBAL VARIABLES *
;* ÈÍÍͼ *
;* *
;**************************************************************************
string record, name, first, last, password, access, remarks, msg, ontime, offtime
integer tempkey, contype

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º 4.º MAIN *
;* ÈÍÍͼ *
;* *
;**************************************************************************
include "include.inc"
include "subs.inc"
include "asciixf.inc"
include "mail.inc"

proc main
getenv "PCPLUS" ddir ; Get DOS environment variable
strcmp ddir "" ; Compare to null
if success ; success, variable not set
ddir = "." ; set to current directory
endif
call BuildDFile with &HostParmFile
call GetHostParms ; Reads Host.Prm File

call BuildDFile with &HostUsrFile ;*
call BuildDFile with &MsgFile ;***
call BuildDFile with &HdrFile ;**** Build Paths to
call BuildDFile with &TempFile ;**** data files
call BuildDFile with &HostNWSFile ;***
call BuildDFile with &HostNUFile ;**
call BuildDFile with &HostLogFile ;*
call BuildDFile with &HostOpenFile ;*
call BuildDFile with &HostHelpFile ;*

call hostlog with "************ Host Activated ************" "`n"

H_Level = -1 ; Set to -1, no previous caller
su_baudrate = 38400 ; Set initial baudrate
; This is necessary in
; order to restore maximum
; baudrates.
fetch screen vidmode ; Get Videomode
getdir 0 st_dir ; Get Startup Dir
call setup ; Setup port/Modem_Con/Vars
while 1 ; Loop forever
call mod_init ; Setup port/Modem
curoff ; Set cursor off
call waitforcall ; Wait for a caller
curon ; Set cursor on
if llogin ; If local login
call checkmail ; check mail
call hostmenu ; display menu
loopwhile ; loop back to while
endif
call GetUser ; Wait for someone to login
if success ; If user logged on,
if (! connected) && (contype==MODEM_CON) && (llogin == 0)
; If connect type is modem
; && not connect
; && not a local login
loopwhile ; No carrier? loop back to while
endif
if ansi_on && (llogin == 0) ; If ANSI on
; & it's not a local login
transmit clrstr ; transmit clear string
endif

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

call CheckMail ; Check for mail
call HostMenu ; Display menu
endif
endwhile ; Loop back to while
endproc

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º 5.º HostMenu *
;* ÈÍÍͼ *
;* *
;**************************************************************************
proc HostMenu
integer security, tries,Valid,anykey
string key,Valid_Keys,start

atoi access security ; convert access str to integer

while forever
call HostPutS with "`r`n`n`n"
call HostPutS with "`r`n "
call HostPuts with "Host Mode Options"

call HostPutS with "`r`n F)iles U)pload D)ownload"
call HostPutS with "`r`n H)elp T)ime C)hat"
call HostPutS with "`r`n R)ead mail L)eave mail G)oodbye";

if security == 1
strfmt s0 "`n`r X)change File Area (Current = `"%s`")" hostdlnam
call HostPutS with s0
endif

if security==2
call HostPutS with "`r`n"
call HostPutS with "`r`n "
call HostPuts with "Privilege Options"
call HostPutS with "`r`n A)bort (SHUT DOWN host mode)"
call HostPutS with "`r`n S)hell to DOS"
getdir 0 s1
strfmt S0 "`r`n *)change default directory (Current = `"%s`")" s1
call HostPutS with S0
endif

call HostPutS with "`r`n`r`n Your Choice? "

if (! connected) && (contype==MODEM_CON) && (llogin == 0)
; If connect type is modem
; && not connect
; && not a local login
call SetFailure
exitwhile
endif

nextkey: ; Label-Loop on invalid key

call HostGetC with &key ; Get char
if failure
exitwhile
endif

strupr key ; Uppercase key
Valid_Keys="FHRXUTLDCG" ; Define valid keys
; If you change the host menu
; and add additional options
; requiring more keys, just
; add those keys to list.
strlen Valid_Keys N0 ; Get length of valid keys
valid = 0 ; Set valid to false

strpeek key 0 n1 ; Look at first (only) char
if n1==13 ; If it's a CR
valid=1 ; it's valid
endif

for n1 = 0 upto n0 ; See if key is in list
substr s0 valid_keys n1 1 ; Get 1 char at a time
strcmp key s0 ; Compare char to key
if success ; If they match then
valid = 1 ; the key they hit
exitfor ; was valid.
endif ;
endfor

if (security == 2) && (!valid) ; If privileged
valid_keys = "AS*" ; Add 3 keys, additions made
; to privileged user menus
; need their keys added to
; this list.
strlen Valid_Keys N0 ; Get new length

for n1 = 0 upto n0 ; Check privileged keys
substr s0 valid_keys n1 1 ; Get 1 char at a time
strcmp key s0 ; Compare char to key
if success ; If they match then
valid = 1 ; the key they hit
exitfor ; was valid.
endif ;
endfor
endif

if !valid ; If key is not valid
call hostputs with "`a" ; Ring bell
rflush
goto nextkey ; Get next keystroke
endif

call HostPutS with key ; Write key

switch key ; Switch on key
;****************
;* F)iles *
;****************
case "F"
call hostlog with padit "File Listing"
if security==0
call HostPutS with "`r`nYou aren't authorized to list files!`r`n"
else
call FileList
endif
endcase
;****************
;* U)pload *
;****************
case "U"
if llogin ; Local logins can't upload
call HostPutS with "`n`r`nYou can't transfer files locally!`r`n"
loopwhile
endif
if security==0
call HostPutS with "`r`nYou aren't authorized to transfer files!`r`n"
else
call Upload
endif
endcase
;****************
;* D)ownload *
;****************
case "D"
if llogin
call HostPutS with "`n`r`nYou can't transfer files locally!`r`n"
loopwhile
endif
if security==0
call HostPutS with "`r`nYou aren't authorized to transfer files!`r`n"
else
call Download
endif
endcase
;****************
;* H)elp *
;****************
case "H"
isfile HOSTHELPFILE
if failure
call HostPutS with "`r`n`r`nHelp File Not Available`n`r"
else
tries=1
if ansi_on && (llogin == 0) ; If ANSI on
; & not local login
transmit clrstr
endif
call HostPutS with "`r`n`r`nHelp File`n`r"
call HostPutS with "---------`n`r"
call displayfile with hosthelpfile 23
endif
endcase
;****************
;* T)ime *
;****************
case "T"
time offtime 0
call HostPutS with "`r`n`r`n Online at: "
call HostPutS with ontime
call HostPutS with "`r`n It is now: "
call HostPuts with offtime
call HostPutS with "`r`nTime Online:"
call Elaps with &H_Elapsed Ontime Offtime
call HostPuts with H_Elapsed
call HostPutS with "`r`n`r`n"
endcase
;****************
;* C)hat *
;****************
case "C"
if llogin
call HostPutS with "`n`r`nYou can't chat locally!`r`n`a"
loopwhile
endif
if ! pager ; Allow Page?
call HostPutS with "`r`n`nHost Operator is not available!`r`n`a"
loopwhile ; If not
endif
call HostPutS with "`r`n`nPaging Host Operator ...`r`n"
message "*** Press F1 to accept ***"
time start 0 ; Set Start Time
tries = 0 ; Set Tries to 0
while tries < 7 ; If Tries < 7
sound 500 5 ; * Sound
sound 1000 5 ; * Beep
call elapsed with &tries start $time0 ; Get Elapsed Time
if hitkey ; Check for Keyhit
keyget anykey ; Get Key
if anykey == 0x3B00 ; F2 hit?
call hostlog with padit "Chatted with Sysop"
call chat ; Go into chat
tries = 99 ; Set Tries > 7
exitwhile ; Leave While
endif
endif
endwhile
if tries != 99 ; If Not Timedout
call HostPutS with "`r`n`nHost Operator is not available!`r`n`a"
endif
endcase
;****************
;* R)ead Mail *
;****************
case "R"
call hostlog with padit "Read Mail"
call ReadMail
endcase
;****************
;* L)eave Mail *
;****************
case "L"
call hostlog with padit "Left Mail"
call LeaveMail with "" ""
endcase
;****************
;* X)change Dir *
;****************
case "X"
if security == 1
call hostlog with padit "Changed File Area"
call Change_Dir
endif
endcase
;****************
;* G)oodbye *
;****************
case "G" ;Goodbye
time offtime 0
H_Offline = offtime
call HostPutS with "`r`n`r`nOnline at: "
call HostPutS with H_online
call HostPutS with "`r`nIt is now: "
call HostPuts with H_offline
call elaps with &H_Elapsed H_Online H_Offline
call HostPuts with "`r`n`r`nTotal Time Online: "
call HostPuts with H_Elapsed
call HostPutS with "`r`n`r`n"

strfmt s0 "%s - Logged Off after%s`n" name H_Elapsed
call hostlog with "" s0

llogin = 0 ; Reset local login

if CONTYPE == Modem_Con
call HostHangup
endif
exitwhile
endcase
;****************
; A)bort *
;****************
case "A"
call ExitHost with 1
endcase
;****************
; * Switch *
;****************
case "*"
call SwitchDir
endcase
;****************
; S)hell *
;****************
case "S"
if llogin
call HostPutS with "`n`r`nYou can't shell locally!`r`n"
loopwhile
endif
if ! connected ; If CD not present
call hostputs with "`r`n"
call hostputs with "`a`r`nShell is not available!`r`n`"CD`" is"
call hostputs with " not being detected on host machine`r`n"
loopwhile
endif
statmsg "User has shelled to DOS"
call hostlog with padit "Shelled to DOS"

strfmt s0 "Command.Com %s" HostShellPort
run s0 noclear ; Perform Dos Shell

set statline on ; Restore status line
key = " " ; Reset key
call flush_it ; Flush everything
clear 23
endcase
endswitch
endwhile
endproc

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º 6.º FileList *
;* ÈÍÍͼ *
;* *
;*****************************************+********************************
proc FileList
string filespec, list, key, dirflag=""
integer security, again=0, linenum=1, maxlen=40
integer flen

atoi access security ; Convert Security to Integer

call HostPutS with "`r`n`nEnter FILE SPEC: (Carriage Return = *.*)`r`n> "
call HostGetS with &filespec maxlen DISP

strcmp filespec "" ; Check for null filespec
if success ; If true
filespec="*.*" ; Set to wildcards
endif

if security!=2 ; If not privileged
find filespec "\" ; Check for "\"
if found
call hostputs with "`r`n`r`n"
call hostputs with "You don't have rights to specify directories!`r`n"

strset s9 0 79 ;*
strset s0 0 79 ;** Set to Null
strset s1 0 79 ;*

strlen filespec flen ; Get length of filespec
strpeek filespec flen n1 ;
while n1 != 92 ; While not "\"
strpoke s1 0 n1 ; Build filespec w/o path
strcat s0 s1 1 ; Store in S0
flen-- ;
strpeek filespec flen n1 ;
endwhile

filespec=s0 ; Reset File spec w/o path
strset s0 0 79 ; Clear S0
strlen filespec flen ;
flen-- ; Dec to point to last character
n3=flen ;
while flen > -1 ;
strpeek filespec flen n1 ;
n2 = n3 - flen ;
strpoke s0 n2 n1 ;
flen-- ;
endwhile ;
filespec=s0 ;
strlen filespec flen ;
if flen<2 ;
filespec = "*.*" ;
endif ;
endif ;

strcpy list HOSTDLDIR ; Set List Directory
strlen list n9 ; Get Length
if n9>0
dec n9 ; Dec Len (String Idx Starts 0)
else
list = "."
endif
strpeek list n9 n8 ; Look at last char
if !(n8 == 92) ; Not "\" ?
strcat list "\" ; Append BackSlash
endif
strcat list filespec ; Append filespec
else
strcpy list filespec ; Use filespec
endif

Call HostPuts With "`r`n`r`nFile Specs: "
Call HostPuts With FileSpec
Call HostPuts With "`r`n`r`n"

linenum = 3

findfirst list "D" ; Search for files include DIRS
if found
find $FATTR "D" ; If Attribute Directory
if found
if security == 2
strfmt msg "`r`n`r`n %-12s %8s %9s %s`r`n" $FILENAME dirflag $FDATE $FTIME
linenum++
else
msg = $null ; Not Privileged, don't show
endif ; in list
else ; Not directory
linenum++
strfmt msg "`r`n`r`n %-12s %8ld %9s %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
call HostPutS with msg
endif
again=1
else
call HostPutS with "`r`n`r`nNo files found.`r`n"
endif
while again
if linenum==24
linenum=1
call HostPutS with "-MORE? (Y/n)-"
call HostGetC with &key
call HostPutS with "`r `r"

switch key
case "n" ;"n"
case "N" ; "N"
exitwhile ; Leave filelist
endcase
endswitch
endif

findnext ; Get next filename
if found
find $FATTR "D"
if found
if security == 2
strfmt msg " %-12s %8s %9s %s`r`n" $FILENAME dirflag $FDATE $FTIME
linenum++
else
msg = $null
endif
else
linenum++
strfmt msg " %-12s %8ld %9s %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
endif
call HostPutS with msg
else
call HostPutS with "`r`nEnd of list.`r`n"
call HostPutS with "Hit any key..."
call HostGetC with &key
call HostPutS with "`r `r"
exitwhile
endif
endwhile
endproc

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º 7.º Upload *
;* ÈÍÍͼ *
;* *
;**************************************************************************
proc upload
string filename, choice
string xferbegin = "`r`nBegin your %s transfer procedure... (CTRL-X Aborts)`r`n"
string dltdldir
string xferout

integer calledfrom = 0, NoWild = 0
fetch dldir dltdldir

while 1
set dldir hostuldir
call HostPutS with "`r`n"
call HostPutS with "`r`nA) Ascii Y) Ymodem (Batch) S) Sealink"
call HostPutS with "`r`nK) Kermit O) 1K-Xmodem T) Telink"
call HostPutS with "`r`nX) Xmodem E) 1K-Xmodem-G W) Wxmodem"
call HostPutS with "`r`nZ) Zmodem G) Ymodem-G (Batch) I) Imodem"
call HostPutS with "`r`n"
call HostPutS with "`r`nYour choice? "

if (! connected) && (contype==MODEM_CON) && (llogin == 0)
; If connect type is modem
; && not connect
; && not a local login
call SetFailure
exitwhile
endif

call HostGetC with &choice
if failure
exitwhile
endif
call HostPutS with choice

switch choice
;****************
;* A)scii *
;****************
case "A"
call GetFname with &filename calledfrom nowild ; Get name
if failure ; If fails exit
exitwhile
endif
call getascii with filename ; Call Asciixf
endcase
;****************
;* K)ermit *
;****************
case "K"
strfmt xferout xferbegin "KERMIT"
call HostPutS with xferout
getfile kermit
endcase
;****************
;* X)modem *
;****************
case "X"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "XMODEM"
call HostPutS with xferout
getfile xmodem filename
endcase
;****************
;* Z)modem *
;****************
case "Z"
strfmt xferout xferbegin "ZMODEM"
call HostPutS with xferout
getfile zmodem
endcase
;****************
;* Y)modem *
;****************
case "Y"
strfmt xferout xferbegin "YMODEM"
call HostPutS with xferout
getfile ymodem
endcase
;********j*******
;* O) 1K Xmodem *
;****************
case "O"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "1K-XMODEM"
call HostPutS with xferout
getfile 1kxmodem filename
endcase
;*****************
;* E) 1K Xmodem-G*
;*****************
case "E"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "1K-XMODEM-G"
call HostPutS with xferout
getfile 1kxmodemg filename
endcase
;****************
;* Y)modem-G *
;****************
case "G"
strfmt xferout xferbegin "YMODEM-G"
call HostPutS with xferout
getfile ymodemg
endcase
;****************
;* S)ealink *
;****************
case "S"
strfmt xferout xferbegin "SEALINK"
call HostPutS with xferout
getfile sealink
endcase
;****************
;* T)elink *
;****************
case "T"
strfmt xferout xferbegin "TELINK"
call HostPutS with xferout
getfile telink
endcase
;****************
;* W)xmodem *
;****************
case "W"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "WXMODEM"
call HostPutS with xferout
getfile wxmodem filename
endcase
;****************
;* I)modem *
;****************
case "I"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "IMODEM"
call HostPutS with xferout
getfile imodem filename
endcase
;****************
;* Default *
;****************
default
exitwhile
endcase
endswitch

if success
call HostPutS with "`r`nTRANSFER COMPLETE.`r`n"
call hostlog with padit "File Uploaded Successfully!`r`n"
else
call hostlog with padit "Attempted File Upload - Unsuccessful`r`n"
call HostPutS with "`r`nTRANSFER ABORTED!`r`n`r`n"
endif
exitwhile
endwhile
set dldir dltdldir
endproc

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º 8.º Download *
;* ÈÍÍͼ *
;* *
;**************************************************************************
proc download

string filename, choice
string xferbegin = "`r`nBegin your %s transfer procedure... (CTRL-X aborts)`r`n"
string asciibegin= "`r`nPress to begin transfer...(Ctrl-C aborts)`R`N"
string xferout
integer calledfrom = 1, WildOK = 1, NoWild = 0

while 1
call HostPutS with "`r`n"
call HostPutS with "`r`nA) Ascii Y) Ymodem (Batch) S) Sealink"
call HostPutS with "`r`nK) Kermit O) 1K-Xmodem T) Telink"
call HostPutS with "`r`nX) Xmodem E) 1K-Xmodem-G W) Wxmodem"
call HostPutS with "`r`nZ) Zmodem G) Ymodem-G (Batch) I) Imodem"
call HostPutS with "`r`n";
call HostPutS with "`r`nYour choice? "

if (! connected) && (contype==MODEM_CON) && (llogin == 0)
; If connect type is modem
; && not connect
; && not a local login
call SetFailure
exitwhile
endif

call HostGetC with &choice
if failure
exitwhile
endif

call HostPutS with choice

switch choice
;****************
;* A)scii *
;****************
case "A"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
call HostPutS with asciibegin
SENDFILE ASCII filename
endcase
;****************
;* K)ermit *
;****************
case "K"
call GetFname with &filename calledfrom wildok
if failure
exitwhile
endif
strfmt xferout xferbegin "KERMIT"
call HostPutS with xferout
sendfile kermit filename
endcase
;****************
;* X)modem *
;****************
case "X"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "XMODEM"
call HostPutS with xferout
sendfile xmodem filename
endcase
;****************
;* Z)modem *
;****************
case "Z"
call GetFname with &filename calledfrom wildok
if failure
exitwhile
endif
strfmt xferout xferbegin "ZMODEM"
call HostPutS with xferout
sendfile zmodem filename
endcase
;****************
;* Y)modem *
;****************
case "Y"
call GetFname with &filename calledfrom wildok
if failure
exitwhile
endif
strfmt xferout xferbegin "YMODEM"
call HostPutS with xferout
sendfile ymodem filename
endcase
;****************
;* O) 1K Xmodem *
;****************
case "O"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "1K-XMODEM"
call HostPutS with xferout
sendfile 1kxmodem filename
endcase
;****************
;* E) 1K XmodemG*
;****************
case "E"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "1K-XMODEM-G"
call HostPutS with xferout
sendfile 1kxmodemg filename
endcase
;****************
;* Y)modem-G *
;****************
case "G"
call GetFname with &filename calledfrom wildok
if failure
exitwhile
endif
strfmt xferout xferbegin "YMODEM-G"
call HostPutS with xferout
sendfile ymodemg filename
endcase
;****************
;* S)ealink *
;****************
case "S"
call GetFname with &filename calledfrom wildok
if failure
exitwhile
endif
strfmt xferout xferbegin "SEALINK"
call HostPutS with xferout
sendfile sealink filename
endcase
;****************
;* T)elink *
;****************
case "T"
call GetFname with &filename calledfrom wildok
if failure
exitwhile
endif
strfmt xferout xferbegin "TELINK"
call HostPutS with xferout
sendfile telink filename
endcase
;****************
;* W)xmodem *
;****************
case "W"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "WXMODEM"
call HostPutS with xferout
sendfile wxmodem filename
endcase
;****************
;* I)modem *
;****************
case "I"
call GetFname with &filename calledfrom nowild
if failure
exitwhile
endif
strfmt xferout xferbegin "IMODEM"
call HostPutS with xferout
sendfile imodem filename
endcase
;****************
;* Default *
;****************
default
exitwhile
endcase
endswitch
call strippath with &filename
if success
strfmt s0 "Download - %s - Successful" filename
call hostlog with padit s0
call HostPutS with "`r`nTRANSFER COMPLETE.`r`n"
else
strfmt s0 "Download - %s - Unsuccessful" filename
call hostlog with padit s0
call HostPutS with "`r`nTRANSFER ABORTED!`r`n`r`n"
endif
exitwhile
endwhile
endproc

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º 9.º GetFname *
;* ÈÍÍͼ *
;* *
;**************************************************************************
proc GetFname
strparm fname
intparm calledfrom,wildcards
string path
integer security

atoi access security
if calledfrom == 1
path = HostDlDir
else
path = HostUlDir ; was hostuldir
endif
call HostPutS with "`r`n`r`nFile name? "
call HostGetS with &fname 50 DISP
if failure
call SetFailure
return
endif

strcmp fname ""
if success && (calledfrom == 1) ; You have to specify filename
call setfailure ; for download
return
endif

strupr fname
call HostPutS with "`r`n"
if security!=2
find fname ":"
if found
strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
call HostPutS with msg
call SetFailure
return
endif

find fname "\"
if found
strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
call HostPutS with msg
call SetFailure
return
endif

strlen path n1 ; Get length of path
dec n1 ; Dec by 1, string index start
; with 0
strpeek path n1 n2 ; Look at last character
if n2 != 92 ; Is it a "\"
strcat path "\" ; No? Add one
endif

strcat path fname
fname=path
endif

strcmp fname ""
if success
call setfailure
return
endif

if !wildcards ; If wildcard disallowed
call IsWildcard with &fname ; Check for wildcards
if failure
return
endif
endif

findfirst fname
if not found
if calledfrom == 1
call HostPutS with "`r`nFile not found!`r`n"
call SetFailure
return
else
call SetSuccess
return
endif
else
if calledfrom == 0
if security !=2
call HostPutS with "`r`nFile already exists!`r`n"
call SetFailure
return
else
call HostputS with "`r`nFile exists, overwrite? "
call HostGetYN
if success
call HostPutS with "`r`n"
delete fname
if failure
call HostPutS with "`r`n`r`nCan't delete file!`r`n"
call SetFailure
return
endif
call SetSuccess
return
endif
call HostPutS with "`r`n"
call SetFailure
return
endif
endif
call SetSuccess
endif
call HostPutS with "`r`n"
endproc

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º10.º IsWildcard *
;* ÈÍÍͼ *
;* *
;**************************************************************************
proc IsWildcard
strparm fname
string error = "`r`nNo wildcards allowed!`r`n"

find fname "*"
if found
call HostPutS with error
call SetFailure
return
endif

find fname "?"
if found
call HostPutS with error
call SetFailure
return
endif

call SetSuccess
endproc
;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º11.º SwitchDir *
;* ÈÍÍͼ *
;* *
;**************************************************************************
proc SwitchDir
string path, newpath


getdir 0 path
strfmt msg "`r`n`nCurrent directory is %s`r`n" path
call HostPutS with msg
call HostPutS with "Change to what directory? "
call HostGetS with &newpath 50 DISP
if success
call IsWildcard with newpath
call HostPuts with "`r`n"
call Dexist with newpath
if success
chdir newpath
else
call HostPutS with "`nSorry that directory doesn't exist`a`r`n"
endif
endif
endproc


;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º12.º Alternate Directory *
;* ÈÍÍͼ *
;* *
;**************************************************************************
proc Change_Dir
string tempout,choice

strupr adir1 ;*
strupr adir2 ;**
strupr adir3 ;*** Convert All Dirnames
strupr adir4 ;*** to Uppercase
strupr adir5 ;**
strupr odir ;*

call HostPutS with "`r`n`r`nChange Directory`r`n"
call HostPutS with "----------------`r`n"

strfmt tempout "`r1) %s`r`n" anam1
call HostPutS with tempout

strfmt tempout "`r2) %s`r`n" anam2
call HostPutS with tempout

strfmt tempout "`r3) %s`r`n" anam3
call HostPutS with tempout

strfmt tempout "`r4) %s`r`n" anam4
call HostPutS with tempout

strfmt tempout "`r5) %s`r`n" anam5
call HostPutS with tempout

strfmt tempout "`rX) %s`r`n" onam
call HostPutS with tempout

strfmt tempout "`r`nCurrent: %s`r`n" hostdlNAM
call hostputs with tempout

choice = ""
call hostputs with "Your Choice: "
call hostgetc with &choice
call hostputs with choice

strpeek choice 0 n1 ; Check for Enter (No Choice)
if n1 == 13
choice = "OK"
endif

switch choice
case "X"
hostdldir=odir
hostdlnam=onam
endcase
case "1"
hostdldir=adir1
hostdlnam=anam1
endcase
case "2"
hostdldir=adir2
hostdlnam=anam2
endcase
case "3"
hostdldir=adir3
hostdlnam=anam3
endcase
case "4"
hostdldir=adir4
hostdlnam=anam4
endcase
case "5"
hostdldir=adir5
hostdlnam=anam5
endcase
case "OK"
endcase
default
call hostputs with " - Invalid Choice^G"
endcase
endswitch
call hostputs with "`r`n"

strcmp hostdlnam "N/A" ; if dir not valid
if success ; set to default
hostdlnam = onam
hostdldir = odir
endif
endproc

;**************************************************************************
;* *
;* ÉÍÍÍ» *
;* º13.º Host Chat Mode *
;* ÈÍÍͼ *
;* *
;**************************************************************************
proc chat
string lineout,char
integer anykey,irow,icol,orow,ocol,iidx


if ansi_on && (llogin == 0) ; If ANSI on
; & it's not a local login
transmit clrstr
endif
call hostputs with "`r`nOperator ONLINE`r`n`r`n"
clear 14 ; Clear & Set to Black
box 0 0 23 79 13 ; Draw Outline Box
box 1 1 16 78 11 ; Draw Remote Box
box 17 2 22 77 11 ; Draw Local Box
atsay 0 30 13 "µ Host Mode Chat Æ"
atsay 16 31 11 "µ REMOTE SYSTEM Æ"
atsay 22 31 11 "µ LOCAL SYSTEM Æ"
; atsay 17 32 11 "µ ESC to Exit Æ"
atsay 23 32 13 "µ ESC to Exit Æ"

anykey = 0 ; Reset anykey
orow=2 ; Set Outrow 2
ocol=2 ; Set Outcol 2
irow=18 ; Set Inrow 18
icol=3 ; Set Incol 2
iidx = 0 ; Set InIndex 0

lineout=""

while 1
locate irow icol ; Set cursor pos(Always in Host box)
if hitkey
keyget anykey

if anykey == 27
strlen lineout n9
if n9 > 1
transmit "`r`nHOST: " ; Tranmit Host
transmit lineout ; Transmit
endif
exitwhile
endif

if (anykey == 13) || (icol > 75) ; If Enter hit or index goes beyond 75
; stop at 76 because when you add
; the "HOST:" to outgoing message
; you get wrap-a-round on remote
; user's 80 column screen.
strcat lineout "^J^M" ; Add LF,CR
transmit "`r`nHOST: " ; Tranmit Host
transmit lineout ; Transmit
icol=3 ; Reposition to col 2
inc irow ; Inc row
locate irow icol ; Locate cursor
lineout="" ; Reset Lineout
iidx = 0 ; Reset Index
if irow > 21 ; Last Row? then scroll
scroll 1 18 3 21 76 14
irow = 21
locate irow icol
endif
endif

if anykey == 0xE08 ; Adjust for Backspace
anykey = 8

strlen lineout n9
if n9 > 0
dec n9
if n9 > 0
dec n9
endif
substr lineout lineout 0 n9
endif
dec iidx
endif

if ((anykey > 31) && (anykey<127)) || (anykey == 8) ; Check for valid keys

if anykey == 8 ; Backspace
if icol > 3
dec icol
dec iidx
endif
locate irow icol
writec 32
endif

locate irow icol ; If not backspace
if anykey != 8
writec anykey
inc icol
endif

key2ascii anykey char
strcat lineout char
inc iidx
endif
endif

if comdata ; Check for data at port
comgetc n0 ; Get it
if n0 > -1 ; Validate, -1 means no data
if n0 == 13 ; Check for CR
call hostputs with "`r`n" ; add CR,LF
inc orow
ocol = 2
locate orow ocol
else
locate orow ocol
key2ascii n0 s0
call hostputs with s0
inc ocol
endif
if n0 == 8
dec ocol
dec ocol
endif
if ocol < 2
ocol = 2
endif
if ocol > 77
inc orow
ocol = 2
endif
if orow > 15
scroll 1 2 2 15 77 14
orow = 15
locate orow ocol
endif
endif
endif
endwhile
clear cnorm
endproc