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

; HOST.ASP v 1.02a
;******************************************************************************
;* *
;* HOST.ASP V1.02 *
;* Copyright (C) 1993 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 - 1993 *
;* *
;* Program History *
;* --------------- *
;* 1.01 - November 1992 - mps *
;* 1) The initial baudrate is no longer hard coded. It is obtained *
;* from the current port setting. *
;* 2) The COM port used by the shell function is no longer hard coded. *
;* The current port is assumed as the host shell port. *
;* 3) Change directory for priveleged users now excepts ".." & "." *
;* 4) Colors are obtained directly from PCPLUS.PRM file. (Uses Normal & *
;* Hilight colors from File Transfer Window settings.) *
;* Note: If changes are made to the colors with SETUP, but NOT made *
;* permanent, they will not be reflected by the script. The script *
;* access the PCPLUS.PRM file, & temporary changes are not saved. *
;* 5) Chat mode exits when an ESC is receive from remote. *
;* Chat termination messages added. *
;* 6) Fixed error when Host Download path is blank. (Range Error) *
;* *
;* 1.01b - December 1992 - mps *
;* ------ *
;* *
;* 1) Recognizes SYSOP as valid name (no longer prompts for last name) *
;* 2) Obeys Host Setup Goodbye action *
;* 3) Now has one exit point *
;* 4) Includes code to add additional character checking during logins. *
;* This is for users in the European Community who need to use *
;* 8-bit ASCII characters in their login name. *
;* 5) EC flag added to HOST.PRM for use in EC and added to HostUtil.Asp. *
;* *
;* 1.02 - January 1993 - mps *
;* ---- *
;* *
;* 1) User access derived from PCPLUS.USR. *
;* 2) If PCPLUS.USR file doesn't exist, it's be created. *
;* 3) To all users who received an "Unable to create (NULL)" message, *
;* sorry, I've re-added the filename causing the problem. Who says *
;* cryptic error messages can't be fun. *
;* 4) Sysop can now initiate a chat with "F1". *
;* *
;* 1.02a - February 1993 - mps *
;* ----- *
;* *
;* 1) Problem with EC flag fixed. *
;* 2) Users with 1 directory to access, now only get 1. *
;* *
;* 1.02b - March 1993 - mps *
;* ----- *
;* *
;* 1) Added "View File" option to menu *
;* *
;* *
;******************************************************************************

;******************************************************************************
;* GLOBAL VARIABLES *
;******************************************************************************

integer TempKey, ConType
long SU_Baudrate ; Startup Baudrate
long H_Baud
integer HAutoBaud,H_Level,ATimeout,LLogin = 0
integer AnsiOn,VidMode,HostCDXfer,FilterCtrl
integer AnsiOK = 1 ; Result of ANSI query
integer Pager ; Allow Host Paging
integer LogIt ; 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
integer SystemType ; (OPEN=1 | CLOSED=0)
integer HostGBye ; Goodbye action
integer LoginFail = 0 ; Failed login attempt
integer ECFlag = -1 ; European Community flag
integer MaxDirs = 0 ; # of addition dirs for users
integer MSGNumber ; Number of Messages
integer MsgLength, MsgFlag, Blocksize ; *
long CharsToRead ; ** Message Vars
string _DATE,_TIME ; *

string Record, Name, First, Last, Password, Access ; Mail vars
string Remarks, MSG, OnTime, OffTime ; Mail vars
string LibAccess ; Libraries Accessable

string DataDir ; Data Directory
string ADir1,ADir2,ADir3,ADir4,ADir5 ; Alternate directory
string ADir6,ADir7,ADir8,ADir9,ADir0 ; Paths
string ANam1,ANam2,ANam3,ANam4,ANam5 ; Alternate directory
string ANam6,ANam7,ANam8,ANam9,ANam0 ; name
string UDir1,UDir2,UDir3,UDir4,UDir5 ; Alternate directory
string UDir6,UDir7,UDir8,UDir9,UDir0 ; Paths for users
string UNam1,UNam2,UNam3,UNam4,UNam5 ; Alternate directory
string UNam6,UNam7,UNam8,UNam9,UNam0 ; name for users
string Odir,Onam ; Original Dir & Name
string St_Dir ; Startup Dir
string H_Name

string HostWelcom
string H_Elapsed,H_Online,H_Offline
string HostULDir,HostDLDir,HostDLNam
string ClrStr = "^[[1;1H^[[2J" ; ANSI Clear Screen/Home Cursor
string VABold = "^[[1m" ; Bold ANSI video attribute
string VANorm = "^[[m" ; Normal Video Attribute
string HostShellPort ; COM port used by shell
string Version = "1.02" ; 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
string PCPlusParm = "PCPLUS.PRM" ; PCPLUS parm file

