home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / bbp_pom.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  66.6 KB  |  1,981 lines
  1. unit bbp_pom;
  2.  
  3. interface
  4.  
  5. procedure phreakoutmenu;
  6. procedure phreakout;
  7. procedure scanmode;
  8. procedure redboxit;
  9. procedure cardtalker;
  10. procedure freqtester;
  11. procedure cardchecker;
  12.  
  13. implementation
  14.  
  15. uses crt, extras, grwins, bbp_vars, editrout, video, types, ferror,
  16.      bbp_proc, sbvoice, grmenus, bitmani, pdial, mouseio, optimer,
  17.      bbunit, vgagraph, sos;
  18.  
  19. procedure editnumber(nr:word);
  20. var s:string;
  21.     save:byte;
  22.     x:word;
  23. begin
  24.   textattr:=colors.normal;
  25.   writeln;
  26.   write('Editing Phone Number');
  27.   window(1,1,80,25);
  28.   setcursorsize($6,$7);
  29.   save:=textattr; textattr:=colors.high;
  30.   openbox(3,15,16,65,22,true,true,false);
  31.   gotoxy(34,16);
  32.   textattr:=colors.win_title;
  33.   write(' Edit Number ');
  34.   textattr:=colors.reverse;
  35.   center(21,'    Use [0..9], *, #, ABCDEFGH for the number    ');
  36.   textattr:=colors.win_text;
  37.   gotoxy(19,18); write('Name: ',numbers[nr]^.name);
  38.   gotoxy(17,19); write('Number: ',numbers[nr]^.number);
  39.   s:=numbers[nr]^.name; gotoxy(25,18); edit(s,35); numbers[nr]^.name:=s;
  40.   s:=numbers[nr]^.number; gotoxy(25,19); edituc(s,20); numbers[nr]^.number:=s;
  41.   closebox(3);
  42.   textattr:=save;
  43.   setcursorsize($32,$32);
  44.   sosopen;
  45.   sosfopen(phonebookname);
  46.   sosseek(sizeof(numberrec)*(nr-1));
  47.   numbers[nr]^.name:=scrambled(numbers[nr]^.name);
  48.   numbers[nr]^.number:=scrambled(numbers[nr]^.number);
  49.   soswrite(numbers[nr],sizeof(numberrec));
  50.   numbers[nr]^.name:=scrambled(numbers[nr]^.name);
  51.   numbers[nr]^.number:=scrambled(numbers[nr]^.number);
  52.   sosclose;
  53.   window(18,14,79,14);
  54. end;
  55.  
  56. procedure refreshnums;
  57. var x:word;
  58. begin
  59.   window(1,16,80,24);
  60.   for x:=1 to pagesize do begin
  61.     if firstonpage-1+x=current then
  62.       if numflags[firstonpage-1+x] then textattr:=colors.special_reverse_high
  63.         else textattr:=colors.special_reverse
  64.       else if numflags[firstonpage-1+x] then textattr:=colors.worldtime_ahead
  65.     else textattr:=colors.special;
  66.     gotoxy(1,x);
  67.     if x+firstonpage-1<=maxnums then begin
  68.       write(x+firstonpage-1:3,'  ');
  69.       write(numbers[x+firstonpage-1]^.name);
  70.       for y:=1 to 38-length(numbers[x+firstonpage-1]^.name) do write(' ');
  71.       write(numbers[x+firstonpage-1]^.number);
  72.       for y:=1 to 24-length(numbers[x+firstonpage-1]^.number) do write(' ');
  73.       write(countryfor(numbers[x+firstonpage-1]^.number));
  74.     end;
  75.     clreol;
  76.   end;
  77.   textattr:=colors.normal;
  78.   window(18,14,79,14);
  79. end;
  80.  
  81. procedure scanmode;
  82. var x                 :word;
  83.     bufstring,bla,tmp :string;
  84.     ch                :char;
  85. begin
  86.   move(mem[vadr:0],save,4000);
  87.   textattr:=colors.normal;
  88.   clrscr;
  89.   openbox(1,1,1,80,3,false,true,false);
  90.   openbox(2,1,23,80,25,false,true,false);
  91.   textattr:=colors.win_text_high;
  92.   center(2,'SCAN MODE');
  93.   textattr:=colors.special_high; gotoxy(5,5); write('Scan String (see docs for details)');
  94.   textattr:=colors.dark; for x:=1 to 50-wherex do write('.');
  95.   textattr:=colors.high2; write(curscan.scanstring);
  96.   textattr:=colors.special_high; gotoxy(5,6); write('Quick Macro');
  97.   textattr:=colors.dark; for x:=1 to 50-wherex do write('.');
  98.   textattr:=colors.high2; write(curscan.quickmacro);
  99.   textattr:=colors.special_high; gotoxy(5,7); write('How many digits to scan');
  100.   textattr:=colors.dark; for x:=1 to 50-wherex do write('.');
  101.   textattr:=colors.high2; write(curscan.digits);
  102.   textattr:=colors.special_high; gotoxy(5,8); write('Current scan is at');
  103.   textattr:=colors.dark; for x:=1 to 50-wherex do write('.');
  104.   textattr:=colors.high2; write(curscan.progress);
  105.   textattr:=colors.special_high; gotoxy(5,9); write('Auto-Increase');
  106.   textattr:=colors.dark; for x:=1 to 50-wherex do write('.');
  107.   textattr:=colors.high2; write(onoff[curscan.ai]);
  108.   textattr:=colors.special_high; gotoxy(5,10); write('Macro Redial Count (0=off)');
  109.   textattr:=colors.dark; for x:=1 to 50-wherex do write('.');
  110.   textattr:=colors.high2; write(curscan.redialcount);
  111.   textattr:=colors.special_high; gotoxy(5,11); write('Macro Redial Count-Up');
  112.   textattr:=colors.dark; for x:=1 to 50-wherex do write('.');
  113.   textattr:=colors.high2; write(curscan.redialprog);
  114.   textattr:=colors.special_high; gotoxy(5,12); write('Strip leading zeroes');
  115.   textattr:=colors.dark; for x:=1 to 50-wherex do write('.');
  116.   textattr:=colors.high2; if curscan.stripzeroes then write('Yes') else write('No');
  117.   textbackground(colors.win_background);
  118.   gotoxy(3,24);
  119.   cwrite('|Y'^X^Y' |WInc/Dec  |YCR |WDial  |Y+ |WSend Break  |YF1 |WEdit settings  |YM |WDial Macro   |YESC |WQuit');
  120.   repeat
  121.     repeat vmemwrite(74,2,time(false),colors.win_text) until keypressed;
  122.     ch:=upcase(readkey);
  123.     if ch=#0 then ch:=readkey;
  124.     case ch of
  125.       CurUp :begin textattr:=colors.high2; inc(curscan.progress); gotoxy(50,8); write(curscan.progress,'  '); end;
  126.       CurDn :begin textattr:=colors.high2; dec(curscan.progress); gotoxy(50,8); write(curscan.progress,'  '); end;
  127.       '+'   :playtrunk(curtrunk,false);
  128.       'M'   :begin
  129.                gotoxy(3,16);
  130.                clreol;
  131.                gotoxy(3,15);
  132.                dial(curscan.quickmacro,false,false,true);
  133.              end;
  134.       Return:begin
  135.                textattr:=colors.normal;
  136.                gotoxy(3,16);
  137.                clreol;
  138.                gotoxy(3,15);
  139.                str(curscan.progress,bufstring);
  140.                if not(curscan.stripzeroes) then
  141.                  for x:=1 to curscan.digits-length(bufstring) do bufstring:='0'+bufstring;
  142.                tmp:='';
  143.                for x:=1 to length(curscan.scanstring) do begin
  144.                  if curscan.scanstring[x]<>'X' then
  145.                  tmp:=tmp+curscan.scanstring[x] else
  146.                  tmp:=tmp+bufstring;
  147.                end;
  148.                dial(tmp,false,false,true);
  149.                clreol;
  150.                if curscan.ai then begin
  151.                  textattr:=colors.high2;
  152.                  inc(curscan.progress);
  153.                  gotoxy(50,8);
  154.                  write(curscan.progress,'  ');
  155.                end;
  156.                if curscan.redialcount<>0 then begin
  157.                  textattr:=colors.high2;
  158.                  inc(curscan.redialprog);
  159.                  gotoxy(50,11);
  160.                  write(curscan.redialprog,'  ');
  161.                  if curscan.redialprog=curscan.redialcount then begin
  162.                    curscan.redialprog:=0;
  163.                    gotoxy(3,16);
  164.                    clreol;
  165.                    gotoxy(3,15);
  166.                    dial(curscan.quickmacro,false,false,true);
  167.                    textattr:=colors.high2;
  168.                    gotoxy(50,11);
  169.                    write(curscan.redialprog,'  ');
  170.                  end;
  171.                end;
  172.              end;
  173.       F1    :begin
  174.                setcursorsize($6,$7);
  175.                gotoxy(50,5); edit(curscan.scanstring,27);
  176.                gotoxy(50,6); edit(curscan.quickmacro,27);
  177.                gotoxy(50,7); editli(curscan.digits);
  178.                gotoxy(50,8); editli(curscan.progress);
  179.                if curscan.ai then bla:='Y' else bla:='N';
  180.                gotoxy(50,9);
  181.                write('Auto-Increase? ');
  182.                setcursorsize($32,$32);
  183.                curscan.ai:=yesnotoggle(curscan.ai,'Yes','No');
  184.                setcursorsize($6,$7);
  185.                gotoxy(50,9); write(onoff[curscan.ai]); clreol;
  186.                gotoxy(50,10); editli(curscan.redialcount);
  187.                gotoxy(50,11); editli(curscan.redialprog);
  188.                setcursorsize($32,$32);
  189.                gotoxy(50,12); write('Strip''em? '); curscan.stripzeroes:=yesnotoggle(curscan.stripzeroes,'Yes','No');
  190.                gotoxy(50,12); if curscan.stripzeroes then write('Yes') else write('No');
  191.                clreol;
  192.              end;
  193.     end;
  194.   until ch=#27;
  195.   sosopen;
  196.   sosfopen(scanfilename);
  197.   soswrite(@curscan,sizeof(curscan));
  198.   sosclose;
  199.   closebox(2);
  200.   closebox(1);
  201.   move(save,mem[vadr:0],4000);
  202. end;
  203.  
  204. procedure phreakout;
  205. var ch       :char;
  206.     save,bks :array[1..4000] of byte;
  207.     mx,my    :integer;
  208.     spkey    :boolean;
  209.     testbyte :byte;
  210.     v        :voicefile;
  211.     s        :string;
  212.     i,x      :word;
  213.  
  214. procedure selecttrunk;
  215. var res       :byte;
  216.     worktrunk :trunktype;
  217.     x         :word;
  218. begin
  219.   setcursorsize($32,$32);
  220.   textattr:=colors.normal;
  221.   writeln;
  222.   write('Selecting new trunk');
  223.   window(1,1,80,25);
  224.   res:=config.curtrunk;
  225.   sosopen;
  226.   sosfopen(trunkfilename);
  227.   for x:=1 to maxtrunks do begin
  228.     sosread(@worktrunk,sizeof(worktrunk));
  229.     menuitem[x]:=worktrunk.name;
  230.     menuinfo[x]:=worktrunk.description;
  231.   end;
  232.   sosclose;
  233.   menucount:=maxtrunks;
  234.   res:=menu(1,4,res,true,true,true,false,true);
  235.   if res<>0 then begin
  236.     config.curtrunk:=res;
  237.     sosopen;
  238.     sosfopen(trunkfilename);
  239.     sosseek(sizeof(trunktype)*(res-1));
  240.     sosread(@curtrunk,sizeof(curtrunk));
  241.     sosclose;
  242.     for x:=18 to 28 do vmemwrite(x,2,' ',colors.titlebox);
  243.     vmemwrite(18,2,curtrunk.name,colors.titlebox);
  244.     window(18,14,79,14);
  245.     write('Trunk: ',curtrunk.name,', ',curtrunk.description);
  246.     clreol;
  247.   end else begin
  248.     window(18,14,79,14);
  249.   end;
  250.   setcursorsize($6,$7);
  251. end;
  252.  
  253. procedure selectset;
  254. var res     :byte;
  255.     workset :dialsettype;
  256.     x       :word;
  257. begin
  258.   setcursorsize($32,$32);
  259.   textattr:=colors.normal;
  260.   writeln;
  261.   write('Selecting new Dial Set');
  262.   window(1,1,80,25);
  263.   res:=config.curdset;
  264.   sosopen;
  265.   sosfopen(dsfilename);
  266.   for x:=1 to maxdialsets do begin
  267.     sosread(@workset,sizeof(workset));
  268.     menuitem[x]:=workset.standard;
  269.     menuinfo[x]:=workset.description;
  270.   end;
  271.   sosclose;
  272.   menucount:=maxdialsets;
  273.   res:=menu(1,4,res,true,true,true,false,true);
  274.   if res<>0 then begin
  275.     config.curdset:=res;
  276.     sosopen;
  277.     sosfopen(dsfilename);
  278.     sosseek(sizeof(dialsettype)*(res-1));
  279.     sosread(@curds,sizeof(curds));
  280.     sosclose;
  281.     for x:=72 to 79 do vmemwrite(x,8,' ',colors.high);
  282.     vmemwrite(72,8,curds.standard,colors.high);
  283.     window(18,14,79,14);
  284.     clrscr;
  285.     write('Dialset: ',curds.standard,', ',curds.description);
  286.     clreol;
  287.   end else begin
  288.     window(18,14,79,14);
  289.     clrscr;
  290.   end;
  291.   setcursorsize($6,$7);
  292. end;
  293.  
  294. procedure selectdtl;
  295. var res     :byte;
  296.     workrec :dtltype;
  297.     x       :word;
  298. begin
  299.   setcursorsize($32,$32);
  300.   textattr:=colors.normal;
  301.   writeln;
  302.   write('Selecting new dial translation');
  303.   window(1,1,80,25);
  304.   res:=config.activedtl;
  305.   sosopen;
  306.   sosfopen(dtlfilename);
  307.   for x:=1 to maxdtlsets do begin
  308.     sosread(@workrec,sizeof(workrec));
  309.     menuitem[x]:=workrec.name;
  310.     menuinfo[x]:=workrec.note;
  311.   end;
  312.   sosclose;
  313.   menucount:=maxdtlsets;
  314.   res:=menu(1,4,res,true,true,true,false,true);
  315.   if res<>0 then begin
  316.     config.activedtl:=res;
  317.     sosopen;
  318.     sosfopen(dtlfilename);
  319.     sosseek(sizeof(dtltype)*(res-1));
  320.     sosread(@curdtl,sizeof(curdtl));
  321.     sosclose;
  322.     for x:=44 to 61 do vmemwrite(x,8,' ',colors.high);
  323.     vmemwrite(44,8,curdtl.name,colors.high);
  324.     window(18,14,79,14);
  325.     clrscr;
  326.     write('Dial Translation: ',curdtl.name,', ',curdtl.note);
  327.     clreol;
  328.   end else begin
  329.     window(18,14,79,14);
  330.     clrscr;
  331.   end;
  332.   setcursorsize($6,$7);
  333. end;
  334.  
  335. procedure insertentry;
  336. var x:word;
  337. begin
  338.   window(18,14,79,13);
  339.   clrscr;
  340.   if numbers[maxnums]^.name<>'-Unused-' then begin
  341.     textattr:=colors.error_reverse;
  342.     write(' * WARNING * ');
  343.     textattr:=colors.error;
  344.     write(' Entry #',maxnums,' will be pushed out, do it?');
  345.     if not(yesnotoggle(false,'YES','NO')) then begin
  346.       textattr:=colors.normal;
  347.       writeln;
  348.       write('Operation cancelled.');
  349.       exit;
  350.     end;
  351.   end;
  352.   textattr:=colors.normal;
  353.   write('Inserting blank entry at position #',current,'...');
  354.   for x:=maxnums downto current+1 do numbers[x]^:=numbers[x-1]^;
  355.   numbers[current]^.number:='';
  356.   numbers[current]^.name:='-Unused-';
  357.   refreshnums;
  358.   textattr:=colors.normal;
  359.   write('Rewriting phone book after entry insert...');
  360.   sosopen;
  361.   sosfopen(phonebookname);
  362.   for x:=1 to maxnums do begin
  363.     numbers[x]^.name:=scrambled(numbers[x]^.name);
  364.     numbers[x]^.number:=scrambled(numbers[x]^.number);
  365.     soswrite(numbers[x],sizeof(numberrec));
  366.     numbers[x]^.name:=scrambled(numbers[x]^.name);
  367.     numbers[x]^.number:=scrambled(numbers[x]^.number);
  368.   end;
  369.   sosclose;
  370.   write('OK');
  371. end;
  372.  
  373. procedure deleteentry;
  374. var x :word;
  375. begin
  376.   window(18,14,79,14);
  377.   clrscr;
  378.   if numbers[current]^.name<>'-Unused-' then begin
  379.     textattr:=colors.error_reverse;
  380.     write(' * WARNING * ');
  381.     textattr:=colors.error;
  382.     write(' Delete phonebook entry #',current,' ? ');
  383.     if not(yesnotoggle(false,'YES','NO')) then begin
  384.       textattr:=colors.normal;
  385.       writeln;
  386.       write('Operation cancelled.');
  387.       exit;
  388.     end;
  389.   end;
  390.   textattr:=colors.normal;
  391.   write('Deleting number #',current,'...');
  392.   for x:=current to maxnums-1 do numbers[x]^:=numbers[x+1]^;
  393.   numbers[maxnums]^.number:='';
  394.   numbers[maxnums]^.name:='-Unused-';
  395.   refreshnums;
  396.   textattr:=colors.normal;
  397.   write('Rewriting new phone book after deletion...');
  398.   sosopen;
  399.   sosfopen(phonebookname);
  400.   for x:=1 to maxnums do begin
  401.     numbers[x]^.name:=scrambled(numbers[x]^.name);
  402.     numbers[x]^.number:=scrambled(numbers[x]^.number);
  403.     soswrite(numbers[x],sizeof(numberrec));
  404.     numbers[x]^.name:=scrambled(numbers[x]^.name);
  405.     numbers[x]^.number:=scrambled(numbers[x]^.number);
  406.   end;
  407.   sosclose;
  408.   write('OK');
  409. end;
  410.  
  411. procedure pleasewait;
  412. begin
  413.   textattr:=colors.normal;
  414.   writeln;
  415.   if not(config.gotblaster) then begin
  416.     write('SoundBlaster not installed correctly!');
  417.     exit;
  418.   end;
  419.   write('Saying "Please wait"');
  420.   switchon(true);
  421.   fixdriver('CT-VOICE.DRV',0);
  422.   if initblaster(config.sbint,config.sbaddr)<>0 then
  423.     fatalerror('SB Init Failure!');
  424.   loadvoice('wait.voc',v,0);
  425.   playvoice(v);
  426.   repeat until status=0;
  427.   killvoice(v);
  428.   switchoff(true);
  429.   removedriver;
  430. end;
  431.  
  432. procedure recordquick;
  433. begin
  434.   textattr:=colors.normal;
  435.   writeln;
  436.   if not(config.gotblaster) then begin
  437.     write('SoundBlaster not installed correctly!');
  438.     exit;
  439.   end;
  440.   write('Recording Quick Sample, press any key to end...');
  441.   fixdriver('CT-VOICE.DRV',0);
  442.   if initblaster(config.sbint,config.sbaddr)<>0 then
  443.     fatalerror('SB Init Failure!');
  444.   recordvoice('QUICK.VOC',12000,0);
  445.   removedriver;
  446. end;
  447.  
  448. procedure replayquick;
  449. begin
  450.   textattr:=colors.normal;
  451.   writeln;
  452.   if not(config.gotblaster) then begin
  453.     write('SoundBlaster not installed correctly!');
  454.     exit;
  455.   end;
  456.   write('Replaying Quick Sample...');
  457.   switchon(true);
  458.   fixdriver('CT-VOICE.DRV',0);
  459.   if initblaster(config.sbint,config.sbaddr)<>0 then
  460.     fatalerror('SB Init Failure!');
  461.   loadvoice('quick.voc',v,0);
  462.   playvoice(v);
  463.   repeat until status=0;
  464.   killvoice(v);
  465.   switchoff(true);
  466.   removedriver;
  467. end;
  468.  
  469. procedure searchphonebook;
  470. var s :string;
  471.     i :word;
  472. begin
  473.   textattr:=colors.normal;
  474.   writeln;
  475.   write('Search for:');
  476.   s:='';
  477.   edituc(s,40);
  478.   if s='' then begin
  479.     writeln;
  480.     write('Operation cancelled.');
  481.     exit;
  482.   end;
  483.   i:=1;
  484.   writeln;
  485.   textattr:=colors.normal;
  486.   write('Searching for ');
  487.   textattr:=colors.high;
  488.   write(s);
  489.   textattr:=colors.normal;
  490.   write('...');
  491.   while not ((pos(s,uppercase(numbers[i]^.name))<>0) or (i>(maxnums-1))) do inc(i);
  492.   if (i=maxnums) and (pos(s,uppercase(numbers[i]^.name))=0) then begin
  493.     textattr:=colors.error;
  494.     writeln;
  495.     write('Nothing found.');
  496.   end else begin
  497.     writeln;
  498.     write('Match found at position #',i);
  499.     firstonpage:=i;
  500.     current:=i;
  501.     refreshnums;
  502.   end;
  503. end;
  504.  
  505. procedure vtdialchar(character:char);
  506. var ch:char;
  507. begin
  508.   ch:=character;
  509.   if ch='ü' then ch:='Ü';
  510.   if ch='ä' then ch:='Ä';
  511.   if ch='ö' then ch:='Ö';
  512.   if not(ch in [#13,^H,'#']) then write(ch);
  513.   case ch of
  514.     'A' :dial('10',true,false,false);
  515.     'B' :dial('11',true,false,false);
  516.     'C' :dial('12',true,false,false);
  517.     'D' :dial('13',true,false,false);
  518.     'E' :dial('14',true,false,false);
  519.     'F' :dial('15',true,false,false);
  520.     'G' :dial('16',true,false,false);
  521.     'H' :dial('17',true,false,false);
  522.     'I' :dial('18',true,false,false);
  523.     'J' :dial('19',true,false,false);
  524.     'K' :dial('20',true,false,false);
  525.     'L' :dial('21',true,false,false);
  526.     'M' :dial('22',true,false,false);
  527.     'N' :dial('23',true,false,false);
  528.     'O' :dial('24',true,false,false);
  529.     'P' :dial('25',true,false,false);
  530.     'Q' :dial('26',true,false,false);
  531.     'R' :dial('27',true,false,false);
  532.     'S' :dial('28',true,false,false);
  533.     'T' :dial('29',true,false,false);
  534.     'U' :dial('30',true,false,false);
  535.     'V' :dial('31',true,false,false);
  536.     'W' :dial('39',true,false,false);
  537.     'X' :dial('32',true,false,false);
  538.     'Y' :dial('33',true,false,false);
  539.     'Z' :dial('34',true,false,false);
  540.     #13 :begin dial('*0',true,false,false); writeln; end;
  541.     '0' :dial('0*',true,false,false);
  542.     '1' :dial('1*',true,false,false);
  543.     '2' :dial('2*',true,false,false);
  544.     '3' :dial('3*',true,false,false);
  545.     '4' :dial('4*',true,false,false);
  546.     '5' :dial('5*',true,false,false);
  547.     '6' :dial('6*',true,false,false);
  548.     '7' :dial('7*',true,false,false);
  549.     '8' :dial('8*',true,false,false);
  550.     '9' :dial('9*',true,false,false);
  551.     ' ' :dial('55',true,false,false);
  552.     'Ü' :dial('35',true,false,false);
  553.     'Ä' :dial('36',true,false,false);
  554.     'Ö' :dial('37',true,false,false);
  555.     '.' :dial('40',true,false,false);
  556.     ',' :dial('41',true,false,false);
  557.     '?' :dial('42',true,false,false);
  558.     '!' :dial('43',true,false,false);
  559.     '"' :dial('44',true,false,false);
  560.     '-' :dial('45',true,false,false);
  561.     '&' :dial('46',true,false,false);
  562.     '+' :dial('47',true,false,false);
  563.     ':' :dial('47',true,false,false);
  564.     ^H  :begin write(^H' '^H); dial('**',true,false,false); end;
  565.     '#' :begin
  566.            textattr:=colors.special_high;
  567.            writeln(' <OK>');
  568.            dial('#',true,false,false);
  569.            textattr:=colors.special;
  570.          end;
  571.   else begin
  572.     textattr:=colors.dark;
  573.     write(^H,ch);
  574.     textattr:=colors.special;
  575.   end; end;
  576. end;
  577.  
  578. procedure vtdialfile;
  579. var fn :string;
  580.     t  :text;
  581.     x  :byte;
  582. begin
  583.   textattr:=colors.special_high;
  584.   write('Filename to Xmit: ');
  585.   fn:='MYAD.TXT';
  586.   edituc(fn,40);
  587.   writeln;
  588.   writeln;
  589.   setcursorsize($1,$7);
  590.   if not exist(fn) then begin
  591.     writeln('[File not found]');
  592.     textattr:=colors.special;
  593.     exit;
  594.   end;
  595.   writeln('[Xmitting '+fn+']');
  596.   textattr:=colors.special;
  597.   assign(t,fn);
  598.   reset(t);
  599.   while not eof(t) do begin
  600.     readln(t,s);
  601.     for x:=1 to length(s) do vtdialchar(upcase(s[x]));
  602.     vtdialchar(#13);
  603.   end;
  604.   close(t);
  605.   textattr:=colors.special_high;
  606.   writeln('[Xmit done]');
  607.   textattr:=colors.special;
  608. end;
  609.  
  610. procedure vtdialer;
  611. var ch:char;
  612. begin
  613.   writeln;
  614.   write('SAT.1 Videotext Ad Dialer - A Dittmeyer Invention!');
  615.   window(1,16,80,24);
  616.   textattr:=colors.special_high;
  617.   clrscr;
  618.   writeln;
  619.   writeln('SAT.1-TEXT KLEINANZEIGEN-DIALER - ESC to quit');
  620.   writeln;
  621.   writeln('Use F1 to Xmit a text file.');
  622.   writeln;
  623.   setcursorsize($1,$7);
  624.   textattr:=colors.special;
  625.   repeat
  626.     ch:=upcase(readkey);
  627.     if ch=#0 then begin
  628.       ch:=readkey;
  629.       textattr:=colors.special_high;
  630.       case ch of
  631.         'H' :begin write(#24); dial('*2',true,false,false); end;
  632.         'P' :begin write(#25); dial('*8',true,false,false); end;
  633.         'K' :begin write(#27); dial('*4',true,false,false); end;
  634.         'M' :begin write(#26); dial('*6',true,false,false); end;
  635.         F1  :vtdialfile;
  636.       else begin
  637.         textattr:=colors.dark;
  638.         write('^',ch);
  639.       end; end;
  640.       textattr:=colors.special;
  641.     end else vtdialchar(ch);
  642.   until ch=#27;
  643.   setcursorsize($32,$32);
  644.   clrscr;
  645.   refreshnums;
  646. end;
  647.  
  648. begin
  649.   if check_userid then recheck_id;
  650.   move(mem[vadr:0],save,4000);
  651.   setcursorsize($32,$32);
  652.   textattr:=colors.normal;
  653.   clrscr;
  654.   openbox(1,1,1,80,3,false,false,false);   ignbox(1);
  655.   openbox(1,1,4,19,12,false,false,false);  ignbox(1);
  656.   openbox(1,19,4,80,12,false,false,false); ignbox(1);
  657.   openbox(1,1,12,80,15,false,false,false); ignbox(1);
  658.   for x:=0 to 239 do mem[vadr:x*2+1]:=colors.titlebox_border;
  659.   for x:=2 to 78 do mem[vadr:160+(x*2+1)]:=colors.titlebox_high;
  660.   textattr:=colors.titlebox_title;
  661.   center(1,' BlueBEEP! Action Mode ');
  662.   vmemwrite(19,4,'┬',colors.win_border_1);
  663.   vmemwrite(16,12,'──',colors.win_border_2);
  664.   vmemwrite(18,12,'─┴─',colors.win_border_1);
  665.   vmemwrite(21,12,'──',colors.win_border_2);
  666.   vmemwrite(1,12,'├',colors.win_border_1);
  667.   vmemwrite(80,12,'┤',colors.win_border_1);
  668.   vmemwrite(3,13,'Device Status:',colors.high);
  669.   vmemwrite(3,14,'Dialer Status:',colors.high);
  670.   vmemwrite(26,10,'Trunk',colors.normal);
  671.   vmemwrite(26,11,'Dial Set',colors.normal);
  672.   vmemwrite(21,8,'M/S:',colors.normal);
  673.   vmemwrite(38,8,'Xlat:',colors.normal);
  674.   vmemwrite(62,8,'Dial Set:',colors.normal);
  675.   vmemwrite(44,10,'Dial Speed',colors.normal);
  676.   vmemwrite(44,11,'Send Number',colors.normal);
  677.   vmemwrite(64,10,'Blast Exit',colors.normal);
  678.   vmemwrite(64,11,'Edit Number',colors.normal);
  679.   vmemwrite(2,5,'     │     │',colors.dark);
  680.   vmemwrite(2,6,'─────┼─────┼─────',colors.dark);
  681.   vmemwrite(2,7,'     │     │',colors.dark);
  682.   vmemwrite(2,8,'─────┼─────┼─────',colors.dark);
  683.   vmemwrite(2,9,'     │     │',colors.dark);
  684.   vmemwrite(2,10,'─────┼─────┼─────',colors.dark);
  685.   vmemwrite(2,11,'     │     │',colors.dark);
  686.   vmemwrite(4,5,'1',colors.keypad_released);
  687.   vmemwrite(10,5,'2',colors.keypad_released);
  688.   vmemwrite(16,5,'3',colors.keypad_released);
  689.   vmemwrite(4,7,'4',colors.keypad_released);
  690.   vmemwrite(10,7,'5',colors.keypad_released);
  691.   vmemwrite(16,7,'6',colors.keypad_released);
  692.   vmemwrite(4,9,'7',colors.keypad_released);
  693.   vmemwrite(10,9,'8',colors.keypad_released);
  694.   vmemwrite(16,9,'9',colors.keypad_released);
  695.   vmemwrite(4,11,'*',colors.keypad_released);
  696.   vmemwrite(10,11,'0',colors.keypad_released);
  697.   vmemwrite(16,11,'#',colors.keypad_released);
  698.   vmemwrite(20,5,'     │     │    │      │     │     │     │    │     │      ',colors.dark);
  699.   vmemwrite(20,6,'──A──┴──B──┴─C──┴──D───┴──E──┴──F──┴──G──┴─H──┘     └── + ──',colors.dark);
  700.   vmemwrite(21,5,'KP1',colors.keypad_released);
  701.   vmemwrite(27,5,'KP2',colors.keypad_released);
  702.   vmemwrite(33,5,'ST',colors.keypad_released);
  703.   vmemwrite(38,5,'KP2E',colors.keypad_released);
  704.   vmemwrite(45,5,'STE',colors.keypad_released);
  705.   vmemwrite(51,5,'C11',colors.keypad_released);
  706.   vmemwrite(57,5,'C12',colors.keypad_released);
  707.   vmemwrite(63,5,'EO',colors.keypad_released);
  708.   vmemwrite(74,5,'BREAK',colors.keypad_released);
  709.   vmemwrite(21,10,'[',colors.dark);
  710.   vmemwrite(22,10,'F1',colors.super_high);
  711.   vmemwrite(24,10,']',colors.dark);
  712.   vmemwrite(21,11,'[',colors.dark);
  713.   vmemwrite(22,11,'F2',colors.super_high);
  714.   vmemwrite(24,11,']',colors.dark);
  715.   vmemwrite(39,10,'[',colors.dark);
  716.   vmemwrite(40,10,#27+#26,colors.super_high);
  717.   vmemwrite(42,10,']',colors.dark);
  718.   vmemwrite(39,11,'[',colors.dark);
  719.   vmemwrite(40,11,'CR',colors.super_high);
  720.   vmemwrite(42,11,']',colors.dark);
  721.   vmemwrite(58,10,'[',colors.dark);
  722.   vmemwrite(59,10,'F10',colors.super_high);
  723.   vmemwrite(62,10,']',colors.dark);
  724.   vmemwrite(58,11,'[',colors.dark);
  725.   vmemwrite(59,11,'SPC',colors.super_high);
  726.   vmemwrite(62,11,']',colors.dark);
  727.   vmemwrite(3,2,'Current trunk:',colors.titlebox_high);
  728.   vmemwrite(62,2,'Local Time:',colors.titlebox_high);
  729.   textattr:=colors.status;
  730.   gotoxy(1,25);
  731.   write(' BlueBEEP! v');
  732.   clreol;
  733.   if mousepresent then begin
  734.     gotoxy(26,25);
  735.     cwrite('|'+stg(colors.status div 16)+'|d[|WScroll Up|d]   [|WScroll Down|d]');
  736.   end;
  737.   gotoxy(67,25);
  738.   cwrite('|'+stg(colors.status div 16)+'|d[|YESC|d] to quit');
  739.   window(1,15,80,15+pagesize);
  740.   vmemwrite(26,8,stg2(config.dialspeed)+'x ',colors.high);
  741.   vmemwrite(44,8,curdtl.name,colors.high);
  742.   vmemwrite(72,8,curds.standard,colors.high);
  743.   vmemwrite(18,2,curtrunk.name,colors.titlebox);
  744.   vmemwrite(13,25,version,colors.status);
  745.   x:=port[pdial.portadress];
  746.   if gesetztinbyte(hookbit,x) then vmemwrite(18,13,' ON-HOOK ',colors.keypad_pressed)
  747.     else vmemwrite(18,13,' ON-HOOK ',colors.keypad_released);
  748.   if gesetztinbyte(playrecbit,x) then begin
  749.     vmemwrite(28,13,' PLAY ',colors.keypad_released);
  750.     vmemwrite(35,13,' REC ',colors.keypad_pressed);
  751.   end else begin
  752.     vmemwrite(28,13,' PLAY ',colors.keypad_pressed);
  753.     vmemwrite(35,13,' REC ',colors.keypad_released);
  754.   end;
  755.   vmemwrite(49,13,' DIAL ',colors.keypad_released);
  756.   if config.switchback=0 then begin
  757.     vmemwrite(59,13,' NONE ',colors.keypad_pressed);
  758.     vmemwrite(66,13,' REC ',colors.keypad_released);
  759.     vmemwrite(72,13,' PHONE ',colors.keypad_released);
  760.   end;
  761.   if config.switchback=1 then begin
  762.     vmemwrite(59,13,' NONE ',colors.keypad_released);
  763.     vmemwrite(66,13,' REC ',colors.keypad_pressed);
  764.     vmemwrite(72,13,' PHONE ',colors.keypad_released);
  765.   end;
  766.   if config.switchback=2 then begin
  767.     vmemwrite(59,13,' NONE ',colors.keypad_released);
  768.     vmemwrite(66,13,' REC ',colors.keypad_released);
  769.     vmemwrite(72,13,' PHONE ',colors.keypad_pressed);
  770.   end;
  771.   if not(gesetztinbyte(phonebit,x)) then vmemwrite(41,13,' PHONE ',colors.keypad_pressed)
  772.     else vmemwrite(41,13,' PHONE ',colors.keypad_released);
  773.   firstonpage:=config.firstonpage;
  774.   current:=config.curnum;
  775.   refreshnums;
  776.   textattr:=colors.normal;
  777.   writeln;
  778.   write('Welcome to BlueBEEP V',version,' - "Ready To Rock, Commander Data?"');
  779.   repeat
  780.     spkey:=false;
  781.     setcursorsize($32,$32);
  782.     if mousepresent then mouseon;
  783.     if mousepresent then
  784.     repeat vmemwrite(74,2,time(false),colors.titlebox) until keypressed or mouseleftclicked or mouserightclicked
  785.     else repeat vmemwrite(74,2,time(false),colors.titlebox) until keypressed;
  786.     if mousepresent then mouseoff;
  787.     if mousepresent and mouserightclicked then begin
  788.       ch:=#27;
  789.       repeat until not(mouserightclicked);
  790.     end;
  791.     if mousepresent and mouseleftclicked then begin
  792.       ch:='-';
  793.       mx:=mousex; my:=mousey;
  794.       if config.flipkeypad then begin
  795.         if (mx>1) and (mx<7) and (my=5) then ch:='7';
  796.         if (mx>7) and (mx<13) and (my=5) then ch:='8';
  797.         if (mx>13) and (mx<19) and (my=5) then ch:='9';
  798.         if (mx>1) and (mx<7) and (my=7) then ch:='4';
  799.         if (mx>7) and (mx<13) and (my=7) then ch:='5';
  800.         if (mx>13) and (mx<19) and (my=7) then ch:='6';
  801.         if (mx>1) and (mx<7) and (my=9) then ch:='1';
  802.         if (mx>7) and (mx<13) and (my=9) then ch:='2';
  803.         if (mx>13) and (mx<19) and (my=9) then ch:='3';
  804.       end else begin
  805.         if (mx>1) and (mx<7) and (my=5) then ch:='1';
  806.         if (mx>7) and (mx<13) and (my=5) then ch:='2';
  807.         if (mx>13) and (mx<19) and (my=5) then ch:='3';
  808.         if (mx>1) and (mx<7) and (my=7) then ch:='4';
  809.         if (mx>7) and (mx<13) and (my=7) then ch:='5';
  810.         if (mx>13) and (mx<19) and (my=7) then ch:='6';
  811.         if (mx>1) and (mx<7) and (my=9) then ch:='7';
  812.         if (mx>7) and (mx<13) and (my=9) then ch:='8';
  813.         if (mx>13) and (mx<19) and (my=9) then ch:='9';
  814.       end;
  815.       if (mx>1) and (mx<7) and (my=11) then ch:='*';
  816.       if (mx>7) and (mx<13) and (my=11) then ch:='0';
  817.       if (mx>13) and (mx<19) and (my=11) then ch:='#';
  818.       if (mx>19) and (mx<25) and (my=5) then ch:='A';
  819.       if (mx>25) and (mx<31) and (my=5) then ch:='B';
  820.       if (mx>31) and (mx<36) and (my=5) then ch:='C';
  821.       if (mx>36) and (mx<43) and (my=5) then ch:='D';
  822.       if (mx>43) and (mx<49) and (my=5) then ch:='E';
  823.       if (mx>49) and (mx<55) and (my=5) then ch:='F';
  824.       if (mx>55) and (mx<61) and (my=5) then ch:='G';
  825.       if (mx>61) and (mx<66) and (my=5) then ch:='H';
  826.       if (mx>72) and (mx<80) and (my=5) then ch:='+';
  827.       if (mx>20) and (mx<25) and (my=10) then begin ch:=F1; spkey:=true; end;
  828.       if (mx>20) and (mx<25) and (my=11) then begin ch:=F2; spkey:=true; end;
  829.       if (mx>38) and (mx<41) and (my=10) then begin ch:=CurLf; spkey:=true; end;
  830.       if (mx>40) and (mx<43) and (my=10) then begin ch:=CurRt; spkey:=true; end;
  831.       if (mx>38) and (mx<43) and (my=11) then ch:=#13;
  832.       if (mx>57) and (mx<63) and (my=10) then begin ch:=F10; spkey:=true; end;
  833.       if (mx>57) and (mx<63) and (my=11) then ch:=' ';;
  834.       if (mx>66) and (mx<72) and (my=25) then ch:=#27;
  835.       if (mx>17) and (mx<27) and (my=13) then begin ch:=F5; spkey:=true; end;
  836.       if (mx>27) and (mx<40) and (my=13) then begin ch:=F6; spkey:=true; end;
  837.       if (mx>40) and (mx<53) and (my=13) then begin ch:=F7; spkey:=true; end;
  838.       if (mx>58) and (mx<80) and (my=13) then begin ch:=#50; spkey:=true; end;
  839.       if (mx>48) and (mx<55) and (my=13) then begin ch:='P'; spkey:=false; end;
  840.       if (my>15) and (my<25) then begin
  841.         current:=firstonpage+(my-16);
  842.         refreshnums;
  843.       end;
  844.       if (mx>25) and (mx<37) and (my=25) then while mouseleftclicked do begin
  845.         if current>1 then begin
  846.           dec(current);
  847.           if current<firstonpage then dec(firstonpage);
  848.           refreshnums;
  849.         end;
  850.       end;
  851.       if (mx>39) and (mx<53) and (my=25) then while mouseleftclicked do begin
  852.         if current<maxnums then begin
  853.           inc(current);
  854.           if current-firstonpage>=pagesize then inc(firstonpage);
  855.           refreshnums;
  856.         end;
  857.       end;
  858.     end;
  859.     if keypressed then begin
  860.       ch:=upcase(readkey);
  861.       if ch=#0 then begin
  862.         ch:=readkey;
  863.         spkey:=true;
  864.       end;
  865.     end;
  866.     if spkey then case ch of
  867.       CurDn:if current<maxnums then begin
  868.               inc(current);
  869.               if current-firstonpage>=pagesize then inc(firstonpage);
  870.               refreshnums;
  871.             end;
  872.       CurUp:if current>1 then begin
  873.               dec(current);
  874.               if current<firstonpage then dec(firstonpage);
  875.               refreshnums;
  876.             end;
  877.       PgUp :begin
  878.               if current>pagesize+1 then begin
  879.                 dec(current,pagesize-1);
  880.                 if firstonpage>pagesize then dec(firstonpage,pagesize-1)
  881.                   else firstonpage:=1;
  882.               end else begin
  883.                 firstonpage:=1;
  884.                 current:=1;
  885.               end;
  886.               refreshnums;
  887.             end;
  888.       PgDn :begin
  889.               if current<maxnums-pagesize then begin
  890.                 inc(current,pagesize-1);
  891.                 inc(firstonpage,pagesize-1);
  892.               end else begin
  893.                 firstonpage:=maxnums-pagesize+1;
  894.                 current:=maxnums;
  895.               end;
  896.               refreshnums;
  897.             end;
  898.       Home :begin current:=1; firstonpage:=1; refreshnums; end;
  899.       Endk :begin firstonpage:=maxnums-pagesize+1; current:=maxnums; refreshnums; end;
  900.       CurRt:begin
  901.               if config.dialspeed<100 then config.dialspeed:=config.dialspeed+speedstepsize;
  902.               vmemwrite(26,8,stg2(config.dialspeed)+'x ',colors.high);
  903.             end;
  904.       CurLf :begin
  905.                if config.dialspeed>=speedstepsize then config.dialspeed:=config.dialspeed-speedstepsize;
  906.                vmemwrite(26,8,stg2(config.dialspeed)+'x ',colors.high);
  907.              end;
  908.       Ins   :InsertEntry;
  909.       Del   :DeleteEntry;
  910.       F1    :selecttrunk;
  911.       F2    :selectset;
  912.       F3    :selectdtl;
  913.       F5    :begin
  914.                textattr:=colors.normal;
  915.                writeln;
  916.                write('Toggling Device Hook Condition...');
  917.                testbyte:=port[pdial.portadress];
  918.                if gesetztinbyte(hookbit,testbyte) then clrportbit(hookbit,true)
  919.                  else setportbit(hookbit,true);
  920.              end;
  921.       F6    :begin
  922.                textattr:=colors.normal;
  923.                writeln;
  924.                write('Toggling Device Play/Record Bit Condition...');
  925.                testbyte:=port[pdial.portadress];
  926.                if gesetztinbyte(playrecbit,testbyte) then clrportbit(playrecbit,true)
  927.                  else setportbit(playrecbit,true);
  928.              end;
  929.       F7    :begin
  930.                textattr:=colors.normal;
  931.                writeln;
  932.                write('Toggling Phone Online Condition...');
  933.                testbyte:=port[pdial.portadress];
  934.                if gesetztinbyte(phonebit,testbyte) then clrportbit(phonebit,true)
  935.                  else setportbit(phonebit,true);
  936.              end;
  937.       F8    :begin
  938.                textattr:=colors.normal;
  939.                writeln;
  940.                write('Total hangup...');
  941.                clrportbit(hookbit,true);
  942.                setportbit(phonebit,true);
  943.                clrportbit(playrecbit,true);
  944.              end;
  945.       F9    :vtdialer;
  946.       F10   :begin
  947.                config.curnum:=current;
  948.                config.firstonpage:=firstonpage;
  949.                imoutie;
  950.              end;
  951.       #50   :begin                        { #0+#50 = ALT-M }
  952.                textattr:=colors.normal;
  953.                writeln;
  954.                write('Turning Device Mode to ');
  955.                textattr:=colors.high;
  956.                if config.switchback<2 then inc(config.switchback,1) else config.switchback:=0;
  957.                case config.switchback of
  958.                  0 :write('NONE');
  959.                  1 :write('REC');
  960.                  2 :write('PHONE');
  961.                end;
  962.                if config.switchback=0 then begin
  963.                  vmemwrite(59,13,' NONE ',colors.knob_active);
  964.                  vmemwrite(66,13,' REC ',colors.knob_inactive);
  965.                  vmemwrite(72,13,' PHONE ',colors.knob_inactive);
  966.                end;
  967.                if config.switchback=1 then begin
  968.                  vmemwrite(59,13,' NONE ',colors.knob_inactive);
  969.                  vmemwrite(66,13,' REC ',colors.knob_active);
  970.                  vmemwrite(72,13,' PHONE ',colors.knob_inactive);
  971.                end;
  972.                if config.switchback=2 then begin
  973.                  vmemwrite(59,13,' NONE ',colors.knob_inactive);
  974.                  vmemwrite(66,13,' REC ',colors.knob_inactive);
  975.                  vmemwrite(72,13,' PHONE ',colors.knob_active);
  976.                end;
  977.              end;
  978.       #17   :begin worldtime; refreshnums; end;
  979.       #31   :begin sortphonebook; refreshnums; end;
  980.       '0'   :begin { ALT-B }
  981.                move(mem[vadr:0],bks,4000);
  982.                sosopen;
  983.                sosfopen(bosskeyfilename);
  984.                sosread(@mem[vadr:0],4000);
  985.                sosclose;
  986.                setcursorsize($6,$7);
  987.                window(1,1,80,25);
  988.                textattr:=lightgreen;
  989.                gotoxy(14,2);
  990.                readln;
  991.                setcursorsize($32,$32);
  992.                move(bks,mem[vadr:0],4000);
  993.                window(18,14,79,14);
  994.                textattr:=colors.normal;
  995.                writeln;
  996.                write('Puhh.. Boss is gone, huh?');
  997.              end;
  998.       end;
  999.       if not(spkey) then begin
  1000.         if config.flipkeypad then case ch of
  1001.           '7' :ch:='1';
  1002.           '8' :ch:='2';
  1003.           '9' :ch:='3';
  1004.           '1' :ch:='7';
  1005.           '2' :ch:='8';
  1006.           '3' :ch:='9';
  1007.           '.' :ch:='#';
  1008.           ',' :ch:='#';
  1009.         end;
  1010.         case ch of
  1011.           ' ':begin editnumber(current); refreshnums; end;
  1012.           '1':dial('1',true,config.touchpad,true);
  1013.           '2':dial('2',true,config.touchpad,true);
  1014.           '3':dial('3',true,config.touchpad,true);
  1015.           '4':dial('4',true,config.touchpad,true);
  1016.           '5':dial('5',true,config.touchpad,true);
  1017.           '6':dial('6',true,config.touchpad,true);
  1018.           '7':dial('7',true,config.touchpad,true);
  1019.           '8':dial('8',true,config.touchpad,true);
  1020.           '9':dial('9',true,config.touchpad,true);
  1021.           '0':dial('0',true,config.touchpad,true);
  1022.           '*':dial('*',true,config.touchpad,true);
  1023.           '#':dial('#',true,config.touchpad,true);
  1024.           'A':dial('A',true,config.touchpad,true);
  1025.           'B':dial('B',true,config.touchpad,true);
  1026.           'C':dial('C',true,config.touchpad,true);
  1027.           'D':dial('D',true,config.touchpad,true);
  1028.           'E':dial('E',true,config.touchpad,true);
  1029.           'F':dial('F',true,config.touchpad,true);
  1030.           'G':dial('G',true,config.touchpad,true);
  1031.           'H':dial('H',true,config.touchpad,true);
  1032.           'W':pleasewait;
  1033.           '+':playtrunk(curtrunk,true);
  1034.           #13:dial(xlate(numbers[current]^.number),true,false,true);
  1035.           'P':begin
  1036.                 vmemwrite(49,13,' DIAL ',colors.knob_active);
  1037.                 setportbit(phonebit,true);
  1038.                 clrportbit(playrecbit,true);
  1039.                 textattr:=colors.normal;
  1040.                 writeln;
  1041.                 write('Hanging up...');
  1042.                 clrportbit(playrecbit,true);
  1043.                 clrportbit(hookbit,true);
  1044.                 delayms(curpulsedial.hanguptime);
  1045.                 writeln;
  1046.                 write('Waiting for dialtone...');
  1047.                 setportbit(pdial.hookbit,true);
  1048.                 delayms(pdial.waitfordt);
  1049.                 writeln;
  1050.                 write('Pulse-Dialing: ');
  1051.                 dialpulse(numbers[current]^.number,true);
  1052.                 switchoff(true);
  1053.                 vmemwrite(49,13,' DIAL ',colors.knob_inactive);
  1054.               end;
  1055.           'M':begin modemdial(numbers[current]^.number); refreshnums; end;
  1056.           'I':begin
  1057.                 textattr:=colors.normal;
  1058.                 writeln;
  1059.                 write('Debug Info: MemAvail ',memavail,', MaxAvail ',maxavail);
  1060.               end;
  1061.           'S':searchphonebook;
  1062.           'Q':recordquick;
  1063.           'R':replayquick;
  1064.           'T':begin
  1065.                 numflags[current]:=not(numflags[current]);
  1066.                 if current<maxnums then begin
  1067.                   inc(current);
  1068.                   if current-firstonpage>=pagesize then inc(firstonpage);
  1069.                 end;
  1070.                 refreshnums;
  1071.               end;
  1072.       end;
  1073.     end;
  1074.     if mousepresent and mouseleftclicked then repeat until not(mouseleftclicked);
  1075.   until ch=#27;
  1076.   config.curnum:=current;
  1077.   config.firstonpage:=firstonpage;
  1078.   window(1,1,80,25);
  1079.   setcursorsize($32,$32);
  1080.   move(save,mem[vadr:0],4000);
  1081. end;
  1082.  
  1083. procedure redboxit;
  1084. var x,y,z      :word;
  1085.     ch         :char;
  1086.     mx,my      :integer;
  1087.     mousepress :boolean;
  1088.     scammed    :real;
  1089. procedure scam;
  1090. begin
  1091.   scammed:=scammed+0.05;
  1092.   gotoxy(37,20);
  1093.   textattr:=colors.special_high;
  1094.   write('$',scammed:0:2);
  1095. end;
  1096. procedure playredbox(tone1,tone2,coin:word);
  1097. var x:word;
  1098. begin
  1099.   if coin=1 then begin
  1100.     scam;
  1101.     soundplay(tone1,tone2,0,50);
  1102.     delayms(50);
  1103.     exit;
  1104.   end;
  1105.   if coin=2 then begin
  1106.     for x:=1 to 2 do begin
  1107.       scam;
  1108.       soundplay(tone1,tone2,0,50);
  1109.       delayms(50);
  1110.     end;
  1111.     exit;
  1112.   end;
  1113.   if coin=3 then begin
  1114.     for x:=1 to 5 do begin
  1115.       scam;
  1116.       soundplay(tone1,tone2,0,30);
  1117.       delayms(25);
  1118.     end;
  1119.     exit;
  1120.   end;
  1121. end;
  1122. begin
  1123.   mousepress:=false;
  1124.   move(mem[vadr:0],save,4000);
  1125.   bottominfo('BlueBEEP! Red BoX Mode');
  1126.   window(1,4,80,24);
  1127.   clrscr;
  1128.   openbox(1,3,8,21,10,false,true,false);
  1129.   openbox(2,3,10,21,16,false,true,false);
  1130.   openbox(3,21,8,30,10,false,true,false);
  1131.   openbox(4,21,10,30,16,false,true,false);
  1132.   vmemwrite(21,8,'┬',colors.win_border_1);
  1133.   vmemwrite(3,10,'├',colors.win_border_1);
  1134.   vmemwrite(21,10,'┼',colors.win_border_1);
  1135.   vmemwrite(21,16,'┴',colors.win_border_1);
  1136.   vmemwrite(30,10,'┤',colors.win_border_1);
  1137.   vmemwrite(4,11,'     │     │',colors.dark);
  1138.   vmemwrite(4,12,'─────┼─────┼─────',colors.dark);
  1139.   vmemwrite(4,13,'     │     │     ',colors.dark);
  1140.   vmemwrite(4,14,'─────┼─────┼─────',colors.dark);
  1141.   vmemwrite(4,15,'     │     │     ',colors.dark);
  1142.   vmemwrite(6,11,'1',colors.keypad_released);
  1143.   vmemwrite(12,11,'2',colors.keypad_released);
  1144.   vmemwrite(18,11,'3',colors.keypad_released);
  1145.   vmemwrite(6,13,'4',colors.keypad_released);
  1146.   vmemwrite(12,13,'5',colors.keypad_released);
  1147.   vmemwrite(18,13,'6',colors.keypad_released);
  1148.   vmemwrite(6,15,'7',colors.keypad_released);
  1149.   vmemwrite(12,15,'8',colors.keypad_released);
  1150.   vmemwrite(18,15,'9',colors.keypad_released);
  1151.   vmemwrite(23,9,'ReDBoX',colors.high2);
  1152.   vmemwrite(24,11,'ACTS',colors.high);
  1153.   vmemwrite(24,13,'IPTS',colors.high);
  1154.   vmemwrite(23,15,'N-ACTS',colors.high);
  1155.   vmemwrite(4,9,' 5¢    10¢   25¢',colors.high);
  1156.   vmemwrite(9,9,'│',colors.dark);
  1157.   vmemwrite(15,9,'│',colors.dark);
  1158.   vmemwrite(22,12,'────────',colors.dark);
  1159.   vmemwrite(22,14,'────────',colors.dark);
  1160.   textattr:=colors.high;
  1161.   gotoxy(45,5); write('Red Box Mode');
  1162.   gotoxy(35,7); write('Try 1-9 for various coins and companies.');
  1163.   gotoxy(35,8); write('This should do fine in North America and');
  1164.   gotoxy(35,9); write('and Canada.');
  1165.   gotoxy(35,10);write('If anyone has suggestions on this part of');
  1166.   gotoxy(35,11);write('BlueBEEP!, please let me know.');
  1167.   gotoxy(38,13);write('Press [R] to reset the cash counter');
  1168.   gotoxy(38,14);write('Press [ESC] to exit Red Box Mode');
  1169.   scammed:=0;
  1170.   textattr:=colors.special;
  1171.   gotoxy(21,20);
  1172.   write('Amount $cammed: ');
  1173.   textattr:=colors.special_high;
  1174.   gotoxy(37,20);
  1175.   write('$0.00');
  1176.   repeat
  1177.     if mousepresent then mouseon;
  1178.     if mousepresent then repeat until keypressed or mouseleftclicked or mouserightclicked
  1179.     else repeat until keypressed;
  1180.     mx:=mousex; my:=mousey;
  1181.     if mousepresent then mouseoff;
  1182.     if mouseleftclicked and mousepresent then begin
  1183.       ch:=' ';
  1184.       if (mx>=4) and (mx<=8) and (my=11) then ch:='1';
  1185.       if (mx>=10) and (mx<=14) and (my=11) then ch:='2';
  1186.       if (mx>=16) and (mx<=20) and (my=11) then ch:='3';
  1187.       if (mx>=4) and (mx<=8) and (my=13) then ch:='4';
  1188.       if (mx>=10) and (mx<=14) and (my=13) then ch:='5';
  1189.       if (mx>=16) and (mx<=20) and (my=13) then ch:='6';
  1190.       if (mx>=4) and (mx<=8) and (my=15) then ch:='7';
  1191.       if (mx>=10) and (mx<=14) and (my=15) then ch:='8';
  1192.       if (mx>=16) and (mx<=20) and (my=15) then ch:='9';
  1193.       mousepress:=true;
  1194.     end;
  1195.     if mouserightclicked and mousepresent then begin
  1196.       ch:=#27;
  1197.       repeat until not(mouserightclicked);
  1198.     end;
  1199.     if keypressed then repeat ch:=upcase(readkey) until ch in ['1','2','3','4','5','6','7','8','9',#27,'R'];
  1200.     case ch of
  1201.       '1' :begin
  1202.              vmemwrite(5,11,' 1 ',colors.keypad_pressed);
  1203.              playredbox(curredbox.acts1,curredbox.acts2,1);
  1204.              vmemwrite(5,11,' 1 ',colors.keypad_released);
  1205.            end;
  1206.       '2' :begin
  1207.              vmemwrite(11,11,' 2 ',colors.keypad_pressed);
  1208.              playredbox(curredbox.acts1,curredbox.acts2,2);
  1209.              vmemwrite(11,11,' 2 ',colors.keypad_released);
  1210.            end;
  1211.       '3' :begin
  1212.              vmemwrite(17,11,' 3 ',colors.keypad_pressed);
  1213.              playredbox(curredbox.acts1,curredbox.acts2,3);
  1214.              vmemwrite(17,11,' 3 ',colors.keypad_released);
  1215.            end;
  1216.       '4' :begin
  1217.              vmemwrite(5,13,' 4 ',colors.keypad_pressed);
  1218.              playredbox(curredbox.ipts1,curredbox.ipts2,1);
  1219.              vmemwrite(5,13,' 4 ',colors.keypad_released);
  1220.            end;
  1221.       '5' :begin
  1222.              vmemwrite(11,13,' 5 ',colors.keypad_pressed);
  1223.              playredbox(curredbox.ipts1,curredbox.ipts2,2);
  1224.              vmemwrite(11,13,' 5 ',colors.keypad_released);
  1225.            end;
  1226.       '6' :begin
  1227.              vmemwrite(17,13,' 6 ',colors.keypad_pressed);
  1228.              playredbox(curredbox.ipts1,curredbox.ipts2,3);
  1229.              vmemwrite(17,13,' 6 ',colors.keypad_released);
  1230.            end;
  1231.       '7' :begin
  1232.              vmemwrite(5,15,' 7 ',colors.keypad_pressed);
  1233.              playredbox(curredbox.nonacts,0,1);
  1234.              vmemwrite(5,15,' 7 ',colors.keypad_released);
  1235.            end;
  1236.       '8' :begin
  1237.              vmemwrite(11,15,' 8 ',colors.keypad_pressed);
  1238.              playredbox(curredbox.nonacts,0,2);
  1239.              vmemwrite(11,15,' 8 ',colors.keypad_released);
  1240.            end;
  1241.       '9' :begin
  1242.              vmemwrite(17,15,' 9 ',colors.keypad_pressed);
  1243.              playredbox(curredbox.nonacts,0,3);
  1244.              vmemwrite(17,15,' 9 ',colors.keypad_released);
  1245.            end;
  1246.       'R' :begin
  1247.              scammed:=0;
  1248.              textattr:=colors.special_high;
  1249.              gotoxy(37,20);
  1250.              write('$0.00   ');
  1251.            end;
  1252.     end;
  1253.     if mousepress and mousepresent then repeat until not (mouseleftclicked);
  1254.     mousepress:=false;
  1255.   until ch=#27;
  1256.   closebox(4);
  1257.   closebox(3);
  1258.   closebox(2);
  1259.   closebox(1);
  1260.   window(1,1,80,25);
  1261.   move(save,mem[vadr:0],4000);
  1262. end;
  1263.  
  1264. procedure cardtalker;
  1265. var voice                      :voicefile;
  1266.     ch                         :char;
  1267.     x,oldx,oldy                :word;
  1268. procedure talksample(samplefile,message:string);
  1269. var voice:voicefile;
  1270. begin
  1271.   switchon(true);
  1272.   loadvoice(samplefile,voice,0);
  1273.   playvoice(voice);
  1274.   write(message);
  1275.   repeat until status=0;
  1276.   writeln;
  1277.   killvoice(voice);
  1278.   switchoff(true);
  1279. end;
  1280. procedure talknumber(s:string);
  1281. var x:byte;
  1282. procedure talkdigit(ch:char;low:boolean);
  1283. begin
  1284.   write(ch);
  1285.   if low then begin
  1286.     case ch of
  1287.       '1' :loadvoice('lowone.voc',voice,0);
  1288.       '2' :loadvoice('lowtwo.voc',voice,0);
  1289.       '3' :loadvoice('lowthree.voc',voice,0);
  1290.       '4' :loadvoice('lowfour.voc',voice,0);
  1291.       '5' :loadvoice('lowfive.voc',voice,0);
  1292.       '6' :loadvoice('lowsix.voc',voice,0);
  1293.       '7' :loadvoice('lowseven.voc',voice,0);
  1294.       '8' :loadvoice('loweight.voc',voice,0);
  1295.       '9' :loadvoice('lownine.voc',voice,0);
  1296.       '0' :loadvoice('lowzero.voc',voice,0);
  1297.     end;
  1298.   end else begin
  1299.     case ch of
  1300.       '1' :loadvoice('hione.voc',voice,0);
  1301.       '2' :loadvoice('hitwo.voc',voice,0);
  1302.       '3' :loadvoice('hithree.voc',voice,0);
  1303.       '4' :loadvoice('hifour.voc',voice,0);
  1304.       '5' :loadvoice('hifive.voc',voice,0);
  1305.       '6' :loadvoice('hisix.voc',voice,0);
  1306.       '7' :loadvoice('hiseven.voc',voice,0);
  1307.       '8' :loadvoice('hieight.voc',voice,0);
  1308.       '9' :loadvoice('hinine.voc',voice,0);
  1309.       '0' :loadvoice('hizero.voc',voice,0);
  1310.     end;
  1311.   end;
  1312.   playvoice(voice);
  1313.   repeat until status=0;
  1314.   delayms(150);
  1315.   killvoice(voice);
  1316. end;
  1317. begin
  1318.   switchon(true);
  1319.   for x:=1 to length(s)-1 do begin
  1320.     if s[x+1]='-' then begin
  1321.       talkdigit(s[x],true);
  1322.       inc(x);
  1323.       write('-');
  1324.     end else begin
  1325.       talkdigit(s[x],false);
  1326.     end;
  1327.   end;
  1328.   talkdigit(s[length(s)],true);
  1329.   switchoff(true);
  1330.   writeln;
  1331. end;
  1332. begin
  1333.   setcursorsize($6,$7);
  1334.   move(mem[vadr:0],save,4000);
  1335.   clrscr;
  1336.   openbox(1,1,1,80,3,false,false,false);   ignbox(1);
  1337.   openbox(1,1,4,36,10,false,false,false);  ignbox(1);
  1338.   openbox(1,1,10,36,15,false,false,false); ignbox(1);
  1339.   openbox(1,36,4,80,15,false,false,false); ignbox(1);
  1340.   vmemwrite(1,10,#195,colors.win_border_1);
  1341.   vmemwrite(36,4,#194,colors.win_border_1);
  1342.   vmemwrite(36,15,#193,colors.win_border_1);
  1343.   vmemwrite(36,9,#179,colors.win_border_2);
  1344.   vmemwrite(36,10,#180,colors.win_border_1);
  1345.   vmemwrite(36,11,#179,colors.win_border_2);
  1346.   for x:=0 to 239 do mem[vadr:x*2+1]:=colors.titlebox_border;
  1347.   for x:=2 to 78 do mem[vadr:160+(x*2+1)]:=colors.titlebox_high;
  1348.   gotoxy(1,25);
  1349.   textattr:=colors.status;
  1350.   write(' BlueBEEP! v      Card Talker');
  1351.   clreol;
  1352.   vmemwrite(13,25,version,colors.status);
  1353.   vmemwrite(62,2,'Local Time:',colors.titlebox_high);
  1354.   textattr:=colors.titlebox_title;
  1355.   center(1,' BlueBEEP! CardTalker ');
  1356.   textattr:=colors.high2;
  1357.   vmemwrite(44,5,'I''d like to make a call ... AT&T',colors.normal);
  1358.   vmemwrite(44,6,'I''d like to make a call ... MCI',colors.normal);
  1359.   vmemwrite(44,7,'I''d like to make a call ... Sprint',colors.normal);
  1360.   vmemwrite(44,8,'The Number I''m calling to is...',colors.normal);
  1361.   vmemwrite(44,9,'Talk Card Number',colors.normal);
  1362.   vmemwrite(44,10,'Talk Number you''re calling to',colors.normal);
  1363.   vmemwrite(44,11,'User Defined Sample #1 (USER1.VOC)',colors.normal);
  1364.   vmemwrite(44,12,'User Defined Sample #2 (USER2.VOC)',colors.normal);
  1365.   vmemwrite(44,13,'Change Card Number',colors.normal);
  1366.   vmemwrite(44,14,'Change Phone Number',colors.normal);
  1367.   for x:=5 to 13 do vmemwrite(39,x,'[',colors.dark);
  1368.   vmemwrite(38,14,'[',colors.dark);
  1369.   for x:=5 to 14 do vmemwrite(42,x,']',colors.dark);
  1370.   for x:=1 to 9 do vmemwrite(40,4+x,'F'+stg(x),colors.super_high);
  1371.   vmemwrite(39,14,'F10',colors.super_high);
  1372.   vmemwrite(3,12,'Loaded Card #:',colors.normal);
  1373.   vmemwrite(3,13,'Loaded Fone #:',colors.normal);
  1374.   vmemwrite(18,12,config.curcard,colors.high);
  1375.   vmemwrite(18,13,config.curcallto,colors.high);
  1376.   textattr:=colors.high;
  1377.   window(3,5,34,9);
  1378.   if config.gotblaster=false then begin
  1379.     writeln('Need Soundblaster for this!');
  1380.     writeln('If you have one, set it up');
  1381.     writeln('in the Setup/Blaster menu !');
  1382.     writeln('Press <ENTER>...');
  1383.     repeat ch:=readkey until ch=#13;
  1384.     window(1,1,80,25);
  1385.     move(save,mem[vadr:0],4000);
  1386.     setcursorsize($32,$32);
  1387.     exit;
  1388.   end;
  1389.   writeln('Loading SB driver...');
  1390.   fixdriver('CT-VOICE.DRV',0);
  1391.   writeln('Initializing card...');
  1392.   if initblaster(config.sbint,config.sbaddr)=0 then writeln('Initialize OK.') else begin
  1393.     writeln('BLASTER INIT FAILURE!');
  1394.     writeln('Check your settings !');
  1395.     writeln('Or BUY A BLASTER !');
  1396.     writeln('Press <ENTER>...');
  1397.     repeat ch:=readkey until ch=#13;
  1398.     writeln('Removing driver...');
  1399.     removedriver;
  1400.     window(1,1,80,25);
  1401.     move(save,mem[vadr:0],4000);
  1402.     setcursorsize($32,$32);
  1403.     exit;
  1404.   end;
  1405.   writeln('Init Done.');
  1406.   repeat
  1407.     ch:=' ';
  1408.     if mousepresent then mouserange(37,5,79,14);
  1409.     if mousepresent then mouseon;
  1410.     if mousepresent then
  1411.     repeat vmemwrite(74,2,time(false),colors.titlebox) until keypressed or mouseleftclicked or mouserightclicked
  1412.     else repeat vmemwrite(74,2,time(false),colors.titlebox) until keypressed;
  1413.     if mousepresent then mouseoff;
  1414.     if mousepresent and mouserightclicked then begin
  1415.       ch:=#27;
  1416.       repeat until not(mouserightclicked);
  1417.     end;
  1418.     if mousepresent and mouseleftclicked then begin
  1419.       case mousey of
  1420.         5  :ch:=F1;
  1421.         6  :ch:=F2;
  1422.         7  :ch:=F3;
  1423.         8  :ch:=F4;
  1424.         9  :ch:=F5;
  1425.         10 :ch:=F6;
  1426.         11 :ch:=F7;
  1427.         12 :ch:=F8;
  1428.         13 :ch:=F9;
  1429.         14 :ch:=F10;
  1430.       end;
  1431.     end;
  1432.     if keypressed then ch:=readkey;
  1433.     case ch of
  1434.       F1 :talksample('usinatt.voc','Wanna use my AT&T calling card');
  1435.       F2 :talksample('usinmci.voc','Wanna use my MCI calling card');
  1436.       F3 :talksample('usinspr.voc','Wanna use my Sprint phonecard');
  1437.       F4 :talksample('numcall.voc','The number I''m calling is');
  1438.       F5 :talknumber(config.curcard);
  1439.       F6 :talknumber(config.curcallto);
  1440.       F7 :talksample('user1.voc','User Defined Sample #1');
  1441.       F8 :talksample('user2.voc','User Defined Sample #2');
  1442.       F9 :begin
  1443.             oldx:=wherex; oldy:=wherey;
  1444.             window(1,1,80,25);
  1445.             gotoxy(18,12);
  1446.             edit(config.curcard,17);
  1447.             window(3,5,34,9);
  1448.             gotoxy(oldx,oldy);
  1449.             textattr:=colors.high;
  1450.             writeln('New card # entered');
  1451.           end;
  1452.       F10:begin
  1453.             oldx:=wherex; oldy:=wherey;
  1454.             window(1,1,80,25);
  1455.             gotoxy(18,13);
  1456.             edit(config.curcallto,17);
  1457.             window(3,5,34,9);
  1458.             gotoxy(oldx,oldy);
  1459.             textattr:=colors.high;
  1460.             writeln('New phone # entered');
  1461.           end;
  1462.     end;
  1463.   until ch=#27;
  1464.   writeln('Removing driver...');
  1465.   removedriver;
  1466.   window(1,1,80,25);
  1467.   if mousepresent then mouserange(1,1,80,25);
  1468.   move(save,mem[vadr:0],4000);
  1469.   setcursorsize($32,$32);
  1470. end;
  1471.  
  1472. procedure freqtester;
  1473. var ch         :char;
  1474.     temptrunk  :trunktype;
  1475. procedure savetrunk;
  1476. var comp,desc        :string;
  1477.     save,x,pos,res   :byte;
  1478.     t,worktrunk      :trunktype;
  1479. begin
  1480.   pos:=0; res:=1;
  1481.   save:=textattr;
  1482.   textattr:=colors.win_text;
  1483.   openbox(13,15,10,65,18,true,true,false);
  1484.   center(10,'Save Trunk');
  1485.   gotoxy(18,12); write('    Company:');
  1486.   gotoxy(18,13); write('Description:');
  1487.   gotoxy(18,14); write('   Position:');
  1488.   textattr:=colors.win_text_high;
  1489.   comp:=''; desc:='';
  1490.   gotoxy(31,12); edituc(comp,8);
  1491.   gotoxy(31,13); edit(desc,30);
  1492.   sosopen;
  1493.   sosfopen(trunkfilename);
  1494.   for x:=1 to maxtrunks do begin
  1495.     sosread(@worktrunk,sizeof(worktrunk));
  1496.     menuitem[x]:=worktrunk.name;
  1497.     menuinfo[x]:=worktrunk.description;
  1498.   end;
  1499.   sosclose;
  1500.   menucount:=maxtrunks;
  1501.   setcursorsize($32,$32);
  1502.   res:=menu(1,4,res,true,true,true,false,true);
  1503.   pos:=res;
  1504.   gotoxy(31,14); write('#',pos);
  1505.   gotoxy(34,16);
  1506.   if yesnotoggle(true,'OK','CANCEL') then begin
  1507.     t:=temptrunk;
  1508.     t.name:=comp;
  1509.     t.description:=desc;
  1510.     sosopen;
  1511.     sosfopen(trunkfilename);
  1512.     sosseek(sizeof(trunktype)*(pos-1));
  1513.     soswrite(@t,sizeof(t));
  1514.     sosclose;
  1515.   end;
  1516.   closebox(13);
  1517.   setcursorsize($32,$32);
  1518.   textattr:=save;
  1519. end;
  1520.  
  1521. procedure editfreqs;
  1522. procedure modify(x,y:byte;var data:word);
  1523. begin
  1524.   gotoxy(x,y);
  1525.   editword(data);
  1526.   gotoxy(x,y);
  1527.   textattr:=colors.high;
  1528.   write(data:5);
  1529. end;
  1530. begin
  1531.   with curfreqtest do begin
  1532.     modify(5,5,freq11);
  1533.     modify(11,5,freq12);
  1534.     modify(17,5,freq13);
  1535.     modify(23,5,len1);
  1536.     modify(29,5,del1);
  1537.     modify(5,6,freq21);
  1538.     modify(11,6,freq22);
  1539.     modify(17,6,freq23);
  1540.     modify(23,6,len2);
  1541.   end;
  1542.   setcursorsize($32,$32);
  1543. end;
  1544.  
  1545. begin
  1546.   move(mem[vadr:0],save,4000);
  1547.   textattr:=colors.normal;
  1548.   clrscr;
  1549.   openbox(10,1,1,80,3,false,true,false);
  1550.   openbox(11,1,23,80,25,false,true,false);
  1551.   gotoxy(3,24);
  1552.   textattr:=colors.win_text;;
  1553.   cwrite('|WCurrent Test#: |Y'+curfreqtest.numbertotest);
  1554.   gotoxy(50,24); cwrite('|WStep Size:');
  1555.   gotoxy(68,24); cwrite('|YESC |Wto exit');
  1556.   gotoxy(3,2); write('Frequency Tester');
  1557.   for x:=1 to 10 do begin
  1558.     temptrunk.tone[x].one:=0;           { reset trunk variables in order to  }
  1559.     temptrunk.tone[x].two:=0;           { avoid trash while playing trunk    }
  1560.     temptrunk.tone[x].three:=0;
  1561.     temptrunk.tone[x].len:=0;
  1562.     temptrunk.pause[x]:=0;
  1563.   end;
  1564.   repeat
  1565.     with curfreqtest do begin
  1566.       temptrunk.tone[1].one:=freq11;    {  *  Dump all the garbage from    * }
  1567.       temptrunk.tone[1].two:=freq12;    {  *  curfreqtest into a trunk     * }
  1568.       temptrunk.tone[1].three:=freq13;  {  *  variable for playtrunk()     * }
  1569.       temptrunk.tone[1].len:=len1;
  1570.       temptrunk.tone[2].one:=freq21;
  1571.       temptrunk.tone[2].two:=freq22;
  1572.       temptrunk.tone[2].three:=freq23;
  1573.       temptrunk.tone[2].len:=len2;
  1574.       temptrunk.pause[1]:=del1;
  1575.       textattr:=colors.high;
  1576.       gotoxy(5,5); write(freq11:5,'/',freq12:5,'/',freq13:5,'/',len1:5,'/',del1:5);
  1577.       gotoxy(5,6); write(freq21:5,'/',freq22:5,'/',freq23:5,'/',len2:5);
  1578.       textattr:=colors.win_text_high;
  1579.       gotoxy(61,24);
  1580.       write(stepsize,'  ');
  1581.       textattr:=colors.win_text;
  1582.       repeat vmemwrite(74,2,time(false),colors.win_text) until keypressed;
  1583.       ch:=upcase(readkey);
  1584.       if ch=#0 then begin
  1585.         ch:=readkey;
  1586.         case ch of
  1587.           F1 :stepsize:=1;
  1588.           F2 :stepsize:=3;
  1589.           F3 :stepsize:=5;
  1590.           F4 :stepsize:=20;
  1591.           F5 :playtrunk(curtrunk,false);
  1592.           F6 :savetrunk;
  1593.           F7 :editfreqs;
  1594.           F8 :begin
  1595.                 freq11:=2400; freq12:=2600; freq13:=0; len1:=150; del1:=100;
  1596.                 freq21:=2400; freq22:=0;    freq23:=0; len2:=100;
  1597.               end;
  1598.           F9 :begin freq11:=0; freq12:=0; freq13:=0; len1:=0; del1:=0; end;
  1599.           F10:begin freq21:=0; freq22:=0; freq23:=0; len2:=0; end;
  1600.         end;
  1601.       end else begin
  1602.         case ch of
  1603.           '1' :inc(freq11,stepsize);
  1604.           '2' :inc(freq12,stepsize);
  1605.           '3' :inc(freq13,stepsize);
  1606.           '4' :inc(len1,stepsize);
  1607.           '5' :inc(del1,stepsize);
  1608.           'Q' :if freq11>=stepsize then dec(freq11,stepsize) else freq11:=0;
  1609.           'W' :if freq12>=stepsize then dec(freq12,stepsize) else freq12:=0;
  1610.           'E' :if freq13>=stepsize then dec(freq13,stepsize) else freq13:=0;
  1611.           'R' :if len1>=stepsize then dec(len1,stepsize) else len1:=0;
  1612.           'T' :if del1>=stepsize then dec(del1,stepsize) else del1:=0;
  1613.           '+' :playtrunk(temptrunk,false);
  1614.           'A' :inc(freq21,stepsize);
  1615.           'S' :inc(freq22,stepsize);
  1616.           'D' :inc(freq23,stepsize);
  1617.           'F' :inc(len2,stepsize);
  1618.           'Y' :if freq21>=stepsize then dec(freq21,stepsize) else freq21:=0;
  1619.           'X' :if freq22>=stepsize then dec(freq22,stepsize) else freq22:=0;
  1620.           'C' :if freq23>=stepsize then dec(freq23,stepsize) else freq23:=0;
  1621.           'V' :if len2>=stepsize then dec(len2,stepsize) else len2:=0;
  1622.           ' ' :begin
  1623.                   gotoxy(18,24);
  1624.                   edituc(numbertotest,30);
  1625.                   gotoxy(18,24);
  1626.                   textattr:=colors.win_text_high;
  1627.                   write(numbertotest);
  1628.                   setcursorsize($32,$32);
  1629.                   textattr:=colors.high;
  1630.                 end;
  1631.           #13 :begin
  1632.                  textattr:=colors.high;
  1633.                  gotoxy(1,21);
  1634.                  clreol;
  1635.                  gotoxy(1,20);
  1636.                  dial(numbertotest,false,false,true);
  1637.                  textattr:=colors.high;
  1638.                end;
  1639.         end;
  1640.       end;
  1641.     end;
  1642.   until ch=#27;
  1643.   closebox(11);
  1644.   closebox(10);
  1645.   sosopen;
  1646.   sosfopen(freqtestfilename);
  1647.   soswrite(@curfreqtest,sizeof(curfreqtest));
  1648.   sosclose;
  1649.   move(save,mem[vadr:0],4000);
  1650. end;
  1651.  
  1652. procedure cardchecker;
  1653. var x,total              :word;
  1654.     t                    :text;
  1655.     s,filename,nfilename :string;
  1656.     ch                   :char;
  1657.     exkey                :boolean;
  1658.     f                    :file;
  1659.     vcn,vd,vt,vf         :string;
  1660.     v                    :voicefile;
  1661. procedure checkcard(cardnumber,filename:string;notefile:string);
  1662. var fn     :string;
  1663.     x      :word;
  1664.     total  :word;
  1665.     t      :text;
  1666. begin
  1667.   fn:='';
  1668.   for x:=1 to 8-length(filename) do fn:=fn+'0';     { pad with zeroes        }
  1669.   fn:=fn+filename+'.VOC';
  1670.   if config.ccc_manually then write('Checking Card: ',cardnumber,' manual at ')
  1671.   else write('Checking Card: ',cardnumber,', ',fn,' at ');
  1672.   writeln(curccc.name);
  1673.   switchon(false);
  1674.   write('Waiting for dialtone...');
  1675.   setportbit(pdial.hookbit,false);
  1676.   delayms(pdial.waitfordt);
  1677.   writeln;
  1678.   write('Pulse-Dialing: ');
  1679.   dialpulse(curccc.number,false);
  1680.   writeln;
  1681.   switchoff(false);
  1682.   writeln('Waiting for remote pickup...');
  1683.   delayms(curccc.comeuptime);
  1684.   if curccc.numberfirst then begin
  1685.     write('Dialing Target Number...');
  1686.     clrportbit(playrecbit,false);
  1687.     dial(randomnr+'#',false,false,true);
  1688.     setportbit(playrecbit,false);
  1689.     writeln;
  1690.     delayms(curccc.numdelay);
  1691.   end;
  1692.   write('Dialing Card Number...');
  1693.   switchon(false);
  1694.   dial(curccc.startseq+cardnumber+curccc.endseq,false,false,true);
  1695.   switchoff(false);
  1696.   writeln;
  1697.   writeln('Waiting for reaction...');
  1698.   delayms(curccc.recorddelay);
  1699.   if not config.ccc_manually then begin
  1700.     writeln('Sampling ',curccc.sampletime,' ms to ',fn,'...');
  1701.     recordvoice(fn,curccc.samplerate,curccc.sampletime);
  1702.   end else delayms(curccc.sampletime);
  1703.   writeln('Hanging up...');
  1704.   clrportbit(hookbit,false);
  1705.   switchon(false);
  1706.   delayms(curpulsedial.hanguptime);
  1707.   if config.ccc_manually then begin
  1708.     write('Card alive (Y/N) ?');
  1709.     repeat ch:=upcase(readkey) until ch in ['Y','N'];
  1710.     assign(t,notefile);
  1711.     if exist(notefile) then append(t) else rewrite(t);
  1712.     write(t,cardnumber+'  '+date+' '+time(true)+'  '+curccc.name+' ');
  1713.     if ch='Y' then writeln(t,'OK') else writeln(t,'DEAD');
  1714.     textattr:=colors.high;
  1715.     if ch='Y' then writeln(' Yea!') else writeln(' Nop...');
  1716.     textattr:=colors.normal;
  1717.     close(t);
  1718.   end else begin
  1719.     assign(ccctempfile,ccctempfilename);
  1720.     if exist(ccctempfilename) then append(ccctempfile) else rewrite(ccctempfile);
  1721.     writeln(ccctempfile,cardnumber);
  1722.     writeln(ccctempfile,date);
  1723.     writeln(ccctempfile,time(true));
  1724.     writeln(ccctempfile,fn);
  1725.     close(ccctempfile);
  1726.   end;
  1727. end;
  1728. begin
  1729.   move(mem[vadr:0],save,4000);
  1730.   filename:='CHKLIST.TXT';
  1731.   nfilename:='CHKNOTE.TXT';
  1732.   textattr:=colors.normal;
  1733.   clrscr;
  1734.   openbox(40,1,1,80,3,false,true,false);  ignbox(40);
  1735.   openbox(41,1,4,80,8,false,true,false);  ignbox(41);
  1736.   openbox(42,1,9,80,24,false,true,false); ignbox(42);
  1737.   gotoxy(1,25);
  1738.   textattr:=colors.status;
  1739.   clreol;
  1740.   write(' BlueBEEP! v',version,' Calling Card Checker');
  1741.   textattr:=colors.win_text;
  1742.   gotoxy(3,2);
  1743.   write('Calling Card Checker');
  1744.   textattr:=lightgreen;
  1745.   gotoxy(3,5);  write('Checking Card     of');
  1746.   gotoxy(3,6);  write('Calling Card List File: ');
  1747.   gotoxy(3,7);  write('Result note file      : ');
  1748.   gotoxy(27,6); edituc(filename,50);
  1749.   gotoxy(27,7); edituc(nfilename,50);
  1750.   setcursorsize($32,$32);
  1751.   repeat
  1752.     if config.ccc_manually then begin
  1753.       vmemwrite(50,6,' MANUAL ',green*16+white);
  1754.       vmemwrite(59,6,' AUTOMATIC ',lightgreen);
  1755.     end else begin
  1756.       vmemwrite(50,6,' MANUAL ',lightgreen);
  1757.      vmemwrite(59,6,' AUTOMATIC ',green*16+white);
  1758.     end;
  1759.     repeat ch:=upcase(readkey) until ch in ['M','A',#13,#0];
  1760.     if ch=#0 then begin
  1761.       exkey:=true;
  1762.       ch:=readkey;
  1763.     end else exkey:=false;
  1764.     if not exkey then case ch of
  1765.       'M' :config.ccc_manually:=true;
  1766.       'A' :config.ccc_manually:=false;
  1767.     end else config.ccc_manually:=not(config.ccc_manually);
  1768.     if config.ccc_manually then begin
  1769.       vmemwrite(50,6,' MANUAL ',green*16+white);
  1770.       vmemwrite(59,6,' AUTOMATIC ',lightgreen);
  1771.     end else begin
  1772.       vmemwrite(50,6,' MANUAL ',lightgreen);
  1773.      vmemwrite(59,6,' AUTOMATIC ',green*16+white);
  1774.     end;
  1775.   until (ch in [#13,'M','A']) and (not exkey);
  1776.   setcursorsize($6,$7);
  1777.   window(3,10,78,23);
  1778.   textattr:=green;
  1779.   if filename<>'RESUME' then begin
  1780.     writeln('Checking input file...');
  1781.     assign(t,filename);
  1782.     reset(t);
  1783.     total:=0;
  1784.     while not eof(t) do begin
  1785.       readln(t,s);
  1786.       if (s[1]<>';') and (s<>'') and (length(s)=14) then inc(total);
  1787.       vmemwrite(24,5,stg(total),yellow);
  1788.     end;
  1789.     close(t);
  1790.   end else writeln('*** Resume Mode');
  1791.   write('Loading Sound Driver...');
  1792.   fixdriver('CT-VOICE.DRV',0);
  1793.   writeln('OK');
  1794.   write('Initializing sound blaster...');
  1795.   if initblaster(config.sbint,config.sbaddr)<>0 then fatalerror('Blaster Init Failed');
  1796.   writeln('OK');
  1797.   if filename<>'RESUME' then begin
  1798.     assign(t,filename);
  1799.     reset(t);
  1800.     x:=0;
  1801.     ch:=#13;
  1802.     if exist(ccctempfilename) then begin
  1803.       assign(f,ccctempfilename);
  1804.       erase(f);
  1805.     end;
  1806.     while not eof(t) or (ch=#27) do begin
  1807.       readln(t,s);
  1808.       if keypressed then ch:=readkey;
  1809.       if (s[1]<>';') and (s<>'') and (length(s)=14) then begin
  1810.         inc(x);
  1811.         vmemwrite(17,5,stg(x),yellow);
  1812.         checkcard(s,stg(x),nfilename);
  1813.       end;
  1814.     end;
  1815.     close(t);
  1816.     textattr:=lightgreen;
  1817.     writeln;
  1818.     writeln(x,' cards checked - Press [ENTER] to proceed...');
  1819.     repeat ch:=readkey until ch=#13;
  1820.   end;
  1821.   if not(config.ccc_manually) then begin
  1822.     speaker(1);
  1823.     writeln;
  1824.     writeln('*** Card Sample Verification');
  1825.     writeln;
  1826.     textattr:=green;
  1827.     assign(ccctempfile,ccctempfilename);
  1828.     reset(ccctempfile);
  1829.     while not eof(ccctempfile) do begin
  1830.       readln(ccctempfile,vcn);
  1831.       readln(ccctempfile,vd);
  1832.       readln(ccctempfile,vt);
  1833.       readln(ccctempfile,vf);
  1834.       write('Verifying ',vcn,'...');
  1835.       loadvoice(vf,v,0);
  1836.       write(^H^H^H', alive (Y/N/R) ?');
  1837.       repeat
  1838.         playvoice(v);
  1839.         repeat until (status=0) or keypressed;
  1840.         repeat ch:=upcase(readkey) until ch in ['Y','N','R'];
  1841.       until ch<>'R';
  1842.       stopio;
  1843.       killvoice(v);
  1844.       assign(t,nfilename);
  1845.       if exist(nfilename) then append(t) else rewrite(t);
  1846.       write(t,vcn+'  '+vd+' '+vt+'  '+curccc.name+' ');
  1847.       if ch='Y' then writeln(t,'OK') else writeln(t,'DEAD');
  1848.       textattr:=lightgreen;
  1849.       if ch='Y' then writeln(' Yea!') else writeln(' Nop...');
  1850.       textattr:=green;
  1851.       close(t);
  1852.     end;
  1853.     writeln;
  1854.     textattr:=lightgreen;
  1855.     writeln('*** All done, press [ENTER]');
  1856.     repeat ch:=readkey until ch=#13;
  1857.   end;
  1858.   textattr:=green;
  1859.   writeln('De-Installing sound driver...');
  1860.   removedriver;
  1861.   move(save,mem[vadr:0],4000);
  1862.   window(1,1,80,25);
  1863.   setcursorsize($32,$32);
  1864. end;
  1865.  
  1866. procedure foneword;
  1867. var choice :char;
  1868.  
  1869. procedure wordtonumber;
  1870. var s:string;
  1871.     b:byte;
  1872. begin
  1873.   s:='';
  1874.   writeln(' Word --> Number');
  1875.   writeln;
  1876.   write('Which word:');
  1877.   b:=textattr;
  1878.   edituc(s,60);
  1879.   textattr:=b;
  1880.   writeln;
  1881.   writeln;
  1882.   writeln('The number for that word would be ',stringtodigit(s));
  1883.   writeln;
  1884. end;
  1885.  
  1886. procedure findwordsfornumber;
  1887. var s,fn:string;
  1888. begin
  1889.   s:='';
  1890.   writeln(' # --> Words');
  1891.   writeln;
  1892.   write('Which number:');
  1893.   edituc(s,60);
  1894.   if pos('0',s)<>0 then begin
  1895.     writeln;
  1896.     writeln;
  1897.     writeln('The number you entered contains a zero, which is not defined as');
  1898.     writeln('a letter. We are sorry to say but we cannot proceed with this one.');
  1899.     exit;
  1900.   end;
  1901.   if length(s)>4 then begin
  1902.     writeln;
  1903.     writeln;
  1904.     writeln('The number you entered is longer than 4 digits, and the results of');
  1905.     writeln('the evaluation will not fit on the screen. Please specify a file');
  1906.     writeln('where we can write the results to.');
  1907.     writeln;
  1908.     write('Filename: ');
  1909.     fn:='results.txt';
  1910.     edituc(fn,12);
  1911.     writeln;
  1912.     writeln;
  1913.     write('Processing...');
  1914.     numscan(s,fn);
  1915.     writeln('Done.');
  1916.     writeln;
  1917.   end else begin
  1918.     clrscr;
  1919.     numscan(s,'');
  1920.     textattr:=colors.high;
  1921.     gotoxy(1,18);
  1922.   end;
  1923. end;
  1924.  
  1925. begin
  1926.   openbox(10,1,1,80,3,false,true,false);
  1927.   openbox(11,1,4,80,25,false,true,false);
  1928.   vmemwrite(3,2,'PHONE WORD - Word to Number converter, Number to word finder, for USA fones',colors.win_text_high);
  1929.   textattr:=colors.high;
  1930.   window(3,5,78,24);
  1931.   clrscr;
  1932.   repeat
  1933.     writeln;
  1934.     write('(W)ord to Number, (F)ind words for number, (Q)uit ?');
  1935.     repeat choice:=upcase(readkey) until choice in ['W','F','Q'];
  1936.     case choice of
  1937.       'W' :wordtonumber;
  1938.       'F' :findwordsfornumber;
  1939.       'Q' :writeln(' Quit!');
  1940.     end;
  1941.   until choice='Q';
  1942.   closebox(11);
  1943.   closebox(10);
  1944.   window(1,1,80,25);
  1945.   setcursorsize($32,$32);
  1946. end;
  1947.  
  1948. procedure phreakoutmenu;
  1949. var choice:Byte;
  1950. begin
  1951.   choice:=1;
  1952.   repeat
  1953.     menuitem[1]:='Action Mode';
  1954.     menuitem[2]:='Scanner';
  1955.     menuitem[3]:='Red Box';
  1956.     menuitem[4]:='CardTalker';
  1957.     menuitem[5]:='FreqTester';
  1958.     menuitem[6]:='Card Checker';
  1959.     menuitem[7]:='PhoneWord';
  1960.     menuinfo[1]:='Go to the main dialer program (command line option /A)';
  1961.     menuinfo[2]:='Scan routings / PBXes / phone numbers';
  1962.     menuinfo[3]:='Red Box payphone coin signalling - for our ameriKKKan friends';
  1963.     menuinfo[4]:='Calling Card Talker, if you are too lazy to talk on your own...';
  1964.     menuinfo[5]:='Frequency Tester - For freq finding purposes';
  1965.     menuinfo[6]:='Calling Card checker to check big amounts of Calling Cards';
  1966.     menuinfo[7]:='TouchTone Character & Number Finder, try it its really neat!';
  1967.     menucount:=7;
  1968.     choice:=menu(35,4,choice,true,true,true,true,true);
  1969.     case choice of
  1970.       1: phreakout;
  1971.       2: scanmode;
  1972.       3: redboxit;
  1973.       4: cardtalker;
  1974.       5: freqtester;
  1975.       6: cardchecker;
  1976.       7: foneword;
  1977.     end;
  1978.   until choice=0;
  1979. end;
  1980. end.
  1981.