(*****************************************************************************) (*> <*) (*> MINITERM.PAS - Telegard Communications Program <*) (*> Copyright 1988,89,90 by Eric Oman, Martin Pollard, <*) (*> and Todd Bolitho - All Rights Reserved. <*) (*> <*) (*****************************************************************************) {$A+,B+,E+,F+,I+,L+,N-,O-,R-,S+,V-} {$M $4000,0,0} program miniterm; uses crt, dos, myio, file0, file1, common, tmpcom; procedure clearscr; begin tc(7); clrscr; end; procedure term; const delay_time = 25000; type pnrec=record name:string[40]; number:string[14]; hs:byte; end; minirec=record dpath:string[40]; end; var c,bl,bl2:char; done,bac,eco,LFEEDS,macedited:boolean; ns:array[1..50] of pnrec; fil:file of pnrec; cfgfil:file of minirec; mini:minirec; lnd,i:integer; rl:real; r:registers; sx,sy:integer; chkcom:boolean; pagnum,pages,hientrynum:integer; hs,maxs:byte; wind:windowrec; mtcfilter:cfilterrec; mtcfiltertype,mtcfilternum,mtcfiltercount:integer; mtcfilteron:boolean; tchkpart:integer; timerison:boolean; timerstart,timerstop,tooktime:real; procedure tell(s:astr); var st:integer; begin cursoron(FALSE); st:=40-(length(s) div 2)-3; setwindow(wind,st,10,st+length(s)+5,14,9,1,1); gotoxy(3,2); tc(15); writeln(s); tc(7); end; procedure sendmpcode(s:string); var outc:string; i:integer; begin outc:=^A^B^A+mln(s,6)+#253+#254+#255; for i:=1 to length(outc) do sendcom1(outc[i]); end; (* procedure timertog; var s:string; c:char; begin timerison:=not timerison; if (timerison) then begin timerstart:=timer; tell('Timer started'); delay(100); removewindow(wind); end else begin timerstop:=timer; tooktime:=timerstop-timerstart; str(tooktime:2:4,s); tell('Time: '+s); c:=readkey; removewindow(wind); cursoron(TRUE); end; end;*) procedure tab(x:integer); begin while wherexmtcfilter[ord(ch)])) then textattr:=mtcfilter[ord(ch)]; outkey(ch); end; (* procedure docchk(c:char); begin if ((c=#224) and (tchkpart=0)) then begin tchkpart:=1; exit; end; if ((c=#225) and (tchkpart=1)) then begin tchkpart:=2; exit; end; if ((c=#226) and (tchkpart=2)) then begin tchkpart:=0; timertog; end; tchkpart:=0; end;*) procedure handlemtcode; var f:file of char; rl:real; s:string; i,nzz:integer; c,cft:char; function getnextc:char; begin while (com_rx_empty) do ; getnextc:=ccinkey1; end; begin rl:=timer; repeat until (not com_rx_empty); c:=ccinkey1; if (ord(c) and $70=$70) then textattr:=ord(c) and $8F else case c of 'C':textattr:=ord(getnextc); 'c':case getnextc of '=':begin for i:=0 to 255 do mtcfilter[i]:=ord(getnextc); if (getnextc=';') then begin mtcfilteron:=TRUE; mtcfiltertype:=0; end else mtcfilteron:=FALSE; end; '*':; '-':mtcfilteron:=FALSE; end; 'f':begin rl:=timer; s:=''; repeat s:=s+getnextc until ((s[ord(s[0])]=';') or (timer-rl>5.0)); if (copy(s,length(s),1)=';') then begin s:=allcaps(copy(s,1,length(s)-1)); setwindow(wind,3,10,77,17,9,1,1); clearscr; tc(15); writeln; writeln(' BBS wants to send you "'+s+'"'); writeln(' Enter filename to accept download as.'); write(' '); for i:=1 to 70 do write('_'); writeln; s:=allcaps(mini.dpath)+s; tc(9); write(''); tc(11); infield1(wherex,wherey,s,70); removewindow(wind); if (s='') then exit; assign(f,s); {$I-} reset(f); {$I+} if (ioresult=0) then begin close(f); tellak('"'+s+'": File already exists.'); com_tx(#21); { NAK } end else begin rewrite(f); nzz:=0; com_tx(#6); { ACK } repeat c:=getnextc; write(f,c); write(c); if (c=^Z) then inc(nzz) else nzz:=0; until (nzz>=3); close(f); end; end else com_tx(#21); { NAK } end; end; dosansion:=FALSE; end; (* ferr.log; c*R1,2,3,4; c*C1,2,3,4; c= (0..255 color codes) ; c-; { turn off color filter } *) procedure in1(c:char); begin (* if ((c>=#224) and (c<=#226)) then docchk(c);*) if (c=^T) then begin handlemtcode; exit; end; if ((c=^M) and (lfeeds)) then writeln; if (c=^L) then clrscr else if (c=^H) then begin om(c); if (bac) then begin om(' '); om(^H); end; end else if (c<>#0) then om(c); end; procedure gkey(var c:char); begin repeat until keypressed; c:=readkey; end; function lyn:boolean; var c:char; begin repeat gkey(c); until upcase(c) in ['Y','N',#13]; if (upcase(c)='Y') then begin lyn:=TRUE; writeln('Yes'); end else begin lyn:=FALSE; writeln('No'); end; end; procedure ss(hs:byte); var s:astr; begin writeln; writeln; tc(1); write('--- '); tc(3); case hs of 0:s:='300'; 1:s:='1200'; 2:s:='2400'; 3:s:='4800'; 4:s:='9600'; end; write(s+' BAUD '); tc(1); writeln('---'); writeln; tc(7); end; procedure cs(hs:byte); var s:astr; begin case hs of 0:s:='300'; 1:s:='1200'; 2:s:='2400'; 3:s:='4800'; 4:s:='9600'; end; com_set_speed(value(s)); spd:=s; end; procedure hang; var rl:real; try:integer; procedure dely(r:real); var r1:real; begin r1:=timer; while abs(timer-r1)'0') and (abs(timer-rl)<2.0) do; dely(0.8); pr1('ATH0'+#13); try:=try+1; dely(0.3); end; end; procedure beep; var a,b,c,i,j:integer; begin for j:=1 to 3 do begin for i:=1 to 3 do begin a:=i*500; b:=a; while b>a-300 do begin sound(b); b:=b-50; c:=a+1000; while c>a+700 do begin sound(c); delay(2); c:=c-50; end; end; end; delay(50); nosound; end; end; function filepath(fn:astr):astr; var a,b:integer; s:astr; begin b:=0; {rcg11242000 dosism.} {for a:=1 to length(fn) do if fn[a]='\' then b:=a;} for a:=1 to length(fn) do if fn[a]='/' then b:=a; if b<>0 then filepath:=copy(fn,1,b) else begin getdir(0,s); {rcg11242000 dosism.} {filepath:=s+'\';} filepath:=s+'/'; end; end; procedure ul; var dok,abort,kabort:boolean; i,pa:astr; f:text; c:char; j,sxx,syy,termprotocol:integer; st:real; suboard:astr; pnumber:integer; begin savepos(sxx,syy); setwindow(wind,3,5,38,21,9,1,1); tc(15); textbackground(0); clearscr; window(4,5,37,20); textbackground(1); gotoxy(2,1); write('Upload'); window(4,6,37,20); textbackground(0); gotoxy(1,15); termprotocol:=1; dok:=FALSE; removewindow(wind); if termprotocol<>-1 then begin i:=''; setwindow(wind,3,10,77,16,9,1,1); clearscr; tc(15); writeln; if (termprotocol=1) then writeln(' Enter file to ASCII send, to abort.') else writeln(' Enter file(s) to upload, to abort.'); write(' '); for j:=1 to 70 do write('_'); writeln; tc(9); write(''); tc(11); i:=''; infield1(wherex,wherey,i,70); removewindow(wind); if (i<>'') then begin assign(f,i); {$I-} reset(f); {$I+} if (ioresult=0) then begin close(f); outcom:=FALSE; incom:=FALSE; fileboard:=1; loaduboard(1); suboard:=memuboard.dlpath; memuboard.dlpath:=filepath(i); if (termprotocol=1) then begin dok:=TRUE; gotoxy(sxx,syy); reset(f); while (not eof(f)) and (dok) do begin if keypressed then if readkey=#27 then dok:=FALSE; read(f,c); sendcom1(c); if (eco) then om(c); if (not com_rx_empty) then begin c:=cinkey1; in1(c); end; end; close(f); sxx:=wherex; syy:=wherey; end; memuboard.dlpath:=suboard; term_ready(TRUE); cs(hs); end else begin tellak('File not found'); cursoron(TRUE); end; end; end; hangup:=FALSE; incom:=FALSE; outcom:=FALSE; gotoxy(sxx,syy); tc(7); end; procedure dl; var dok,kabort,addbatch:boolean; i:astr; f:file; j,sxx,syy,sxx2,syy2:integer; st:real; suboard:astr; pnumber:integer; wind1:windowrec; begin (* savepos(sxx,syy); setwindow(wind,3,9,77,16,9,1,1); clearscr; tc(9); writeln(mrn(cstr(freek(exdrv(mini.dpath)))+'k of free space in '+mini.dpath,72)); savepos(sxx2,syy2); setwindow(wind1,3,5,38,21,9,1,1); tc(15); textbackground(0); clearscr; window(4,5,37,20); textbackground(1); gotoxy(2,1); write('Download'); window(4,6,37,20); textbackground(0); gotoxy(1,15); termprotocol:=gtp(TRUE,FALSE); pnumber:=protocols[termprotocol]^.ptype; dok:=FALSE; removewindow(wind1); window(4,10,76,15); gotoxy(sxx2,syy2); textbackground(1); if termprotocol=-1 then removewindow(wind) else begin if pnumber=4 then begin dok:=TRUE; i:=mini.dpath; end else begin tc(15); writeln; writeln(' Enter file to download to, to abort.'); write(' '); for j:=1 to 70 do write('_'); writeln; ft:=255; tc(9); write(''); tc(11); infield(i,70); removewindow(wind); if i<>'' then begin assign(f,i); {$I-} reset(f); {$I+} if ioresult<>0 then begin {$I-} rewrite(f); {$I+} if ioresult=0 then begin close(f); erase(f); dok:=TRUE; end else begin dok:=FALSE; removewindow(wind); tellak('Illegal filename'); cursoron(TRUE); end; end else begin close(f); setwindow(wind,27,10,52,16,9,1,1); clearscr; tc(15); writeln; writeln(#7+' File already exists.'); writeln; write(' Overwrite? '); tc(3); dok:=lyn; removewindow(wind); end; end; end; if dok then begin outcom:=FALSE; incom:=FALSE; fileboard:=1; suboard:=uboards[1]^.dlpath; uboards[1]^.dlpath:=mini.dpath; receive1(i,FALSE,dok,kabort,addbatch); uboards[1]^.dlpath:=suboard; term_ready(TRUE); cs(hs); end; removewindow(wind); end; hangup:=FALSE; incom:=FALSE; outcom:=FALSE; gotoxy(sxx,syy); tc(7); *) end; procedure pc(s:astr); var i:integer; begin s:=s+#13; for i:=1 to length(s) do sendcom1(s[i]); end; procedure initmodem; begin com_flush_rx; delay(500); pc('AT'); delay(500); pc('ATQ0V1E1S2=43M0S11=50'); delay(200); com_flush_rx; end; procedure savedialer; var i:integer; begin reset(fil); rewrite(fil); for i:=1 to hientrynum do begin seek(fil,i-1); write(fil,ns[i]); end; close(fil); end; procedure redial; const loco=9; hico=15; ttspend=30; var c,kk:char; done,done1,gotonext,checking:boolean; try:integer; rl,rl1,rl2:real; int:integer; i,i1,rs,rc:astr; sxx,syy:integer; cl:integer; slpos:integer; procedure getresultcode(rs:astr); var i,j:integer; begin with systat do for i:=1 to 2 do for j:=0 to 4 do if (modemr.resultcode[i][j]<>0) and (rs=cstr(modemr.resultcode[i][j])) then begin case j of 0:spd:='300'; 1:spd:='1200'; 2:spd:='2400'; 3:spd:='4800'; 4:spd:='9600'; end; chkcom:=TRUE; exit; end; end; begin cursoron(FALSE); savepos(sxx,syy); setwindow(wind,1,1,51,9,9,1,1); clearscr; try:=0; hs:=ns[lnd].hs; cs(hs); rl:=timer; chkcom:=FALSE; done:=FALSE; checking:=FALSE; rc:=''; spd:='N.A.'; pc('ATX4M0Q0V0E0S7=16'); tc(loco); writeln('Redial started at 00:00:00'); writeln('Attempt #0 00:00:00'); write('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'); writeln('Dialing'); writeln(' at'); write('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'); write('Last result: None.'); gotoxy(31,1); tc(14); write('Hit '); textbackground(4); write(''); textbackground(1); write(' to abort'); tc(hico); gotoxy(19,1); write(ctim(timer)); gotoxy(9,4); write(ns[lnd].name); gotoxy(9,5); write(ns[lnd].number); tc(loco); write(' ... '); slpos:=wherex; gotoxy(10,2); tc(hico); write('0'); delay(500); com_flush_rx; repeat pc('ATDT'+ns[lnd].number); inc(try); tc(hico); gotoxy(10,2); write(try); gotoxy(19,2); write(ctim(timer)); com_flush_rx; kk:=#0; rl:=timer; done1:=FALSE; while ((not done) and (not done1) and (com_rx_empty)) do begin gotonext:=FALSE; rl1:=timer; if rl10) then if rs=cstr(modemr.busy) then begin rc:='BUSY'; cl:=14; end; if (modemr.nocarrier<>0) or (done1) then if (rs=cstr(modemr.nocarrier)) or (done1) then begin rc:='NO CARRIER'; cl:=12; end; if (modemr.nodialtone<>0) then if rs=cstr(modemr.nodialtone) then begin rc:='NO DIALTONE'; cl:=28; end; getresultcode(rs); end; if (chkcom) then begin rc:='CONNECT '+spd+'!'; cl:=30; end; end; if kk=#27 then begin rc:='User abort!'; cl:=15; end; if kk=#32 then begin rc:='Skipped to next.'; cl:=15; end; if rc<>'' then begin gotoxy(14,7); tc(15); clreol; gotoxy(14,7); tc(cl); write(rc); tc(7); end; if chkcom then done:=TRUE; if rc='NO DIALTONE' then done:=TRUE; if gotonext then done:=FALSE; until done; if (rc='NO DIALTONE') and (kk<>#27) then begin clearscr; tc(28); writeln(' NO DIALTONE '); writeln; tc(12); writeln('Dial tone is NOT detected.'); gotoxy(1,7); textbackground(4); tc(14); clreol; gotoxy(2,7); write('Hit any key to return to terminal mode'); textbackground(1); repeat sound(800); delay(100); nosound; delay(50); until keypressed; c:=readkey; end; if (not chkcom) or (spd='N.A.') then initmodem else begin removewindow(wind); tell('Connection Established at '+spd+' baud'); repeat sound(1200); delay(30); sound(1300); delay(60); sound(1500); delay(90); sound(2000); delay(120); nosound; delay(100); until (try=30) or (keypressed); if keypressed then c:=readkey; end; removewindow(wind); gotoxy(sxx,syy); textbackground(0); tc(7); cursoron(TRUE); end; procedure dial; var sxx,syy,i,j,k:integer; changed,done:boolean; qd,c:char; s:astr; savp:pnrec; procedure updatelist; var i:integer; begin tc(15); gotoxy(67,1); write('Page '+cstr(pagnum)+' of '+cstr(pages)); writeln; for i:=(pagnum-1)*10+1 to (pagnum-1)*10+10 do begin gotoxy(1,(i-(pagnum-1)*10)+2); if i<=hientrynum then begin tc(9); write(i); tc(15); tab(4); write(ns[i].name); tc(14); tab(46); write(ns[i].number); tc(11); tab(61); case ns[i].hs of 0:writeln(' 300'); 1:writeln('1200'); 2:writeln('2400'); 3:writeln('4800'); 4:writeln('9600'); end; end else clreol; end; end; procedure showlist; var i:integer; begin clearscr; tc(15); writeln('N NAME NUMBER SPD'); tc(9); writeln('ÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄ'); end; procedure resetpages; begin pages:=((hientrynum-1) div 10)+1; end; procedure dcmds(i:integer); var x,y:integer; begin cursoron(TRUE); savepos(x,y); gotoxy(1,15); clreol; gotoxy(1,16); clreol; if i<>0 then begin gotoxy(1,15); tc(15); write('Dial: '); tc(9); writeln('(PgUp PgDn) [A]dd [C]lear [D]ial [I]nsert [K]ill [M]odify'); tab(19); write('[Q]uit'); cursoron(FALSE); end; gotoxy(x,y); end; begin changed:=FALSE; cursoron(FALSE); savepos(sxx,syy); setwindow(wind,1,5,79,22,9,1,1); showlist; done:=FALSE; repeat updatelist; dcmds(1); repeat c:=upcase(readkey); until pos(c,#27+'Q0123456789ACDIKM'+#0)>0; if c in ['0'..'9'] then begin qd:=c; c:='D'; end else qd:=#0; gotoxy(1,15); case c of #0:if keypressed then case readkey of #73:if pagnum>1 then dec(pagnum); #81:if pagnum50 then begin inc(hientrynum); with ns[hientrynum] do begin name:=''; number:=''; hs:=maxs; end; resetpages; changed:=TRUE; end else write(^G); end; 'C':begin dcmds(0); tc(15); write('Clear which? :'); infield(s,2); i:=value(s); if (i>=1) and (i<=hientrynum) then begin with ns[i] do begin name:=''; number:=''; hs:=maxs; end; resetpages; changed:=TRUE; end; end; 'D':begin dcmds(0); tc(15); write('Dial which? :'); if qd<>#0 then s:=qd else s:=''; infield1(wherex,wherey,s,2); i:=value(s); if (i>=1) and (i<=hientrynum) then begin removewindow(wind); lnd:=i; if changed then savedialer; changed:=FALSE; redial; done:=TRUE; end; end; 'I':begin if hientrynum<>50 then begin dcmds(0); tc(15); write('Insert before which? :'); infield(s,2); i:=value(s); if (i>=1) and (i<=hientrynum+1) then begin if i<>hientrynum+1 then for j:=hientrynum+1 downto i+1 do ns[j]:=ns[j-1]; with ns[i] do begin name:=''; number:=''; hs:=maxs; end; inc(hientrynum); resetpages; changed:=TRUE; end; end else write(^G); end; 'K':begin if hientrynum>1 then begin dcmds(0); tc(15); write('Kill which? :'); infield(s,2); i:=value(s); if (i>=1) and (i<=hientrynum) then begin if i<>hientrynum then for j:=i to hientrynum-1 do ns[j]:=ns[j+1]; dec(hientrynum); resetpages; changed:=TRUE; end; end; end; 'M':begin dcmds(0); tc(15); write('Modify which? :'); infield(s,2); i:=value(s); if (i>=1) and (i<=hientrynum) then begin clearscr; writeln('Entry number: ',i); writeln('Enter alone at any prompt for no change.'); writeln; tc(14); write('Name: '); tc(15); writeln(ns[i].name); tc(14); write('Number: '); tc(15); writeln(ns[i].number); tc(14); write('Speed: '); tc(15); case ns[i].hs of 0:write('300'); 1:write('1200'); 2:write('2400'); 3:write('4800'); 4:write('9600'); end; writeln(' baud'); s:=ns[i].name; infield1(9,4,s,40); if s<>ns[i].name then begin ns[i].name:=s; changed:=TRUE; end; s:=ns[i].number; infield1(9,5,s,14); if s<>ns[i].number then begin ns[i].number:=s; changed:=TRUE; end; writeln; tc(11); write('[3]00 '); if maxs>0 then write('[1]200 '); if maxs>1 then write('[2]400 '); if maxs>2 then write('[4]800 '); if maxs>3 then write('[9]600 '); writeln; writeln; tc(9); write('New speed? '); c:=readkey; tc(11); if c in ['3','1','2','4','9'] then begin writeln(c); changed:=TRUE; end else writeln('No change.'); with ns[i] do case c of '3':hs:=0; '1':hs:=1; '2':hs:=2; '4':hs:=3; '5':hs:=4; end; c:=' '; showlist; end; end; end; cursoron(FALSE); until (done); if changed then savedialer; textbackground(0); tc(15); gotoxy(sxx,syy); cursoron(TRUE); end; procedure pp(s:astr); var i:integer; c:char; begin for i:=1 to length(s) do begin c:=s[i]; if c='{' then c:=#13; if eco then om(c); sendcom1(c); end; end; procedure wcenter(s:string; color,row:integer); var col:integer; begin col:=((80-length(s)) div 2); gotoxy(col,row); tc(color); write(s); end; procedure logo; begin clearscr; tc(1); box(1,11,1,68,5); window(1,1,80,25); wcenter('Telegard MiniTerm - Version '+ver,15,2); wcenter('Copyright 1988,89,90 by Eric Oman, Martin Pollard,',11,3); wcenter('and Todd Bolitho - All Rights Reserved.',11,4); wcenter('To get help, press "Alt-Z".',14,6); tc(7); end; procedure help; var x,y:integer; c:char; begin cursoron(FALSE); savepos(x,y); setwindow(wind,43,1,80,18,4,0,1); tc(15); writeln('Alt-B = backspacing toggle'); writeln('Alt-C = clear screen'); writeln('Alt-D = dialer'); writeln('Alt-E = echo toggle'); writeln('Alt-H = hang up'); writeln('Alt-I = initialize modem'); writeln('Alt-J = jump to DOS'); writeln('Alt-L = line feeds toggle'); writeln('Alt-M = turbo screen mode toggle'); writeln('Alt-R = redial last number'); writeln('Alt-S = speed toggle'); writeln('Alt-X = exit'); writeln('PgUp = send file from dloads'); writeln('PgDn = receive file into dloads'); writeln; tc(9); write('Press any key....'); repeat until keypressed; c:=readkey; removewindow(wind); gotoxy(x,y); cursoron(TRUE); end; procedure init; var x,y:integer; procedure loading(s:astr); begin tc(9); write('þ '); tc(11); writeln('Loading "'+s+'"'); end; begin trm:=TRUE; tchkpart:=0; timerison:=FALSE; lfeeds:=FALSE; nopfile:=FALSE; eco:=FALSE; wantout:=TRUE; checkit:=FALSE; wantfilename:=FALSE; enddayf:=FALSE; mailread:=FALSE; smread:=FALSE; beepend:=FALSE; useron:=FALSE; chatcall:=FALSE; outcom:=FALSE; incom:=FALSE; hangup:=FALSE; hungup:=FALSE; lnd:=0; ll:=''; chatr:=''; usernum:=1; curco:=7; sdc; delay(50); com_flush_rx; term_ready(TRUE); { iport;} com_flush_rx; infield_out_fgrd:=15; infield_out_bkgd:=1; infield_inp_fgrd:=0; infield_inp_bkgd:=7; infield_arrow_exit:=FALSE; getdir(0,start_dir); window(1,1,80,25); logo; savepos(x,y); setwindow(wind,1,1,50,8,9,1,1); with modemr do begin if (waitbaud=300) then maxs:=0; if (waitbaud=1200) then maxs:=1; if (waitbaud=2400) then maxs:=2; if (waitbaud=4800) then maxs:=3; if (waitbaud=9600) then maxs:=4; end; {rcg11242000 dosisms.} { loading(start_dir+'\miniterm.fon'); if not exist(start_dir+'\miniterm.fon') then begin assign(fil,start_dir+'\miniterm.fon'); } loading(start_dir+'/miniterm.fon'); if not exist(start_dir+'/miniterm.fon') then begin assign(fil,start_dir+'/miniterm.fon'); rewrite(fil); with ns[1] do begin name:='Grosse Pointe Centrale'; number:='1-313-885-1779'; hs:=2; end; write(fil,ns[1]); close(fil); end; {rcg11242000 DOSism.} {assign(fil,start_dir+'\miniterm.fon');} assign(fil,start_dir+'/miniterm.fon'); reset(fil); hientrynum:=0; repeat hientrynum:=hientrynum+1; seek(fil,hientrynum-1); read(fil,ns[hientrynum]); until hientrynum=filesize(fil); close(fil); pages:=((hientrynum-1) div 10)+1; pagnum:=1; {rcg11242000 DOSisms.} { loading(start_dir+'\miniterm.cfg'); if not exist(start_dir+'\miniterm.cfg') then begin assign(cfgfil,start_dir+'\miniterm.cfg'); } loading(start_dir+'/miniterm.cfg'); if not exist(start_dir+'/miniterm.cfg') then begin assign(cfgfil,start_dir+'/miniterm.cfg'); rewrite(cfgfil); with mini do begin {rcg11242000 dosism.} {dpath:=start_dir+'\';} dpath:=start_dir+'/'; end; write(cfgfil,mini); close(cfgfil); end; {rcg11242000 DOSism.} {assign(cfgfil,start_dir+'\miniterm.cfg');} assign(cfgfil,start_dir+'/miniterm.cfg'); reset(cfgfil); read(cfgfil,mini); close(cfgfil); removewindow(wind); gotoxy(x,y); cursoron(TRUE); hs:=maxs; cs(hs); ss(hs); bac:=FALSE; done:=FALSE; initmodem; end; var mtcolors,showascii:boolean; rcode:integer; begin mtcolors:=FALSE; showascii:=FALSE; init; rl:=timer; repeat if (not com_rx_empty) then begin c:=cinkey1; in1(c); if (showascii) then write('(',ord(c),')'); end else begin if (timer10.0*60.0) then done:=TRUE; end; if (keypressed) then begin c:=readkey; if (c=#0) then if (keypressed) then begin c:=readkey; case ord(c) of 18:begin eco:=not eco; if eco then tellak('Echo ON') else tellak('Echo OFF'); cursoron(TRUE); end; 19:if lnd in [1..50] then redial; 23:begin savepos(sx,sy); tell('Initializing modem....'); initmodem; removewindow(wind); gotoxy(sx,sy); cursoron(TRUE); tc(7); end; 27:pp(#27); 31:begin hs:=hs+1; if hs>maxs then hs:=0; cs(hs); ss(hs); end; 32:begin dial; tc(7); end; 35:begin savepos(sx,sy); tell('Hanging up....'); hang; removewindow(wind); gotoxy(sx,sy); cursoron(TRUE); tc(7); end; 36:begin i:=textattr; savepos(sx,sy); setwindow(wind,1,1,80,25,7,0,0); writeln('Type "EXIT" to return to MiniTerm.'); shelldos(FALSE,'',rcode); cs(hs); removewindow(wind); gotoxy(sx,sy); textattr:=i; if (doserror<>0) then tellak('Could not execute COMMAND.COM'); end; 38:begin lfeeds:=not lfeeds; if lfeeds then tellak('Line feeds ON') else tellak('Line feeds OFF'); cursoron(TRUE); end; 44:help; 45:begin cursoron(FALSE); savepos(sx,sy); returna:=FALSE; done:=TRUE; com_flush_rx; removewindow(wind); gotoxy(sx,sy); cursoron(TRUE); clearscr; chdir(start_dir); end; 46:clearscr; 48:begin bac:=not bac; if bac then tellak('Backspace: Destructive') else tellak('Backspace: Non-Destructive'); cursoron(TRUE); end; 50:begin mtcolors:=not mtcolors; if (mtcolors) then sendmpcode('rmt1') else sendmpcode('rmt0'); if mtcolors then tellak('Turbo screen mode ON') else tellak('Turbo screen mode OFF'); end; 130:showascii:=not showascii; 73:ul; 75:if (okansi) then pp(#27+'[D'); 77:if (okansi) then pp(#27+'[C'); 72:if (okansi) then pp(#27+'[A'); 80:if (okansi) then pp(#27+'[B'); 81:dl; end; end else om(c) else begin sendcom1(c); if (eco) then om(c); end; rl:=timer; end; until (done); trm:=FALSE; end; function loadfiles:boolean; var errs:boolean; systatf:file of systatrec; modemrf:file of modemrec; begin errs:=FALSE; assign(systatf,'status.dat'); {$I-} reset(systatf); {$I+} errs:=(ioresult<>0); if (not errs) then begin {$I-} read(systatf,systat); {$I+} errs:=(ioresult<>0); end; close(systatf); if (not errs) then begin assign(modemrf,systat.gfilepath+'modem.dat'); {$I-} reset(modemrf); {$I+} errs:=(ioresult<>0); if (not errs) then read(modemrf,modemr); close(modemrf); end; if (not errs) then begin assign(uf,systat.gfilepath+'user.lst'); {$I-} reset(uf); {$I+} errs:=(ioresult<>0); if (not errs) then begin seek(uf,1); read(uf,thisuser); with thisuser do begin linelen:=80; pagelen:=25; ac:=[ansi,color]; ac:=ac-[onekey,pause,novice,avatar]; end; end; close(uf); end; loadfiles:=errs; end; begin if (loadfiles) then halt(1); iport; term; remove_port; halt(0); end.