;**************************************************************************
;* GLOBAL MACROS *
;**************************************************************************

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

define DEBUG 0 ; for testing, see PROC SETUP
define NAMEMAX 30 ; maximum length for user name
define PSWDMAX 8 ; maximum user password length

define HRECYCLE 0 ;*
define HHANGUP 1 ;** Host Goodbye Actions
define HEXIT 2 ;*

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

define MODEMTYPE 0 ; Connection type is MODEM
define DIRECTTYPE 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 0x3B ; Field separator is ACSII 59 (semi-colon)
define ESC 0x1B
define GREYENTER 0xE00D
define BSPACE 0x0E08

;**************************************************************************
;* INCLUDED FILES *
;**************************************************************************

include "INCLUDE.INC"
include "SUBS1.INC"
include "SUBS2.INC"
include "ASCIIXF.INC"
include "MAIL.INC"

;**************************************************************************
;* MAIN *
;**************************************************************************

proc Main
call TermSetup
call Setup ; Setup port/MODEMTYPE/Vars
call HostMode
endproc

;**************************************************************************
;* Procedure: HostMode *
;* Purpose: *
;* return: *
;* Notes: *
;**************************************************************************

proc HostMode
call HostLog with "************ Host Activated ************" "`n"
while 1 ; Loop forever
LLogin=0
call ModemInit ; Setup port/Modem
curoff ; Set cursor off
call WaitForCall ; Wait for a caller
curon ; Set cursor on

if LLogin ; If local login
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==MODEMTYPE) && (!LLogin)
; If connect type is modem
; && not connect

; && not a local login
loopwhile ; No carrier? loop back to while
endif

call ClearScreen

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

call HostMenu ; Display menu
endif

if (ConType==ModemType) && (HostGBye!=HExit)
call HostHangup ; If Recycle or Hangup hangup
endif

if (HostGBye!=HRecycle) && (!LoginFail) ; If (Exit or Hangup) and
; this wasn't a failed login
exitwhile ; exit the while loop
endif
endwhile ; Loop back to get next caller
call rescreen ; Restore screen & vid attribs
endproc

;**************************************************************************
;* Procedure: TermSetup *
;* Purpose: Define Paths/files, read parameter file *
;* return: *
;* Notes: *
;**************************************************************************

proc TermSetup

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

call BuildDFile with &PCPLUSParm ;*
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 ;*

H_Level = -1 ; Set to -1, no previous caller
fetch SCREEN VIDMODE ; Get Videomode
getdir 0 St_Dir ; Get Startup Dir
endproc

;**************************************************************************
;* ÉÍÍÍ» *
;* º 5.º HostMenu *
;* ÈÍÍͼ *
;**************************************************************************

proc HostMenu
integer Security, Tries,Valid,AnyKey
string Key,ValidKeys,Start

atoi Access Security ; convert Access str to integer
call CheckMail ; check mail

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

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"

;call HostPuts with " V)iew file" ; Not implemented yet

call HostPutS with "`r`n G)oodbye"
if (Security == 1) && (MaxDirs > -1)
strfmt S0 "`n`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%10s*)change default directory (Current = `"%s`")" " " S1
call HostPutS with S0
endif

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

if (!Connected) && (ConType==MODEMTYPE) && (LLogin==0)
; If connect type is modem
; && not connected
; && 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
ValidKeys="VFHRXUTLDCG" ; Define valid keys
; If you change the host menu
; and add additional options
; requiring more keys, just
; add those keys to list.
strlen ValidKeys N0 ; Get length of valid keys
Valid = 0 ; Set valid to false

strpeek Key 0 N1 ; Look at first (only) Char
if N1==0X0D ; If it's a CR
Valid=1 ; it's valid
endif

for N1 = 0 upto N0 ; See if key is in list
substr S0 ValidKeys 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
ValidKeys = "AS*" ; Add 3 keys, additions made
; to privileged user menus
; need their keys added to
; this list.
strlen ValidKeys N0 ; Get new length

for N1 = 0 upto N0 ; Check privileged keys
substr S0 ValidKeys 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 ; Flush receive buffer
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

call ClearScreen

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 == F1 ; F1 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) && (MaxDirs > -1)
call HostLog with PadIt "Changed File Area"
call ChangeDir
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
return ; Exit HostMenu loop
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 FlushIt ; Flush everything
clear 23
endcase
;****************
;* V)iew file *
;****************
; case "V" ; Not implemented yet
; call Viewer ;
; 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
dec FLen ;
strpeek FileSpec FLen N1 ;
endwhile

FileSpec=S0 ; Reset File spec w/o Path
strset S0 0 79 ; Clear S0
strlen FileSpec FLen ;
dec FLen ; Dec to point to last Character
N3=FLen ;
while FLen > -1 ;
strpeek FileSpec FLen N1 ;
N2 = N3 - FLen ;
strpoke s0 N2 N1 ;
dec 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 ; (Security does equal 2)
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
if !FOUND && Security != 2
call HostPutS with "`r`n`r`n *** No files found ***`r`n"
return
endif

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
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 ""
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==MODEMTYPE) && (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
;****************
;* 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==MODEMTYPE) && (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
if N1 > 1 ; Is Path empty?
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
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 !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
string 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 ChangeDir
string TempOut
string Choice
integer Loop
string DirTitle

call HostPutS with "`r`n`r`nChange File Area`r`n"
call HostPutS with "----------------`r`n"

for Loop = 0 upto MaxDirs
call SetDirTitle with &DirTitle Loop
strfmt TempOut "`r%i) %s`r`n" Loop DirTitle
call HostPutS with TempOut
endfor

