Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / communic / asylib / asydemo.bas < prev next >

Wrap

BASIC Source File | 1989-03-04 | 47.9 KB | 1,817 lines

' AsyDEMO - (C) InfoSoft, 1987-1988 ' ALL RIGHTS RESERVED ' ' This serves as a demo of some comport and async programming from ' QuickBasic 4.0. ' ' This was written with a TAB setting of 5 ' ' BILL! Look NO GOTOs !!!!!!! ' ' TYPE struct ' dialing directory structure BBS AS STRING * 30 ' BBS name Phone AS STRING * 14 ' phone number BPS AS LONG ' "baud" (115000 > integer) Par AS INTEGER ' parity, WordLen, Stop bits WLen AS INTEGER SBit AS INTEGER Comment AS STRING * 20 ' a comment ProtoPtr AS INTEGER ' default protocol array pointer PWord AS STRING * 20 ' Password LDate AS STRING * 10 ' last date on LTime AS STRING * 5 ' last time on Upls AS INTEGER ' successful UpL count Dnls AS INTEGER ' successful DnL count END TYPE TYPE stra ' parameter type file Cport AS INTEGER BPS AS LONG Par AS INTEGER ' parity, WordLen, Stop bits WLen AS INTEGER SBit AS INTEGER ' prefix as string Echo AS INTEGER ' echo status fg AS INTEGER ' Colors: These could be expanded bg AS INTEGER ' for various windows etc fgh AS INTEGER Hangup AS INTEGER ' type of hangup to perform END TYPE TYPE strb s AS STRING * 80 END TYPE DIM DIR AS struct ' define user type for DIR DIM Parm AS stra ' define user type for PARMS ' ----------------------------------------------------------------------- ' This is a bare bones example of how to manage ComPort I/O. There is ' very little flash and dazzle here - no exploding windows, no sound effects, ' no screen save/restore effects. These would be immensely easy to add to ' the code, but were they to be used here, it would tie the demo to the ' general pupose library that I use. Without screen save/restores and ' windows, we end up clearing the screen a LOT more often. As is, you can ' use whatever library that you currently use. This demo is for educational ' purposes of utilizing the AsyLIB routines. ' ' ----------------------------------------------------------------------- ' ' AsyLIB, GLIB and DLIB are (C) Copyright 1986-1988 InfoSoft ' ' ----------------------------------------------------------------------- ' AsyLIB.BI holds all the declaration statements for AsyLIB REM $INCLUDE: 'ASYLIB.BI' ' These subs are INLINE to the demo code module - they are more ' to do with the demo than AsyLIB DECLARE SUB Help () DECLARE SUB PSetup (parmfil$, Parm AS stra) DECLARE SUB UpdStatLine (fg%, bg%) COMMON SHARED /TComm/ BPS%, Com$, ComFileNum% COMMON stat AS strb CLEAR DEFINT A-Z ' Fallacy #432: QB does NOT default to integer OPTION BASE 1 REM $INCLUDE: 'tcomm.inc' ' Telecommunication definitions ' These should be in a external cfg file too and read into an ' an array in a "real" program implementation DIM proto$(10) ' protocols supported proto$(1) = "Xmodem" proto$(2) = "Xmodem 1k" proto$(3) = "ASCII " proto$(4) = "Ymodem-G" proto$(5) = "Ymodem-B" proto$(6) = "Relaxed Xmodem" proto$(7) = "Jmodem (Shell)" ' these 2 require DSZ.COM and proto$(8) = "Zmodem (Shell)" ' JMODEM.COM available on many BBS proto$(9) = "" proto$(10) = "" REDIM macro$(10) ' Alt 1- 0 = macro keys FOR x = 1 TO 10 macro$(x) = "" NEXT x '******* Global variables and setup ********* ret$ = SPACE$(12) ' set up for ASM call ' some external file names: phonedir$ = "ASYDEMO.DIR" ' Phone book parmfil$ = "ASYDEMO.INI" ' initial parameters CALL SetBline(24) ' Tell TAnsiPrint we are using ' lines 24-25 (for CLS) CALL SetBeep(500, 50) ' Tell TAnsiPrint what kinda ' BEEP we want ' TAnsiPrint and the related functions make managing ' the local screen handling a BREEZE. Everthing that ' we want to go to the local screen just as it is echoed ' to the remote terminal, is done so with TAnsiPrint. This ' includes automatically leaving any size of status line ' alone CALL SetCRIN(1) ' Set CR in to CR not CR/LF slin$ = SPACE$(80) ' status line mask stat.s = slin$ ' status line DirEnt = 0 ' currently no directory selection LogFile = 0 ' log file not active AnsRow = 1 ' Row/col tracked and maintained by AnsCol = 1 ' TAnsiPrint ProtPtr = 2 ' Protocol in effect until dir ' entry loaded proto$(2) = Xmodem1K ScriptF = 0 ' no script file active Prefix$ = "ATDT" ' Dialing prefix$ RemoteCLS$ = CHR$(27) + "[2J" ' ANSI code to Clear remote screen Minute = 60 waitfor = 0 ' no IF WAITFOR pending ' The logfile mode should be read from a CFG file too or at least ' be able to be altered by some setup process. LogMode = 0 ' set log file output to APPEND mode ' Atime sets the length of the alarm. The alarm sounds after a file Xfer ' session, or in response to the ALARM x script file command. Terminal ' mode ATIME could be read from a CFG file, or set via ATIME from a script ' file. ATime = 3 ' default ' -- This gets the default COM parameters errc = FirstF(parmfil$, ret$) ' find file IF errc = 18 THEN ' no parm file, need to setup slin$ = "No Parameters - run setup" stat.s = slin$ CALL UpdStatLine(7, 0) CALL PSetup(parmfil$, Parm) ELSE f = FREEFILE ' get parms OPEN parmfil$ FOR RANDOM AS #f LEN = LEN(Parm) GET #f, 1, Parm CLOSE #f END IF ' assign global variables from the parameter file. ' This allows EZ modification for those who do not like or ' do not understand TYPE structures ComPort = Parm.Cport BPS = Parm.BPS Parity = Parm.Par WordLen = Parm.WLen StopBit = Parm.SBit fg = Parm.fg bg = Parm.bg fgh = Parm.fgh EchoStat = Parm.Echo ' ' By the by, this terminal program works fine as a dumb terminal - IE ' connected to PCPlus or QMODEM directly with no modem! ' ComFileNum = FREEFILE ' get BAS File no. COLOR fg, bg CLS CALL Help ' start up screen / help CALL TAnsiCLS LOCATE AnsRow, AnsCol GOSUB MakeSline ' make / display status line errc = FirstF(phonedir$, ret$) IF errc = 18 THEN ' no phone file, make 0 byte file f = FREEFILE ' to avoid RTE later OPEN phonedir$ FOR RANDOM AS #f LEN = LEN(DIR) CLOSE #f END IF ' set up the com port. ' ' You CAN leave this closed until needed or until the user wants to ' enter terminal mode. In fact, Alt-T is meant for this but, if we use ' this approach we need to add another IF into the terminal mode block ' of code to NOT poll the comm port if Terminal Mode is 0 and therefore ' the comport is closed. CALL CommPortSetUp(ComPort%, Parity%, WordLen%, StopBit%, Errcode%, 10240) ' these file names are those automatically loaded as the script and / or ' macro file if they exist on disk AutoScr$ = "AsyAuto.SCR" AutoMac$ = "AsyAuto.MAC" errc = FirstF(AutoMac$, ret$) IF errc = 0 THEN ' file was found macfil$ = AutoMac$ ' assign to global macro file name GOSUB LoadMacs END IF ' load script file errc = FirstF(AutoScr$, ret$) IF errc = 0 THEN ' file was found ScrFil$ = AutoScr$ ' assign to global script file name errc = ScrCompiler(ScrFil$, Scr$) IF errc = 0 THEN ScriptF = 1 ' indicate Script File active ELSE PRINT " Script File error - press any key" x$ = INPUT$(1) END IF CALL TAnsiCLS LOCATE 1, 1 END IF ' ********* here is the start of the terminal program ******** ' \\\\/\\\\\/\\\\\/\\\\\\/\\\\\\/\\\\\\/\\\\\\/\\\\\\/\\\\\/\\\\\/\\\\\/\\\\\ DO ' endless loop covering Terminal and Script LOOPS DO ' loop thru terminal control ' note that we are using 0 as the num of secs to wait for a char. m = 0 CALL RecChar(m, ch$, Status%) ' get Com, KB char or TimeOut SELECT CASE Status CASE 1 ' KB char hit k$ = INKEY$ ' get key MOpt = KBOption(k$) ' test for [Alt+key] combo IF MOpt THEN ' YES ! GOSUB AltFuncs ' go exec desired function ELSE CALL SendChar(k$) ' plain char - send to other end IF EchoStat THEN ' if local echo is ON, CALL TAnsiPrint(k$, AnsRow, AnsCol) ' do it END IF END IF CASE 2 ' com port char seen CALL TAnsiPrint(ch$, AnsRow, AnsCol) ' print it IF LogFile THEN ' if Log file open, PRINT #lf, ch$; ' store it END IF CASE -1 ' time ran out END SELECT IF KeyReady THEN ' be ready to send k$ = INKEY$ ' ^K, ^S ^X especially CALL SendChar(k$) END IF GOSUB StatLineChk ' see if stat line needs updating LOOP UNTIL ScriptF ' end terminal if AltFuncs toggles ' script file flag ' ///////////////////////////////////////////////////////////////// ' Thats it! The terminal portion is very sleek and compact: get KB ' or comport I/O and handle it. The rest, dialing and so forth is ' all handled via the menu items! ' ///////////////////////////////////////////////////////////////// ' If a script file is activated by the Alt key selection process, ' the AltFuncs CASE statement sets the ScriptF variable and the ' loop falls thru to here. ' ' When the script file is done or terminated, control returns ' to the terminal loop ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ' at this point, the Alt-O function from the kb has read in the desired ' script file and compiled it into a memory image. We are now ready ' the bgin reading it Command Series by Command Series. ' GOSUB MakeSline ' display name of script file executing ScrPtr = 0 ' initialize compiled script pointer DO ScrOpt = ScrReader(Scr$, ScrPtr%, arg$, arg%) IF ScrOpt = 36 THEN ' trap for IF SELECT CASE arg ' act on condition CASE 1 ' Test CD ScrCD = CarrierDetect(ComPort) ' get state IF ScrCD THEN DO ScrOpt = ScrReader(Scr$, ScrPtr%, arg$, arg%) GOSUB ExecScript LOOP UNTIL ScrOpt = 37 OR ScrOpt = -1 OR ScrOpt = 42 ' do until ENDIF, end of Scr, or ELSE ELSE DO ScrOpt = ScrReader(Scr$, ScrPtr%, arg$, arg%) LOOP UNTIL ScrOpt = 37 OR ScrOpt = -1 OR ScrOpt = 42 ' do until ENDIF, EOS or ELSE END IF CASE 2 ' test for 'IF waitfor' IF waitfor THEN DO ScrOpt = ScrReader(Scr$, ScrPtr%, arg$, arg%) GOSUB ExecScript LOOP UNTIL ScrOpt = 37 OR ScrOpt = -1 OR ScrOpt = 42 ' do until ENDIF, EOS or ELSE ELSE DO ScrOpt = ScrReader(Scr$, ScrPtr%, arg$, arg%) LOOP UNTIL ScrOpt = 37 OR ScrOpt = -1 OR ScrOpt = 42 ' do until ENDIF END IF CASE ELSE ' should not get here - compiler catches ' most errors LOCATE 1, 1 PRINT "unknown IF condition" LOCATE AnsRow, AnsCol ScriptF = 0 ScrOpt = -1 END SELECT ELSEIF ScrOpt = -1 THEN ' this just keeps the ExecScript routine from trying to ' exec a -1 ELSE GOSUB ExecScript ' do the desired function END IF GOSUB StatLineChk ' see if status line needs updating DO ' quickly scan CON and COM for ' char I/O i = 0 CALL RecChar(i, ch$, stats) SELECT CASE stats CASE 1 k$ = INKEY$ CALL SendChar(k$) ' plain char - send to other end IF EchoStat THEN CALL TAnsiPrint(k$, AnsRow, AnsCol) END IF CASE 2 CALL TAnsiPrint(ch$, AnsRow, AnsCol) IF LogFile THEN PRINT #lf, ch$; END IF CASE ELSE END SELECT LOOP UNTIL stats = -1 ' do chars until no more LOOP UNTIL ScrOpt = -1 ' do until ScrReader says we are done SOUND 1200, .5 ' BEEP = end of script ScriptF = 0 ' reset script file active flag Scr$ = "" ' clear old scipt GOSUB MakeSline ' clear name from status line LOOP ' end of LOOP housing TERMINAL and Script mode SYSTEM ' cannot get here really '------------------ ' \\\\\\\\\/\\\\\\\\\\\/\\\\\\\\\\\\/\\\\\\\\\\\\\\/\\\\\\\\\\/ ' This routine houses and handles the Alt-Key function request ' AltFuncs: SELECT CASE MOpt CASE 1 ' Alt-A = answer PRINT #ComFileNum, "ATA" ' The actual string to send to answer should be read ' from some PARM file. CASE 2 ' Alt-B = Burp CALL PurgeCommBuffer CASE 3 ' Alt-C - Clear Screen CALL TAnsiCLS ' If your screen color gets changed ' via ANSI, you should change it ' via ANSI like with AnsiCOLOR CASE 4 ' Alt-D = Dial CALL TAnsiCLS ' SvScrn would be great !! DCol = 1: DRow = 5 pd = 1 ' entry pointer GOSUB OpenDirFile ' open ASYDEMO.DIR LOCATE 4, 1 ' print header COLOR fgh, bg PRINT "# BBS Name Phone Last On Ups Dns" LOCATE 20, 18 PRINT "D = Dial, R = Revise, A = Add, N = Next Set, [Esc]" COLOR fg, bg IF QFones THEN ' if there are phone entries, DirLo = 1 IF QFones > 12 THEN DirHi = 12 ELSE ' Hi and Lo items to print DirHi = QFones END IF DO GOSUB PrintDir ' print items Lo to Hi DO x$ = UCASE$(INPUT$(1)) ' get a key (yes it's legal) LOOP UNTIL INSTR("DRAN" + CHR$(27), x$) SELECT CASE x$ CASE "D" ' dial a number LOCATE 21, 20 INPUT "Number to dial: "; DirEnt GOSUB DialDirEnt CASE "R" ' revise entry LOCATE 21, 20 INPUT "Number to Revise: "; DirItem GOSUB ReviseDir x$ = Esc$ ' to get out of LOOP CASE "A" ' add number GOSUB AddDir CASE "N" IF DirHi + 1 < QFones THEN DirLo = DirHi + 1 IF DirHi + 13 <= QFones THEN DirHi = DirHi + 13 ELSE DirHi = QFones END IF ELSE SOUND 185, 4 ' error - no more numbers END IF CASE CHR$(27) ' [ESC] - do nothing CALL TAnsiCLS CASE ELSE END SELECT LOOP UNTIL DirEnt OR x$ = Esc$ CALL TAnsiCLS ELSE ' new fone file with no entries LOCATE 10, 5 GOSUB AddDir END IF CASE 5 ' Alt-E = Toggle Echo (1 or 0) EchoStat = (1 - EchoStat) Parm.Echo = EchoStat GOSUB MakeSline CASE 6 ' Alt-F = Get disk file list ' ALL thus would be better done with windows and DIR from ' GLIB 1.6 ' CALL TAnsiCLS INPUT "Enter filespec: (Enter = none)", mask$ IF LEN(mask$) THEN ' mask entered ??? ret$ = SPACE$(12) errc = FirstF(mask$, ret$) IF errc = 0 THEN FILES mask$ LOCATE 23, 25 COLOR fgh, bg PRINT "press any key to continue" x$ = INPUT$(1) ' BC6 users can use SLEEP CALL TAnsiCLS END IF END IF GOSUB MakeSline CASE 7 ' Alt-G = nothing ' this section is weak due to the way QB4.00b and BC 6 handle ' the comport and is HIGHLY modem dependant CASE 8 ' Hangup SELECT CASE Parm.Hangup CASE 0 PRINT #ComFileNum, "ATH" CASE 1 ' AT s2 MUST equal 43 for this to work PRINT #ComFileNum, "+++" PRINT #ComFileNum, "ATH" ' suggest you use this one, but even then, it does not ' always hangup - see text. CASE 2 CLOSE #ComFileNum CALL CommPortSetUp(ComPort%, Parity%, WordLen%, StopBit%, Errcode%, 10240) CASE ELSE END SELECT ' when hanging up, AsyDEMO updates the last time and date ' you called much like QMODEM does IF DirEnt THEN ' Connected via Alt-D ? pd = DirEnt GOSUB GetpDir DIR.LDate = DATE$ ' store fate and time DIR.LTime = TIME$ GOSUB UpdPhoneDir ' to disk END IF DirEnt = 0 GOSUB MakeSline ' show we are OFFLINE CASE 9 ' Alt I = info and help CALL Help CALL TAnsiCLS LOCATE AnsRow, AnsCol CASE 10 ' Alt-J = undefined CASE 11 ' Alt-K = undefined CASE 12 ' Alt-L = Log file toggle IF LogFile THEN CLOSE #lf LogFile = 0 ELSE IF AnsRow > 13 THEN r = 1 ELSE r = 21 END IF LOCATE r, 1 PRINT SPACE$(79); LOCATE r, 1 SOUND 1200, 1 INPUT "Log File name (Enter = none): ", LogFil$ IF LEN(LogFil$) THEN GOSUB OpenLogFile END IF LOCATE r, 1 PRINT SPACE$(79) LOCATE AnsRow, AnsCol END IF GOSUB MakeSline ' update status line CASE 13 ' Alt-M = Load Macro File ' this will load a macro file from disk, and exchange embed- ' ded '{'s for CRs. You will have to make macro files with ' a text editor as I would not subject an end user to the rigours ' of editing or changing them without the use of a good, solid ' input editor such as FED, found in GLIB. ' display list of available MACRO files CALL TAnsiCLS FILES "*.mac" LOCATE 23, 1 INPUT "Macro File to load (Enter = NONE):", macfil$ ' check for just enter IF macfil$ > "" THEN IF INSTR(1, macfil$, ".") = 0 THEN macfil$ = LTRIM$(RTRIM$(macfil$)) + ".MAC" END IF GOSUB LoadMacs END IF CALL TAnsiCLS LOCATE 1, 1 CASE 14 ' Alt-N = undefined CASE 15 ' Alt-O = Execute script file CALL TAnsiCLS LOCATE 1, 1 ret$ = SPACE$(12) errc = FirstF("*.scr", ret$) IF errc = 0 THEN ' any script files available ?? FILES "*.scr" ' yup - show em PRINT PRINT INPUT "Script File to execute (Enter = None): ", SFil$ IF LEN(SFil$) THEN Scr$ = "" ' initialize compiled pointer ' tack on a .SCR if needed IF INSTR(SFil$, ".") = 0 THEN ScrFil$ = LTRIM$(RTRIM$(SFil$)) + ".SCR" END IF ' this compiles a text script file into a 'compiled' ' string representation of that script. We access the ' disk only ONCE - to get it. errc = ScrCompiler(ScrFil$, Scr$) IF errc = 0 THEN ScriptF = 1 ' indicate Script File active ELSE PRINT " Script File error - press any key" x$ = INPUT$(1) END IF END IF ELSE ' no script files PRINT "No script files to execute" PRINT "press any key" x$ = INPUT$(1) END IF CALL TAnsiCLS LOCATE 1, 1 CASE 16 ' alt p - set line parms CALL TAnsiCLS PRINT TAB(25); "A - 300 N 8 1 D - 300 E 7 1 " PRINT TAB(25); "B - 1200 N 8 1 E - 1200 E 7 1 " PRINT TAB(25); "C - 2400 N 8 1 F - 2400 E 7 1 " ' in a full fledged program I would allow up to 19200 ' bps rates and use initcom to change the rates, but ' this is a demo DO x$ = UCASE$(INPUT$(1)) LOOP UNTIL INSTR("ABCDEF", x$) CALL TAnsiCLS LOCATE 1, 1 StopBit = 1 SELECT CASE x$ CASE "A", "B", "C" Parity = 0 WordLen = 8 CASE ELSE Parity = 2 WordLen = 7 END SELECT SELECT CASE x$ CASE "A", "D" BPS = 300 CASE "B", "E" BPS = 1200 CASE "C", "F" BPS = 2400 END SELECT ' this can be ComPortInit to reset them ' but QB 4.00b tends to dislike that CALL CommPortSetUp(ComPort%, Parity%, WordLen%, StopBit%, Errcode%, 10240) GOSUB MakeSline ' update status line CASE 17 ' Alt - Q Send Password IF DirEnt THEN ' online via a Alt-D function? pw$ = LTRIM$(RTRIM$(DIR.PWord)) IF LEN(pw$) THEN ' make sure there is one CALL SendString(pw$ + CHR$(13), 0) END IF END IF ' there are better ways of doing a redisl, but this is a demo CASE 18 ' Alt-Redial DO UNTIL CarrierDetect(1) OR KeyReady PRINT #ComFileNum, "A/" Status = 0 DO UNTIL Status = -1 ' grab the chars m = 5 CALL RecChar(m, ch$, Status) CALL TAnsiPrint(ch$, Row, Col) LOOP d = 0 DO UNTIL d >= 30 OR KeyReady ' wait for KB input or 30 times CALL MPacing(500) ' wait a half a sec d = d + 1 LOCATE 12, 15 PRINT 30 - d ' times redialed IF CarrierDetect(1) THEN EXIT DO ' do until DCD hi END IF LOOP PRINT #ComFileNum, CHR$(13) LOOP CASE 19 ' ALT-S - SHELL ' while we suggest a 10 k comm port buffer, if you are ' going to actually support an OS shell, you may want ' to increase the buffer, or make positive the other side ' supports XON/XOFF to prevent buffer overflow PRINT #ComFileNum, XOFF$; SLEEP 3 SHELL PRINT #ComFileNum, XON$; XON$ CASE 20 ' Alt-T -- Terminal mode CALL CommPortSetUp(ComPort%, Parity%, WordLen%, StopBit%, Errcode%, 10240) DirEnt = 0 ' no dir entry active CASE 21 ' Alt-U CASE 22 ' Alt-V CASE 23 ' Alt-W CASE 24 ' Alt-X EXIT LOCATE 1, 1 COLOR fgh, bg INPUT "Quit to DOS? ", x$ IF UCASE$(x$) = "Y" THEN IF CarrierDetect(ComPort) THEN INPUT "Drop Carrier? ", y$ IF UCASE$(y$) = "Y" THEN ' DTRHi and DTRLo have little effect in QB 4.00a+ CLOSE #ComFileNum END IF END IF SYSTEM END IF LOCATE AnsRow, AnsCol CASE 25 ' Alt-Y: save current settings Parm.Cport = ComPort ' as defaults Parm.BPS = BPS Parm.Par = Parity Parm.WLen = WordLen Parm.SBit = StopBit Parm.fg = fg Parm.bg = bg Parm.fgh = fgh Parm.Echo = EchoStat f = FREEFILE ' get next BAS FileNo OPEN parmfil$ FOR RANDOM AS #f LEN = LEN(Parm) PUT #f, 1, Parm CLOSE #f CASE 26 ' Alt-Z - run setup CALL PSetup(parmfil$, Parm) fg = Parm.fg bg = Parm.bg fgh = Parm.fgh COLOR fg, bg GOSUB MakeSline CASE 29 ' Pg Up - upload GOSUB protocol ' get desired protocol to use IF ProtPtr THEN GOSUB UpLoad IF DirEnt THEN ' Connected via Alt-D ? pd = DirEnt ' entry pointer GOSUB GetpDir IF XferOk% THEN ' set by protocol sub program DIR.Upls = DIR.Upls + 1 ' increment upload counter GOSUB UpdPhoneDir END IF END IF END IF CASE 37 ' Pg Dn - DownLoad GOSUB protocol IF ProtPtr > 0 THEN GOSUB DownLoad IF DirEnt THEN ' Connected via Alt-D ? pd = DirEnt GOSUB GetpDir IF XferOk% THEN ' Set by protocol sub program DIR.Dnls = DIR.Dnls + 1 ' increment d/l counter GOSUB UpdPhoneDir END IF END IF END IF ' MACRO keys.... CASE 121 ' Alt - 1 (Top Row) IF LEN(LTRIM$(RTRIM$(macro$(1)))) THEN CALL SendString(macro$(1), 0) END IF CASE 122 TO 130 IF LEN(LTRIM$(RTRIM$(macro$(MOpt - 120)))) THEN CALL SendString(macro$(MOpt - 120), 0) END IF CASE ELSE ' rest of cursor keys. END SELECT RETURN ' return to terminal or script loop '----------- ' This is the execution control point for all the script file functions. ' Keep this in mind if you alter the demo. More importantly, the ' following block of code would need to be copied (cut and pasted) or ' something similar implemented in your own terminal package to interpet ' the script file. ' ' We COULD write a CALLable sub that executes all this stuff, but it would ' do nothing but duplicate an enormous amount of code. The fact of the ' matter is that managing a session from the keyboard or from a script file ' is simply a matter of the source of the commands: text from a script file ' or via keystrokes. ' ' This becomes obvious when you look at the code. Lots of the script ' functions to execute simply sets the MOpt variable and executes the ' code as if it WERE entered from the KB; others GOSUB (Never GOTO) to a ' section of code called from the Script control block AND the ' keyboard / menu control block. ' ' We could also skip the Script compile and read steps and interpet the ' lines read from the script file, but using this algorithm, a number of ' benefits befall us as described in ASYScript.DOC that comes with the source ' code license, not the least of which is that the entire Script Compile step ' can be omitted at run time as well as the script compile CODE, by storing ' the compiled script to its own file via Scr2File. ' ExecScript: SELECT CASE ScrOpt CASE 1 ' alarm IF arg THEN FOR x = 1 TO arg SOUND 1200, .5 SOUND 800, 3 NEXT x ELSE GOSUB SoundAlarm END IF CASE 2 ' set baud BPS = VAL(arg$) CASE 3 ScrCD = CarrierDetect(ComPort) CASE 4 ' cls CALL TAnsiCLS CASE 5 ' set color attr = arg b = attr \ 16 f = attr MOD 16 COLOR f, b CASE 6 ' CLOG CLOSE #lf LogFile = 0 CASE 7 ' CRIN IF arg THEN CALL SetCRIN(1) ' set for CR / LF ELSE CALL SetCRIN(0) ' set for CR only END IF CASE 8 ' CROUT CASE 9 WordLen = arg CASE 10 ' dial IF arg THEN GOSUB OpenDirFile ' get number fones in dir CLOSE #p IF arg <= QFones AND arg > 0 THEN ' if in range DirEnt = arg ' set entry to argument GOSUB DialDirEnt ' dial it END IF END IF CASE 11 ' delay IF arg = 0 THEN arg = 5 ' some default I pulled out of the air END IF 'for BC 6: SLEEP arg 'IF arg = 0 THEN ' arg = 5 'END IF 't! = TIMER 'DO UNTIL t! + CSNG(arg) > TIMER 'LOOP CASE 12 ' echo MOpt = 5 GOSUB AltFuncs ' use existing inline code CASE 13 ' ends ScrOpt = -1 ' set DONE flag CASE 14 ' EXEC IF LEN(arg$) THEN ' valid argument???? ScrPtr = 0 Scr$ = "" ret$ = SPACE$(12) errc = FirstF(arg$, ret$) ' does file desired exist? IF errc = 0 THEN errc = ScrCompiler(arg$, Scr$) IF errc THEN ' syntax error in script ScriptF = 0 ScrOpt = -1 CALL TAnsiCLS PRINT "Error loading Script: "; arg$ PRINT " press any key" x$ = INPUT$(1) ELSE ScriptF = 1 ScrFil$ = arg$ GOSUB MakeSline ' show new script name END IF ELSE SOUND 105, 5 END IF ELSE SOUND 105, 5 END IF CASE 15 ' try to hang up MOpt = 8 GOSUB AltFuncs CASE 16 ' LMOD LogMode = arg ' set log file mode parameter CASE 17 ' set log file name IF LEN(arg$) THEN LogFil$ = arg$ END IF CASE 18 ' Locate Cursor Row = arg Col = VAL(arg$) IF Col + Row >= 2 THEN ' check for legal coords LOCATE Row, Col AnsRow = Row ' Update ANSI cursor locations AnsCol = Col END IF CASE 19 ' load macro file IF LEN(arg$) THEN IF INSTR(arg$, ".") THEN macfil$ = arg$ ELSE macfil$ = RTRIM$(arg$) + ".mac" END IF GOSUB LoadMacs END IF CASE 20 ' Open log GOSUB OpenLogFile CASE 21 ' set parity Parity = arg CASE 22 ' set comport ComPort = arg CASE 23 ' print msg CALL TAnsiPrint(arg$, AnsRow, AnsCol) CASE 24 ' Prefix Prefix$ = arg$ CASE 25 ' set protocol ProtPtr = arg CASE 26 ' Quit CLOSE #lf ' close log file if open 'CLOSE ' Un Rem if you want to maybe drop carrier SYSTEM CASE 27 ' RECV IF ProtPtr = 0 THEN ProtPtr = 1 ' default to Xmodem (YUK) END IF IF LEN(arg$) THEN XferFil$ = arg$ GOSUB DownLoad IF DirEnt THEN ' connected to legit entry ? DIR.Dnls = DIR.Dnls + 1 GOSUB UpdPhoneDir END IF END IF CASE 28 ' Remote Shell IF ComPort = 1 THEN CALL SendString(RemoteCLS$ + "Exit to return", 0) CALL TAnsiPrint(RemoteCLS$ + "Exit to return", AnsRow, AnsCol) SHELL "CTTY COM1:" ELSEIF ComPort = 2 THEN CALL SendString(RemoteCLS$ + "Exit to return", 0) CALL TAnsiPrint(RemoteCLS$ + "Exit to return", AnsRow, AnsCol) SHELL "CTTY COM2:" ELSE ' dunno what port is active! CALL SendString("Cannot Shell", 0) END IF CASE 29 ' send a file IF ProtPtr = 0 THEN ProtPtr = 1 ' default to Xmodem (YUK) END IF IF LEN(arg$) THEN XferFil$ = arg$ GOSUB UpLoad IF DirEnt THEN ' connected to legit entry ? DIR.Upls = DIR.Upls + 1 GOSUB UpdPhoneDir END IF END IF CASE 30 ' SET Comport ' hopefully all the vars are set from previous ' scr commands OR the default settings are ok CALL CommPortSetUp(ComPort%, Parity%, WordLen%, StopBit%, Errcode%, 10240) CASE 31 ' SLOG LogFile = 0 CASE 32 ' STOP bits StopBit = arg CASE 33 ' TRANS IF LEN(arg$) THEN CALL SendString(arg$, 0) END IF CASE 34 ' resume log LogFile = 0 CASE 35 ' WaitFor x$ x IF CarrierDetect(ComPort) THEN MOpt = 2 GOSUB AltFuncs ' purge comm port buffer END IF ' The `waitfor' variable will be set to 1 ' if the string is recieved. Therefore if you write an ' IF construct, you can evaluate the result of this with ' an IF WAITFOR type statement waitfor = 0 IF (LEN(arg$)) THEN w$ = "" IF arg = 0 THEN arg = 35 DO CALL RecChar(arg, p$, Status) SELECT CASE Status CASE -1 ' time out waitfor = 0 CASE 1 ' kb kb$ = INKEY$ IF kb$ = CHR$(27) THEN EXIT DO END IF CALL SendChar(kb$) CASE 2 ' com w$ = RIGHT$(w$, 30) + p$ ' chars recieved so far IF INSTR(UCASE$(w$), UCASE$(arg$)) THEN waitfor = 1 END IF CALL TAnsiPrint(p$, AnsRow, AnsCol) END SELECT LOOP UNTIL Status = -1 OR waitfor END IF CASE 36, 37 ' place holders CASE 38 ' set alarm time ATime = arg CASE 39 ' send password MOpt = 17 GOSUB AltFuncs CASE 40 MOpt = 120 + arg ' set macro to send GOSUB AltFuncs ' exec Alt KB function CASE 41 MOpt = 2 GOSUB AltFuncs ' exec Alt KB function CASE 43 ' should only exec if terminal mode = 0 and OFFLINE ?? ' adjust to your tastes MOpt = 20 ' enter terminal mode GOSUB AltFuncs ' exec Alt KB function CASE ELSE PRINT "Unknown script command: "; ScrOpt; arg$; arg END SELECT RETURN '---------- StatLineChk: IF CarrierDetect(ComPort) THEN ' if CD true and IF online = 0 THEN ' stat line thinks we're OFFLINE GOSUB MakeSline ' post BBS on Status line SOUND 1200, .5 END IF ELSE ' If CD False IF online THEN ' Stat line thinks we're ONLINE DirEnt = 0 ' set to no dir entry active GOSUB MakeSline ' Clear BBS on Status line SOUND 1200, .5 END IF END IF RETURN '---------- SoundAlarm: FOR x = 1 TO ATime SOUND 1200, .5 SOUND 800, 3 NEXT x SOUND 40, .2 ' make sure speakder is shut off RETURN '-------------- ' I reckon INPUT$(1) would have worked as well. GetKey: Keyb$ = INKEY$ DO UNTIL Keyb$ <> "" Keyb$ = INKEY$ LOOP RETURN '------------------ ' get protocol to use protocol: CALL TAnsiCLS LOCATE 1, 1 x = 1 ProtOk = 0 DO PRINT x; proto$(x) x = x + 1 LOOP UNTIL LEN(proto$(x)) < 1 IF DirEnt THEN ' connected via dial dir? PRINT "Protocol (Enter = "; proto$(DIR.ProtoPtr); ": "; ELSE PRINT "Protocol: "; END IF DO GOSUB GetKey SELECT CASE ASC(Keyb$) CASE 13 ' enter ProtPtr = DIR.ProtoPtr CASE 27 ProtPtr = -1 CASE ELSE temp = VAL(Keyb$) IF temp >= 1 AND temp < x THEN ' w/in range ProtPtr = temp END IF END SELECT LOOP UNTIL ProtPtr PRINT SOUND 1200, .3 IF ProtPtr > 0 THEN LINE INPUT "File to transfer: "; XferFil$ IF XferFil$ = "" THEN ProtPtr = 0 RETURN END IF END IF CALL TAnsiCLS LOCATE 1, 1 SOUND 1200, .3 RETURN '-------------- '**** Xfer File from there to here **** UpLoad: PRINT "Attemting File Send. Press <ESC> to abort." SELECT CASE ProtPtr CASE 1 CALL SendXmodem(XferFil$, XferOk%, 1) ' Xmodem CRC/Checksum CASE 2 CALL SendXmodem1k(XferFil$, XferOk%) CASE 3 CALL SendASCII(XferFil$, XferOk%) CASE 4 CALL SendYmodemG(XferFil$, XferOk%) CASE 5 CALL SendYmodemB(XferFil$, XferOk%) CASE 6 CALL SendXmodem(XferFil$, XferOk%, 2) ' relaxed Xmodem CASE 7 ' The BAT file controller 'ASY_SJ.BAT' must ' exist and be accurately written for this one id$ = "j" CALL SendShell(XferFil$, id$, ComPort%, XferOk%) CASE 8 ' The BAT file controller 'ASY_SZ.BAT' must ' exist and be accurately written for this one id$ = "z" CALL SendShell(XferFil$, id$, ComPort%, XferOk%) CASE ELSE END SELECT CALL TAnsiCLS LOCATE 1, 1 IF XferOk% THEN PRINT PRINT "SUCCESS!!!!!" ELSE PRINT "Failed." END IF GOSUB SoundAlarm RETURN '----------------- '**** Xfer file from here to there *** DownLoad: PRINT "Attemting File Receive. Press <ESC> to abort." SELECT CASE ProtPtr CASE 1 CALL RecXmodem(XferFil$, XferOk%, 1) CASE 2 CALL RecXmodem1k(XferFil$, XferOk%) CASE 3 CALL RecASCII(XferFil$, 1) x = 1 CASE 4 CALL RecYmodemG(XferFil$, XferOk%) CASE 5 CALL RecYmodemB(XferOk%) PRINT x; "files!!" CASE 6 CALL RecXmodem(XferFil$, XferOk%, 2) ' relaxed Xmodem CASE 7 ' The BAT file controller 'ASY_RJ.BAT' must ' exist and be accurately written for this one id$ = "j" CALL RecShell(XferFil$, id$, ComPort%, XferOk%) GOSUB MakeSline CASE 8 ' The BAT file controller 'ASY_RZ.BAT' must ' exist and be accurately written for this one id$ = "z" CALL RecShell(XferFil$, id$, ComPort%, XferOk%) GOSUB MakeSline CASE ELSE END SELECT CALL TAnsiCLS LOCATE 1, 1 IF XferOk = 1 THEN PRINT "SUCCESS!!!!!" ELSE PRINT "Failed." END IF GOSUB SoundAlarm RETURN '-------------- ' This routine simply makes a string suitable for the UpdStatline Call MakeSline: IF EchoStat THEN slin$ = " Echo: ON " ELSE slin$ = " Echo: OFF " END IF slin$ = slin$ + LTRIM$(RTRIM$(STR$(BPS))) + " bps" carrier = CarrierDetect(ComPort) IF carrier THEN slin$ = slin$ + " ONLINE to" online = 1 ELSE slin$ = slin$ + " OFFLINE " online = 0 END IF IF carrier AND DirEnt THEN slin$ = slin$ + " " + DIR.BBS ELSE slin$ = slin$ + SPACE$(31) ' clear BBS name END IF IF ScriptF THEN slin$ = slin$ + "Scr: " + LEFT$(ScrFil$, INSTR(ScrFil$, ".") - 1) ELSE IF LogFile THEN slin$ = slin$ + "LOG: " + LogFil$ ELSE slin$ = slin$ + SPACE$(13) END IF END IF stat.s = slin$ CALL UpdStatLine(Parm.fg, Parm.bg) LOCATE AnsRow, AnsCol RETURN '------------------- ' Here are a bunch of dialing directory primitives ' Be careful combining them - they are called by the Alt Key handler AND ' the script file handler '-------------------- ' Open the DIR file and get the number of entries in QFones OpenDirFile: p = FREEFILE OPEN phonedir$ FOR RANDOM AS #p LEN = LEN(DIR) QFones = LOF(p) / LEN(DIR) RETURN '------------- ' Macro type subroutine to get Dir ent #pd into DIR TYPE from DIR file GetpDir: GOSUB OpenDirFile GET #p, pd, DIR CLOSE #p RETURN '--------- ' This one just dials the phone. it is a GOSUB so as to be called from ' the Alt key handler AND the Script File handler '--------- DialDirEnt: IF DirEnt > 0 AND DirEnt <= QFones THEN ' an entry was selected pd = DirEnt GOSUB GetpDir CALL CommPortSetUp(ComPort%, Parity%, WordLen%, StopBit%, Errcode%, 10240) CALL TAnsiCLS PRINT #ComFileNum, Prefix$ + LTRIM$(RTRIM$(DIR.Phone)) ProtPtr = DIR.ProtoPtr ' set global variable END IF RETURN '----------- ' revise DIR entry ReviseDir: IF DirItem > 0 AND DirItem <= QFones THEN ' legit item to revise pd = DirItem GOSUB GetpDir CALL TAnsiCLS CALL AddToDir(DIR, proto$()) GOSUB OpenDirFile pd = DirItem GOSUB UpdDir ELSE SOUND 150, .5 END IF RETURN '--------- AddDir: CALL TAnsiCLS GOSUB OpenDirFile CALL AddToDir(DIR, proto$()) DIR.Upls = 0 DIR.Dnls = 0 DIR.LDate = SPACE$(10) ' last date on DIR.LTime = SPACE$(5) ' last time on CALL TAnsiCLS pd = QFones + 1 GOSUB UpdDir RETURN '---------- ' Write current values of DIR to position pd in DIR file UpdPhoneDir: p = FREEFILE OPEN phonedir$ FOR RANDOM AS #p LEN = LEN(DIR) UpdDir: ' this is a no-no PUT #p, pd, DIR CLOSE #p RETURN '------ PrintDir: ' This routine gets entries from the dialing Dir in the range ' DirLo to DirHi and prints them to the screen. This SHOULD ' be a Screen Save type thing, pop up a window and fill it with ' the data, but then, to use this as is, you'd need to use the ' SAME library as I do. Other inmprovements would be to load the ' DIR into a string array and use a QuickPrint to display it. ' But this is after all, a demo. FOR xx = DirLo TO DirHi pd = xx GOSUB GetpDir psetting$ = LTRIM$(RTRIM$(STR$(DIR.BPS))) SELECT CASE DIR.Par CASE 0: psetting$ = psetting$ + "N" CASE 1: psetting$ = psetting$ + "O" CASE 2: psetting$ = psetting$ + "E" CASE ELSE END SELECT psetting$ = psetting$ + LTRIM$(RTRIM$(STR$(DIR.WLen))) psetting$ = psetting$ + LTRIM$(RTRIM$(STR$(DIR.SBit))) LOCATE DRow, DCol PRINT USING "## "; xx; PRINT DIR.BBS; TAB(35); DIR.Phone; TAB(50); DIR.LDate; TAB(62); DIR.Upls; TAB(67); DIR.Dnls DRow = DRow + 1 NEXT xx CLOSE #p RETURN '///\///\///\///\///\///\///\///\///\///\///\///\///\///\///\///\///\///\ ' As a GOSUB, we can use this code to open a log file from the ' key board (Alt-L) _OR_ from a script file ' OpenLogFile: IF LogFil$ <> CHR$(13) THEN lf = FREEFILE IF LogMode THEN OPEN LogFil$ FOR OUTPUT AS #lf ELSE OPEN LogFil$ FOR APPEND AS #lf END IF LogFile = 1 END IF RETURN '---------- ' This opens the file specified in macfil$, reads it in and assigns ' them to the macro keys Alt-1 to Alt-0 LoadMacs: mac = FREEFILE ret$ = SPACE$(12) errc = FirstF(macfil$, ret$) IF errc THEN SOUND 105, 5 CALL TAnsiPrint("Cannot find " + macfil$ + " Press any key", AnsRow, AnsCol) SLEEP 3 RETURN END IF OPEN macfil$ FOR INPUT AS #mac ' open file j = 1 DO UNTIL EOF(mac) OR j = 10 ' only 10 per set, but ' each can be 32k! LINE INPUT #mac, lin$ ' get a line CALL CRXlate(lin$) ' Xlate '{' for CR's macro$(j) = lin$ ' assign it LOOP CLOSE #mac RETURN SUB AddToDir (DIR AS struct, proto$()) DEFINT A-Z ' This too, begs for a QuickPrint and a SaveScreen LOCATE 7, 10 INPUT "BBS Name: ", DIR.BBS LOCATE 8, 10 INPUT "BBS Phone: ", DIR.Phone LOCATE 9, 10 INPUT "BBS baud rate: ", DIR.BPS LOCATE 10, 10 INPUT "BBS Parity (0=N, 1=O, 2=E): ", DIR.Par LOCATE 11, 10 INPUT "BBS Word Length: ", DIR.WLen LOCATE 12, 10 INPUT "BBS Stop Bits: ", DIR.SBit q = 2 DO UNTIL LEN(proto$(q - 1)) < 1 LOCATE q, 50 PRINT q - 1; " "; proto$(q - 1) q = q + 1 LOOP LOCATE 13, 10 INPUT "Protocol Number: ", DIR.ProtoPtr q = 2 DO UNTIL LEN(proto$(q - 1)) < 1 LOCATE q, 50 PRINT SPACE$(LEN(proto$(q - 1)) + 5) q = q + 1 LOOP LOCATE 14, 10 INPUT "Comment: ", DIR.Comment LOCATE 15, 10 INPUT "Password: ", DIR.PWord END SUB SUB Help CALL TAnsiCLS ' good lord, an OSC screen would be TERRIFIC here!!! LOCATE 2 PRINT TAB(25); "AsyDEMO for AsyLIB 1.1 (C) InfoSoft" LOCATE 3 PRINT TAB(30); "DEMO Command Key Summary" LOCATE 5, 3 PRINT "[Alt-A] - Answer the Phone!!! [Alt-N] - " LOCATE 6, 3 PRINT "[Alt-B] - Purge comm buffer [Alt-O] - Execute Script File" LOCATE 7, 3 PRINT "[Alt-C] - Clear terminal screen [Alt-P] - Set Line parameters" LOCATE 8, 3 PRINT "[Alt-D] - Add/Chg Dial Directory entries [Alt-Q] - Quit TO DOS" LOCATE 9, 3 PRINT "[Alt-E] - Toggle Echo mode [Alt-R] - Redial" LOCATE 10, 3 PRINT "[Alt-F] - Disk File List [Alt-S] - SHELL" LOCATE 11, 3 PRINT "[Alt-G] - [Alt-T] - Terminal Mode" ' this is gonna look like the old PC talk thing LOCATE 12, 3 PRINT "[Alt-H] - Hangup [Alt-U] -" LOCATE 13, 3 PRINT "[Alt-I] - Info and help [Alt-V] -" LOCATE 14, 3 PRINT "[Alt-J] - [Alt-W] -" LOCATE 15, 3 PRINT "[Alt-K] - [Alt-X] - Exit to DOS" LOCATE 16, 3 PRINT "[Alt-L] - Toggle LogFile [Alt-Y] - Save settings to disk" LOCATE 17, 3 PRINT "[Alt-M] - Load Macro File [Alt-Z] - Set up" LOCATE 18, 3 PRINT "[Alt-1] to [Alt-0] (TOPROW!) - Execute macro" LOCATE 19, 3 PRINT "[PgDn] - DownLoad [PgUp] - UpLoad" LOCATE 21, 25 PRINT "[ Press any key to continue]" x$ = INPUT$(1) END SUB SUB PSetup (parmfil$, Parm AS stra) DEFINT A-Z ' ' This is very I/O intensive and does very little validity checking. ' The only way I would do this is to use a decent library using ' either its text input editor or okay$ input routine. ' ret$ = SPACE$(12) errc = FirstF(parmfil$, ret$) IF errc <> 18 THEN f = FREEFILE ' get next BAS FileNo OPEN parmfil$ FOR RANDOM AS #f LEN = LEN(Parm) GET #f, 1, Parm CLOSE #f END IF CLS CALL UpdStatLine(7, 0) LOCATE 8, 20 INPUT " Default COMM Port:"; Parm.Cport LOCATE 9, 20 INPUT " Default Baud rate:"; Parm.BPS done = 0 DO UNTIL done done = 1 LOCATE 10, 20 INPUT " Parity (N, 0, E):"; x$ SELECT CASE UCASE$(x$) CASE "N": Parm.Par = 0 CASE "O": Parm.Par = 1 CASE "E": Parm.Par = 2 CASE ELSE SOUND 185, 3 done = 0 END SELECT LOOP LOCATE 11, 20 INPUT " Data Bits (7 or 8):"; Parm.WLen ' this should keep asking for the word length until what you ' enter is 7 or 8. GLIB users could use GetChar or PGetChar: ' okay$="78": a$=" " ' CALL GetChar(okay$, a$) ' -- or -- ' CALL PGetChar("Data bits or Word length:", 11, 7, okay$, a$) ' LOCATE 12, 20 INPUT " Stop Bits (0 or 1):"; Parm.SBit LOCATE 13, 20 INPUT " Echo: 0=Off, 1=On:"; Parm.Echo LOCATE 14, 20 INPUT " Foreground color(0-31):"; Parm.fg LOCATE 15, 20 INPUT " Background color(0-7):"; Parm.bg LOCATE 16, 20 INPUT "HiIntensity color(0-31):"; Parm.fgh LOCATE 17, 20 PRINT "Hangup mode:" PRINT TAB(22); " 0 = use ATH" PRINT TAB(22); " 1 = use +++ATH" PRINT TAB(22); " 2 = Drop DTR" LOCATE 21, 20 INPUT " Mode to use (0-2):"; Parm.Hangup f = FREEFILE ' get next BAS FileNo OPEN parmfil$ FOR RANDOM AS #f LEN = LEN(Parm) PUT #f, 1, Parm CLOSE #f CLS END SUB SUB UpdStatLine (fg%, bg%) SHARED stat AS strb LOCATE 25, 1 COLOR bg, fg PRINT stat.s; ' adjust this to print 2,3 or ' more elements of an array ' for 2 or 3 line status lines ' use a QUICK PRINT too! COLOR fg, bg END SUB