;************************************************************************** ;* * ;* 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