strfmt TempOut "X) Default Area"
call HostPutS with TempOut

strfmt TempOut "`r`n`nCurrent: %s`r`n" HostDlNam
call HostPutS with TempOut

Choice = ""
call HostPutS with "`r`nYour Choice: "
call HostGetC with &Choice
call HostPutS with Choice

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

atoi Choice N0
if N0 > MaxDirs
Choice = "99"
endif

switch Choice
case "0"
HostDlDir=UDir0
HostDlNam=UNam0
endcase
case "1"
HostDlDir=UDir1
HostDlNam=UNam1
endcase
case "2"
HostDlDir=UDir2
HostDlNam=UNam2
endcase
case "3"
HostDlDir=UDir3
HostDlNam=UNam3
endcase
case "4"
HostDlDir=UDir4
HostDlNam=UNam4
endcase
case "5"
HostDlDir=UDir5
HostDlNam=UNam5
endcase
case "6"
HostDlDir=UDir6
HostDlNam=UNam6
endcase
case "7"
HostDlDir=UDir7
HostDlNam=UNam7
endcase
case "8"
HostDlDir=UDir8
HostDlNam=UNam8
endcase
case "9"
HostDlDir=UDir9
HostDlNam=UNam9
endcase
case "X"
HostDlDir=ODir
HostDlNam=ONam
endcase
case "OK"
endcase
default
call HostPutS with " - Invalid Choice"
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

;**************************************************************************
;* *
;* SetDirTitle *
;* *
;**************************************************************************

proc SetDirTitle
strparm Title
intparm Index

switch Index
case 0
Title=UNam0
endcase
case 1
Title=UNam1
endcase
case 2
Title=UNam2
endcase
case 3
Title=UNam3
endcase
case 4
Title=UNam4
endcase
case 5
Title=UNam5
endcase
case 6
Title=UNam6
endcase
case 7
Title=UNam7
endcase
case 8
Title=UNam8
endcase
case 9
Title=UNam9
endcase
default
Title="N/A"
endcase
endswitch
endproc

;**************************************************************************
;* ÉÍÍÍ» *
;* º13.º Host Chat Mode *
;* ÈÍÍͼ *
;**************************************************************************

proc Chat
string Lineout,Char,ExitMsg
integer AnyKey,IRow,ICol,ORow,OCol,IIdx,ComChar
integer LastRow = 21
integer Len

call ClearScreen

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 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 == 0x1B
strlen Lineout Len
if Len > 1
transmit "`r`nHOST: " ; Tranmit Host
transmit Lineout ; Transmit
endif
ExitMsg = "`r`n`nChat terminated by SYSOP`r`n`n"
exitwhile
endif

if (AnyKey == 13) || (ICol > 75) ; If Enter 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 > LastRow ; Last Row? then scroll
scroll 1 18 3 21 76 14
IRow = LastRow
locate IRow ICol
endif
endif

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

strlen Lineout Len
if Len > 0
dec Len
if Len > 0
dec Len
endif
substr Lineout Lineout 0 Len
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 ComChar ; Get it
if ComChar > -1 ; Validate, -1 means no data
if ComChar == 0x1B ; If we get an ESC
ExitMsg = "`r`n`nESCAPE received from user`r`n`n"
exitwhile
endif
if ComChar == 0xD ; Check for CR
call HostPutS with "`r`n" ; add CR,LF
inc ORow
OCol = 2
locate ORow OCol
else
locate ORow OCol
key2ascii ComChar S0
call HostPutS with S0
inc OCol
endif
if ComChar == 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
call HostPutS with ExitMsg
endproc

proc ClearScreen
if !LLogin && AnsiOn
transmit ClrStr
clear
endif
endproc

proc Viewer

call ClearScreen

endproc