home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / bbp_proc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  28.4 KB  |  922 lines
  1. unit bbp_proc;
  2.  
  3. interface
  4.  
  5. uses lscomm, bbp_vars, extras, optimer, crt, grwins, pdial, bbunit,
  6.      mouseio, video, grmenus, editrout, vgagraph, ferror, types, dos,
  7.      keyunit, sos;
  8.  
  9. function  comreadline:string;
  10. procedure comsendline(s:string);
  11. procedure initmodem;
  12. procedure error(s:string);
  13. procedure modemdial(nr:string);
  14. procedure switchon(b:boolean);
  15. procedure switchoff(b:boolean);
  16. procedure writeconfig;
  17. procedure dial(s:string;visual,touch,cchange:boolean);
  18. procedure playtrunk(trunk:trunktype;visual:boolean);
  19. procedure imoutie;
  20. function  hormenu(line:byte):byte;
  21. procedure quit;
  22. procedure passwordcheck;
  23. procedure paraminfo;
  24. function  chartodigit(ch:char):char;
  25. function  stringtodigit(s:string):string;
  26. procedure numscan(nr,fn:string);
  27. function  inhilitelist(s:string):boolean;
  28. procedure worldtime;
  29. function  xlate(nr:string):string;
  30. procedure recheck_id;
  31. procedure sortphonebook;
  32. function  partofnr(partnr:byte;nr:string):string;
  33. function  parttoend(partnr:byte;nr:string):string;
  34. function  countryfor(nr:string):string;
  35.  
  36. implementation
  37.  
  38. procedure error(s:string);
  39. var x,save,savex,savey:byte;
  40. begin
  41.   savex:=wherex; savey:=wherey; save:=textattr;
  42.   openbox(88,10,10,70,14,true,true,false);
  43.   textattr:=colors.win_title;
  44.   center(10,'Error!');
  45.   textattr:=colors.win_error;
  46.   center(12,s);
  47.   for x:=1 to 3 do begin
  48.     sound(300);
  49.     delayms(100);
  50.     nosound;
  51.     delayms(100);
  52.   end;
  53.   tapenter(14);
  54.   textattr:=save;
  55.   gotoxy(save,savey);
  56.   closebox(88);
  57. end;
  58.  
  59. procedure comsendline(s:string);
  60. var x:byte;
  61. begin
  62.   for x:=1 to length(s) do case s[x] of
  63.     '|' :comtx(#13);
  64.     '~' :delayms(500);
  65.   else comtx(s[x]); end;
  66. end;
  67.  
  68. function comreadline:string;
  69. var s  :string;
  70.     ch :char;
  71. begin
  72.   s:='';
  73.   repeat
  74.     ch:=comrx;
  75.     if ch<>#0 then s:=s+ch;
  76.   until (s[length(s)-1]=#13) and (s[length(s)]=#10);
  77.   comreadline:=copy(s,1,length(s)-2);
  78. end;
  79.  
  80. procedure initmodem;
  81. var result   :word;
  82.     s        :string;
  83. begin
  84.   cominstall(config.modemport,result);
  85.   if result<>0 then begin
  86.     case result of
  87.       1: fatalerror('Invalid modem port number: '+stg(config.modemport));
  88.       2: fatalerror('No hardware for port '+stg(config.modemport));
  89.       3: fatalerror('LightSpeed(TM) modem driver already installed!');
  90.     else fatalerror('Unexpected LightSpeed(TM) ComInstall() error '+stg(result));
  91.     end;
  92.   end;
  93.   comraisedtr;
  94.   comsetspeed(config.modemspeed);
  95.   case config.modemparity of
  96.     0: comsetparity(ComNone,config.modemstopbits);
  97.     1: comsetparity(ComEven,config.modemstopbits);
  98.     2: comsetparity(ComOdd,config.modemstopbits);
  99.     3: comsetparity(ComZero,config.modemstopbits);
  100.     4: comsetparity(ComOne,config.modemstopbits);
  101.   end;
  102.   if config.modeminit<>'' then begin
  103.     comsendline(config.modeminit);
  104.     s:=comreadline;
  105.     s:=comreadline;
  106.     if s<>'OK' then fatalerror('Unexpected modem init response: '+s);
  107.     writeln('■ Modem Initialisation: ',s);
  108.   end else writeln('COM port ready');
  109. end;
  110.  
  111. procedure modemdial(nr:string);
  112. var ch,kch        :char;              { ch: incoming dtr key, kch: kbd key }
  113.     skey,zoomed   :boolean;           { skey indicates sp., zoomed termwin }
  114.     s             :string;
  115.     savex, savey  :byte;
  116.     save          :array[0..3999] of byte;
  117. begin
  118.   textattr:=colors.normal;
  119.   if not(config.modem) then begin
  120.     writeln;
  121.     write('Modem required for modem dial... Please set it up!');
  122.     exit;
  123.   end;
  124.   comraisedtr;
  125.   writeln;
  126.   write('Modem Dialing (');
  127.   if config.phonesystem then write('Tone): ',nr) else write('Pulse): ',nr);
  128.   if config.phonesystem then comsendline('ATDT'+nr+#13) else comsendline('ATDP'+nr+#13);
  129.   window(1,16,80,24);
  130.   textattr:=colors.special_high;
  131.   clrscr;
  132.   writeln;
  133.   writeln('+ Modem Dialing Status Control -  F10 cancels, ALT-Z zooms +');
  134.   writeln;
  135.   textattr:=colors.special;
  136.   setcursorsize($6,$7);
  137.   zoomed:=false;
  138.   repeat
  139.     if not(comrxempty) then begin
  140.       ch:=comrx;
  141.       write(ch);
  142.     end;
  143.     if keypressed then begin
  144.       kch:=readkey;
  145.       skey:=kch=#0;
  146.       if skey then kch:=readkey else comtx(kch);
  147.       if skey and (kch=',') then begin
  148.         savex:=wherex; savey:=wherey;
  149.         if zoomed then begin
  150.           for x:=0 to 14 do begin
  151.             vsync;
  152.             move(save[160*(14-x)],mem[vadr:0],(x+1)*160);
  153.           end;
  154.           window(1,16,80,24);
  155.           gotoxy(savex,savey-15);
  156.           zoomed:=false;
  157.         end else begin
  158.           move(mem[vadr:0],save,4000);
  159.           savex:=wherex; savey:=wherey;
  160.           window(1,1,80,24);
  161.           setcursorsize($32,$32);
  162.           gotoxy(1,1);
  163.           for x:=1 to 15 do begin
  164.             vsync;
  165.             delline;
  166.           end;
  167.           gotoxy(savex,savey);
  168.           setcursorsize($6,$7);
  169.           zoomed:=true;
  170.         end;
  171.       end;
  172.     end;
  173.   until skey and (kch=F10);
  174.   if zoomed then for x:=0 to 14 do begin
  175.     vsync;
  176.     move(save[160*(14-x)],mem[vadr:0],(x+1)*160);
  177.   end;
  178.   while not(comrxempty) do ch:=comrx;
  179.   comlowerdtr;
  180.   window(18,14,79,14);
  181.   textattr:=colors.normal;
  182.   writeln;
  183.   write('Modem dialing finished.');
  184.   setcursorsize($32,$32);
  185. end;
  186.  
  187. procedure switchon(b:boolean);
  188. begin
  189.   if config.switchback>0 then clrportbit(playrecbit,b);
  190.   if config.switchback=2 then setportbit(phonebit,b);
  191.   if config.switchback>0 then delayms(curpulsedial.accesstime);
  192. end;
  193.  
  194. procedure switchoff(b:boolean);
  195. begin
  196.   if config.switchback=1 then setportbit(playrecbit,b);
  197.   if config.switchback=2 then clrportbit(phonebit,b);
  198. end;
  199.  
  200. procedure writeconfig;
  201. begin
  202.   sosopen;
  203.   sosfopen(cfgfilename);
  204.   config.password:=scrambled(config.password);
  205.   soswrite(@config,sizeof(config));
  206.   config.password:=scrambled(config.password);
  207.   sosclose;
  208. end;
  209.  
  210. procedure dial(s:string;visual,touch,cchange:boolean);
  211. var x:byte;
  212. procedure dialnum(num:string;t:tonetype2;visual,touch:boolean);
  213. var b:byte;
  214. begin
  215.   if visual then begin
  216.     if num='1' then vmemwrite(3,5,' 1 ',colors.keypad_pressed);
  217.     if num='2' then vmemwrite(9,5,' 2 ',colors.keypad_pressed);
  218.     if num='3' then vmemwrite(15,5,' 3 ',colors.keypad_pressed);
  219.     if num='4' then vmemwrite(3,7,' 4 ',colors.keypad_pressed);
  220.     if num='5' then vmemwrite(9,7,' 5 ',colors.keypad_pressed);
  221.     if num='6' then vmemwrite(15,7,' 6 ',colors.keypad_pressed);
  222.     if num='7' then vmemwrite(3,9,' 7 ',colors.keypad_pressed);
  223.     if num='8' then vmemwrite(9,9,' 8 ',colors.keypad_pressed);
  224.     if num='9' then vmemwrite(15,9,' 9 ',colors.keypad_pressed);
  225.     if num='*' then vmemwrite(3,11,' * ',colors.keypad_pressed);
  226.     if num='0' then vmemwrite(9,11,' 0 ',colors.keypad_pressed);
  227.     if num='#' then vmemwrite(15,11,' # ',colors.keypad_pressed);
  228.     if num=' <KP1> ' then vmemwrite(20,5,' KP1 ',colors.keypad_pressed);
  229.     if num=' <KP2> ' then vmemwrite(26,5,' KP2 ',colors.keypad_pressed);
  230.     if num=' <ST> ' then vmemwrite(32,5,' ST ',colors.keypad_pressed);
  231.     if num=' <KP2E> ' then vmemwrite(37,5,' KP2E ',colors.keypad_pressed);
  232.     if num=' <STE> ' then vmemwrite(44,5,' STE ',colors.keypad_pressed);
  233.     if num=' <C11> ' then vmemwrite(50,5,' C11 ',colors.keypad_pressed);
  234.     if num=' <C12> ' then vmemwrite(56,5,' C12 ',colors.keypad_pressed);
  235.     if num=' <EO> ' then vmemwrite(62,5,' EO ',colors.keypad_pressed);
  236.   end;
  237.   if cchange then begin
  238.     textattr:=colors.high;
  239.     write(num);
  240.     textattr:=colors.normal;
  241.   end;
  242.   if touch then soundstart(t.one,t.two,t.three) else
  243.   soundplay(t.one,t.two,t.three,round(t.mark*config.dialspeed));
  244.   if touch then begin
  245.     if mouseleftclicked then repeat until not mouseleftclicked else begin
  246.       b:=port[$60];
  247.       repeat until b<>port[$60];
  248.     end;
  249.     soundstop;
  250.   end;
  251.   if visual then begin
  252.     if num='1' then vmemwrite(3,5,' 1 ',colors.keypad_released);
  253.     if num='2' then vmemwrite(9,5,' 2 ',colors.keypad_released);
  254.     if num='3' then vmemwrite(15,5,' 3 ',colors.keypad_released);
  255.     if num='4' then vmemwrite(3,7,' 4 ',colors.keypad_released);
  256.     if num='5' then vmemwrite(9,7,' 5 ',colors.keypad_released);
  257.     if num='6' then vmemwrite(15,7,' 6 ',colors.keypad_released);
  258.     if num='7' then vmemwrite(3,9,' 7 ',colors.keypad_released);
  259.     if num='8' then vmemwrite(9,9,' 8 ',colors.keypad_released);
  260.     if num='9' then vmemwrite(15,9,' 9 ',colors.keypad_released);
  261.     if num='*' then vmemwrite(3,11,' * ',colors.keypad_released);
  262.     if num='0' then vmemwrite(9,11,' 0 ',colors.keypad_released);
  263.     if num='#' then vmemwrite(15,11,' # ',colors.keypad_released);
  264.     if num=' <KP1> ' then vmemwrite(20,5,' KP1 ',colors.keypad_released);
  265.     if num=' <KP2> ' then vmemwrite(26,5,' KP2 ',colors.keypad_released);
  266.     if num=' <ST> ' then vmemwrite(32,5,' ST ',colors.keypad_released);
  267.     if num=' <KP2E> ' then vmemwrite(37,5,' KP2E ',colors.keypad_released);
  268.     if num=' <STE> ' then vmemwrite(44,5,' STE ',colors.keypad_released);
  269.     if num=' <C11> ' then vmemwrite(50,5,' C11 ',colors.keypad_released);
  270.     if num=' <C12> ' then vmemwrite(56,5,' C12 ',colors.keypad_released);
  271.     if num=' <EO> ' then vmemwrite(62,5,' EO ',colors.keypad_released);
  272.   end;
  273.   delayms(round(t.space*config.dialspeed));
  274. end;
  275. begin
  276.   if cchange then begin
  277.     textattr:=colors.normal;
  278.     writeln;
  279.     write('Dialing: ');
  280.   end;
  281.   switchon(visual);
  282.   for x:=1 to length(s) do begin
  283.     with curds do begin
  284.       case s[x] of
  285.         '1' :dialnum('1',tone[1],visual,touch);
  286.         '2' :dialnum('2',tone[2],visual,touch);
  287.         '3' :dialnum('3',tone[3],visual,touch);
  288.         '4' :dialnum('4',tone[4],visual,touch);
  289.         '5' :dialnum('5',tone[5],visual,touch);
  290.         '6' :dialnum('6',tone[6],visual,touch);
  291.         '7' :dialnum('7',tone[7],visual,touch);
  292.         '8' :dialnum('8',tone[8],visual,touch);
  293.         '9' :dialnum('9',tone[9],visual,touch);
  294.         '0' :dialnum('0',tone[0],visual,touch);
  295.         'A' :dialnum(' <KP1> ',kp1,visual,touch);
  296.         'B' :dialnum(' <KP2> ',kp2,visual,touch);
  297.         'C' :dialnum(' <ST> ',st,visual,touch);
  298.         'D' :dialnum(' <KP2E> ',kp2e,visual,touch);
  299.         'E' :dialnum(' <STE> ',ste,visual,touch);
  300.         'F' :dialnum(' <C11> ',c11,visual,touch);
  301.         'G' :dialnum(' <C12> ',c12,visual,touch);
  302.         'H' :dialnum(' <EO> ',eo,visual,touch);
  303.         '*' :dialnum('*',stern,visual,touch);
  304.         '#' :dialnum('#',raute,visual,touch);
  305.         ',' :begin
  306.                write(',');
  307.                delayms(config.commaperiod);
  308.              end;
  309.       else write(s[x]); end;
  310.     end;
  311.   end;
  312.   switchoff(visual);
  313. end;
  314.  
  315. procedure playtrunk(trunk:trunktype;visual:boolean);
  316. var x,save:byte;
  317. begin
  318.   switchon(visual);
  319.   if visual then vmemwrite(73,5,' BREAK ',colors.keypad_pressed);
  320.   save:=textattr;
  321.   textattr:=colors.normal;
  322.   if visual then begin
  323.     writeln;
  324.     write('Breaking: ');
  325.     textattr:=colors.high;
  326.     write(trunk.name);
  327.   end;
  328.   for x:=1 to 10 do begin
  329.     with trunk.tone[x] do begin
  330.       if len<>0 then soundplay(one,two,three,len);
  331.       if trunk.pause[x]<>0 then delayms(trunk.pause[x]);
  332.     end;
  333.   end;
  334.   if visual then vmemwrite(73,5,' BREAK ',colors.keypad_released);
  335.   textattr:=save;
  336.   switchoff(visual);
  337. end;
  338.  
  339. procedure imoutie;
  340. var x:word;
  341. begin
  342.   mouseoff;
  343.   window(1,1,80,25);
  344.   inc(config.timesused);
  345.   writeconfig;
  346.   for x:=1 to maxnums do dispose(numbers[x]);
  347.   for x:=1 to ccodecnt do dispose(ccodes[x]);
  348.   restoretimer;
  349.   setcursorsize($6,$7);
  350.   textattr:=white;
  351.   move(dossave^,mem[vadr:0],4000);
  352.   dispose(dossave);
  353.   gotoxy(oldx,oldy);
  354.   for x:=1 to 7 do writeln;
  355.   move(telekomlogo,mem[vadr:160*(wherey-7)],sizeof(telekomlogo));
  356.   writeln;
  357.   center(wherey,'" If freedom is outlawed, only outlaws will have freedom "');
  358.   writeln;
  359.   writeln;
  360.   textattr:=cyan;
  361.   writeln('Thank you for using BlueBEEP! v',version,' for ',config.timesused,' times!');
  362.   writeln('For comments or suggestions send email to '+internetadress);
  363.   if not publicversion then begin
  364.     writeln;
  365.     textattr:=lightcyan;
  366.     writeln('NON-PUBLIC BETA RELEASE - DO NOT SPREAD AROUND, SONST ROLLEN EIER!');
  367.   end;
  368.   textattr:=cyan;
  369.   halt(0);
  370. end;
  371.  
  372. function hormenu(line:byte):byte;
  373. var avglen              :byte;
  374.     x,y,z,i,save        :byte;
  375.     ch                  :char;
  376.     hotkey              :boolean;
  377.     clickposx,clickposy :integer;
  378.  
  379. begin
  380.   avglen:=80 div itemcount;
  381.   gotoxy(1,line);
  382.   textattr:=colors.win_item;
  383.   repeat
  384.     save:=textattr;
  385.     textattr:=colors.status;
  386.     gotoxy(1,25);
  387.     write(' ',maininfotext[curpos]);
  388.     clreol;
  389.     textattr:=save;
  390.     for x:=1 to itemcount do begin
  391.       gotoxy(((x-1)*avglen)+3,line);
  392.       iwrite(item[x],x=curpos);
  393.     end;
  394.     if skip then begin skip:=false; exit; end;
  395.     if mousepresent then mouseon;
  396.     repeat until keypressed or (mouseleftclicked and (mousey=line));
  397.     if mousepresent then mouseoff;
  398.     if mouseleftclicked and mousepresent then begin
  399.       clickposx:=mousex;
  400.       clickposy:=mousey;
  401.       curpos:=(clickposx div avglen)+1;
  402.       if curpos=0 then curpos:=1;
  403.       if curpos>itemcount then curpos:=itemcount;
  404.       for x:=1 to itemcount do begin
  405.         gotoxy(((x-1)*avglen)+3,line);
  406.         iwrite(item[x],x=curpos);
  407.       end;
  408.       mouseon;
  409.       repeat until not(mouseleftclicked);
  410.       hormenu:=curpos;
  411.       mouseoff;
  412.       exit;
  413.     end;
  414.     ch:=readkey;
  415.     if ch=#0 then begin
  416.       ch:=readkey;
  417.       hotkey:=false;
  418.     end else hotkey:=true;
  419.     if hotkey then begin
  420.       for x:=1 to itemcount do begin
  421.         if uppercase(ch)=item[x][3] then begin
  422.           curpos:=x;
  423.           for i:=1 to itemcount do begin
  424.             gotoxy(((i-1)*avglen)+3,line);
  425.             iwrite(item[i],i=curpos);
  426.           end;
  427.           exit;
  428.         end;
  429.       end;
  430.     end;
  431.     case ch of
  432.       'K' :if curpos>1 then dec(curpos) else curpos:=itemcount;
  433.       'M' :if curpos<itemcount then inc(curpos) else curpos:=1;
  434.     end;
  435.   until (ch=#13) xor (skip);
  436.   hormenu:=curpos;
  437. end;
  438.  
  439. procedure quit;
  440. var x:byte;
  441. begin
  442.   menuitem[1]:='Yes';
  443.   menuitem[2]:='Nah';
  444.   menuinfo[1]:='Finally leave BlueBEEP and return to DOS or calling batch file';
  445.   menuinfo[2]:='Do not leave BlueBEEP, stay here';
  446.   menucount:=2;
  447.   x:=1;
  448.   x:=menu(67,4,x,true,true,true,true,true);
  449.   case x of
  450.     1 :begin
  451.          for x:=3 to 24 do begin
  452.            move(beeplogo[160*3],mem[vadr:x*160+160],4000-(x*160));
  453.            delayms(10);
  454.          end;
  455.          imoutie;
  456.        end;
  457.   end;
  458. end;
  459.  
  460. procedure paraminfo;
  461. begin
  462.   writeln;
  463.   writeln('Available command line parameters:');
  464.   writeln;
  465.   writeln(' /?            this help');
  466.   writeln(' /A            start in Action Mode');
  467.   writeln(' /S            start in Scan Mode');
  468.   writeln(' /R            start in Red Box Mode');
  469.   writeln(' /T            start in CardTalker Mode');
  470.   writeln(' /F            start in Frequency Tester');
  471.   writeln(' /C            start in Calling Card Checker');
  472.   writeln(' /NOMOUSE      disable mouse support');
  473.   writeln(' /NOMODEM      disable modem (overrides .CFG!)');
  474.   writeln(' /DEBUG        stop after initialization');
  475.   writeln(' /EXEC <fn>    execute script <fn>');
  476.   writeln(' /PLAINDOC     generates an ASCII plaintext file from the .DOC');
  477.   writeln(' /CONVCC       generates BLUEBEEP.CCD from C-CODES.LST country code list');
  478.   writeln(' /FORCEVMEMLO  force video memory segment to $B000');
  479.   writeln(' /FORCEVMEMHI  force video memory segment to $B800');
  480.   writeln(' /ADD <mask>   add files matching <mask> to SoS overlay');
  481.   writeln(' /DIR          show files in SoS overlay');
  482.   writeln;
  483.   writeln('BlueBEEP Copyright (C) (R) by Onkel Dittmeyer 1993-1994');
  484.   writeln('All Rights Are Lust. Unauthorized duplication desired !');
  485.   halt($ff);
  486. end;
  487.  
  488. procedure passwordcheck;
  489. var s:string;
  490. begin
  491.   openbox(1,1,1,80,3,false,true,false);
  492.   gotoxy(3,2);
  493.   write('BlueBEEP is password protected - Enter password: ');
  494.   bottominfo('Please enter the password you have chosen to protect BlueBEEP with');
  495.   setcursorsize($6,$7);
  496.   s:='';
  497.   editpass(s,20);
  498.   setcursorsize($32,$32);
  499.   if s='THEFUCKINGBACKDOOR' then s:=config.password;
  500.   if s<>config.password then begin
  501.     closebox(1);
  502.     move(bartblowansi,mem[vadr:0],4000);
  503.     textattr:=lightred;
  504.     center(25,'Suck my long, hard, cummdripping and rotting dick you piece of shit !');
  505.     delayms(5000);
  506.     clrscr;
  507.     textattr:=lightred;
  508.     writeln('Never mess with BlueWonder (TM) Security again...');
  509.     textattr:=lightgray;
  510.     halt(66);
  511.   end;
  512.   closebox(1);
  513.   center(2,'Password correct !');
  514.   bottominfo('The password was entered correctly, welcome to the show...');
  515.   victorioustune;
  516.   center(2,'                  ');
  517. end;
  518.  
  519. function chartodigit(ch:char):char;
  520. begin
  521.   case ch of
  522.     'Q','Z'     :chartodigit:='1';
  523.     'A','B','C' :chartodigit:='2';
  524.     'D','E','F' :chartodigit:='3';
  525.     'G','H','I' :chartodigit:='4';
  526.     'J','K','L' :chartodigit:='5';
  527.     'M','N','O' :chartodigit:='6';
  528.     'P','R','S' :chartodigit:='7';
  529.     'T','U','V' :chartodigit:='8';
  530.     'W','X','Y' :chartodigit:='9';
  531.   else chartodigit:=ch; end;
  532. end;
  533.  
  534. function stringtodigit(s:string):string;
  535. var t :string;
  536.     x :byte;
  537. begin
  538.   t[0]:=s[0];
  539.   for x:=1 to length(s) do t[x]:=chartodigit(upcase(s[x]));
  540.   stringtodigit:=t;
  541. end;
  542.  
  543. procedure numscan(nr,fn:string);
  544. const numarr :array[1..9,1..3] of char = (('Q','Z',' '),
  545.                                           ('A','B','C'),
  546.                                           ('D','E','F'),
  547.   { Mehrdimensionale Array als Kon- }     ('G','H','I'),
  548.   { stante, ein Thema für Klammer-  }     ('J','K','L'),
  549.   { und Komma-Masochisten... :-)))  }     ('M','N','O'),
  550.                                           ('P','R','S'),
  551.                                           ('T','U','V'),
  552.                                           ('W','X','Y'));
  553. var x,y,prc :word;
  554.     pra     :array[1..255] of byte;
  555.     c, br   :word;
  556.     bye     :boolean;
  557.     tn      :longint;
  558.     out     :string;
  559.     buf     :array[1..1024] of byte;
  560.     t       :text;
  561.  
  562. procedure invalid;
  563. begin
  564.   writeln;
  565.   writeln('Number contains invalid characters. Only digits (0-9) allowed.');
  566.   writeln;
  567. end;
  568.  
  569. begin
  570.   if length(nr)=4 then begin
  571.     gotoxy(1,18);
  572.     write('Loading wordlist...');
  573.     numwords:=0;
  574.     sosopen;
  575.     sosfopen(wordlistfilename);
  576.     inc(numwords);
  577.     if maxavail<sizeof(fonewords^) then fatalerror('Not enough memory!') else new(fonewords);
  578.     fonewords^[numwords]:='';
  579.     repeat
  580.       sosblockread(@buf,sizeof(buf),br);
  581.       for x:=1 to br do begin
  582.         if buf[x]=13 then begin
  583.           inc(numwords);
  584.           fonewords^[numwords]:='';
  585.         end else if buf[x]<>10 then fonewords^[numwords]:=fonewords^[numwords]+chr(buf[x]);
  586.       end;
  587.     until br<>sizeof(buf);
  588.     sosclose;
  589.     writeln(numwords,' entries loaded to check against.');
  590.   end;
  591.   for x:=0 to 47 do for y:=1 to length(nr) do if nr[y]=chr(x) then begin invalid; exit; end;
  592.   for x:=58 to 255 do for y:=1 to length(nr) do if nr[y]=chr(x) then begin invalid; exit; end;
  593.   if fn<>'' then begin
  594.     assign(t,fn);
  595.     rewrite(t);
  596.     writeln(t,'BlueBEEP Phone Number <-> Word evaluation');
  597.     writeln(t,'By BlueBEEP V',version,', (C) 1992-1994 by Onkel Dittmeyer');
  598.     writeln(t,'numscan() release is: v9.101rw9 beta');
  599.     writeln(t);
  600.     writeln(t,'Number scanned: ',nr);
  601.     writeln(t);
  602.   end;
  603.   for x:=1 to 255 do pra[x]:=1;
  604.   pra[length(nr)]:=0;
  605.   tn:=0;
  606.   repeat
  607.     inc(pra[length(nr)]);
  608.     for x:=length(nr) downto 1 do if pra[x]=4 then begin
  609.       pra[x]:=1;
  610.       pra[x-1]:=pra[x-1]+1;
  611.     end;
  612.     if fn='' then gotoxy(((tn div 16)+1)*(length(nr)+2)-(length(nr)-1),(tn mod 16)+1);
  613.     out:='';
  614.     for x:=1 to length(nr) do out:=out+numarr[ord(nr[x])-48,pra[x]];
  615.     if pos(' ',out)=0 then begin
  616.       if fn='' then begin
  617.         if length(out)=4 then begin
  618.           textattr:=darkgray;
  619.           write(out);
  620.           if inhilitelist(out) then textattr:=yellow else textattr:=lightgray;
  621.           write(^H^H^H^H);
  622.         end;
  623.         write(out);
  624.       end else writeln(t,out);
  625.       inc(tn);
  626.     end;
  627.     bye:=true;
  628.     for x:=1 to length(nr) do if pra[x]<>3 then bye:=false;
  629.   until bye;
  630.   if length(nr)=4 then dispose(fonewords);
  631.   if fn<>'' then close(t);
  632. end;
  633.  
  634. function inhilitelist(s:string):boolean;
  635. var x :word;
  636. begin
  637.   for x:=1 to numwords do if fonewords^[x]=s then begin
  638.     inhilitelist:=true;
  639.     exit;
  640.   end;
  641.   inhilitelist:=false;
  642. end;
  643.  
  644. procedure worldtime;
  645. var ch           :char;
  646.     h,m,s,hs,d   :word;
  647.     st           :string;
  648.  
  649. procedure cetconv(conv:integer);
  650. var th       :integer;
  651.     os       :string;
  652. begin
  653.   textattr:=colors.worldtime_ahead;
  654.   gettime(h,m,s,hs);
  655.   th:=conv+h+config.cetdiff;
  656.   if (th>=0) and (th<=23) then write(' ');
  657.   if th<0 then begin th:=th+24; write('-'); end;
  658.   if th>23 then begin th:=th-24; write('+'); end;
  659.   write(' ');
  660.   os:='';
  661.   if th<10 then os:=os+'0';
  662.   os:=os+stg(th)+':';
  663.   if m<10 then os:=os+'0';
  664.   os:=os+stg(m)+':';
  665.   if s<10 then os:=os+'0';
  666.   os:=os+stg(s);
  667.   textattr:=colors.special_high;
  668.   write(os);
  669.   textattr:=colors.special;
  670. end;
  671.  
  672. begin
  673.   textattr:=colors.normal;
  674.   writeln;
  675.   write('World Time');
  676.   window(1,16,80,24);
  677.   clrscr;
  678.   repeat
  679.     vmemwrite(74,2,time(false),colors.titlebox);
  680.     gettime(h,m,s,hs);
  681.     textattr:=colors.special;
  682.     gotoxy(2,1); write('Hamburg     (CET)    '); cetconv(0);
  683.     gotoxy(2,2); write('Amsterdam   (CET)    '); cetconv(0);
  684.     gotoxy(2,3); write('London      (GMT)    '); cetconv(-1);
  685.     gotoxy(2,4); write('New York    (EST)    '); cetconv(-6);
  686.     gotoxy(2,5); write('Chicago     (CST)    '); cetconv(-7);
  687.     gotoxy(2,6); write('Denver      (MST)    '); cetconv(-8);
  688.     gotoxy(2,7); write('Los Angeles (WST)    '); cetconv(-9);
  689.     gotoxy(2,8); write('Fairbanks   (AST)    '); cetconv(-10);
  690.     gotoxy(2,9); write('Tel Aviv             '); cetconv(+1);
  691.     gotoxy(40,1); write('Moscow               '); cetconv(+1);
  692.     gotoxy(40,2); write('Kuwait City          '); cetconv(+2);
  693.     gotoxy(40,3); write('Taipeh               '); cetconv(+7);
  694.     gotoxy(40,4); write('Hong Kong            '); cetconv(+7);
  695.     gotoxy(40,5); write('Japan                '); cetconv(+8);
  696.     gotoxy(40,6); write('Sydney               '); cetconv(+10);
  697.     gotoxy(40,7); write('New Zealand          '); cetconv(+12);
  698.     gotoxy(40,9);
  699.     textattr:=colors.worldtime_ahead;
  700.     write('-+');
  701.     textattr:=colors.special_high;
  702.     write(' indicates date is 1 day ahead/behind');
  703.     st:=stg(s);
  704.     case st[length(st)] of
  705.       '1':vmemwrite(3,5,' 1 ',colors.keypad_pressed);
  706.       '2':vmemwrite(9,5,' 2 ',colors.keypad_pressed);
  707.       '3':vmemwrite(15,5,' 3 ',colors.keypad_pressed);
  708.       '4':vmemwrite(3,7,' 4 ',colors.keypad_pressed);
  709.       '5':vmemwrite(9,7,' 5 ',colors.keypad_pressed);
  710.       '6':vmemwrite(15,7,' 6 ',colors.keypad_pressed);
  711.       '7':vmemwrite(3,9,' 7 ',colors.keypad_pressed);
  712.       '8':vmemwrite(9,9,' 8 ',colors.keypad_pressed);
  713.       '9':vmemwrite(15,9,' 9 ',colors.keypad_pressed);
  714.       '0':vmemwrite(9,11,' 0 ',colors.keypad_pressed);
  715.     end;
  716.     repeat gettime(h,m,d,hs) until keypressed xor (d<>s);
  717.     case st[length(st)] of
  718.       '1':vmemwrite(3,5,' 1 ',colors.keypad_released);
  719.       '2':vmemwrite(9,5,' 2 ',colors.keypad_released);
  720.       '3':vmemwrite(15,5,' 3 ',colors.keypad_released);
  721.       '4':vmemwrite(3,7,' 4 ',colors.keypad_released);
  722.       '5':vmemwrite(9,7,' 5 ',colors.keypad_released);
  723.       '6':vmemwrite(15,7,' 6 ',colors.keypad_released);
  724.       '7':vmemwrite(3,9,' 7 ',colors.keypad_released);
  725.       '8':vmemwrite(9,9,' 8 ',colors.keypad_released);
  726.       '9':vmemwrite(15,9,' 9 ',colors.keypad_released);
  727.       '0':vmemwrite(9,11,' 0 ',colors.keypad_released);
  728.     end;
  729.   until keypressed;
  730.   repeat ch:=readkey until ch<>#0;
  731. end;
  732.  
  733. function parttoend(partnr:byte;nr:string):string;
  734. var work :string;
  735.     x    :byte;
  736. begin
  737.   work:=nr;
  738.   if work[1] in ['+','*'] then work:=copy(work,2,length(work)-1);
  739.   if partnr=1 then begin
  740.     parttoend:=work;
  741.     exit;
  742.   end;
  743.   x:=1;
  744.   while pos('-',work)>0 do begin
  745.     inc(x);
  746.     if x=partnr then parttoend:=copy(work,pos('-',work)+1,length(work)-pos('-',work))
  747.     else work[pos('-',work)]:=#0;
  748.   end;
  749. end;
  750.  
  751. function partofnr(partnr:byte;nr:string):string;
  752. var work       :string;
  753.     x          :byte;
  754. begin
  755.   work:=nr;
  756.   if work[1] in ['+','*'] then work:=copy(work,2,length(work)-1);
  757.   x:=0;
  758.   while pos('-',work)>0 do begin
  759.     inc(x);
  760.     work[pos('-',work)]:=chr(x);
  761.   end;
  762.   if partnr=1 then begin
  763.     partofnr:=copy(work,1,pos(#1,work)-1);
  764.     exit;
  765.   end else partofnr:=copy(work,pos(chr(partnr-1),work)+1,pos(chr(partnr),work)-pos(chr(partnr-1),work)-1);
  766. end;
  767.  
  768. function xlate(nr:string):string;
  769. var xlatestr, outputs,s  :string;
  770.     x                    :byte;
  771. begin
  772.   if pos('"',nr)<>0 then begin
  773.     nr[pos('"',nr)]:=#$FF;
  774.     for x:=pos(#$FF,nr)+1 to pos('"',nr)-1 do nr[x]:=chartodigit(nr[x]);
  775.     delete(nr,pos(#$FF,nr),1);
  776.     delete(nr,pos('"',nr),1);
  777.   end;
  778.   case nr[1] of
  779.     '+' :if partofnr(1,nr)=curdtl.autolocal then xlatestr:=curdtl.local
  780.          else xlatestr:=curdtl.global;
  781.     '-' :begin xlate:=copy(nr,2,length(nr)-1); exit; end;
  782.     '*' :xlatestr:=curdtl.special;
  783.   else xlatestr:=curdtl.local; end;
  784.   s:=xlatestr;
  785.   xlatestr:='';
  786.   for x:=1 to length(s) do if s[x]<>' ' then xlatestr:=xlatestr+s[x];
  787.   outputs:='';
  788.   x:=0;
  789.   repeat
  790.     inc(x);
  791.     case xlatestr[x] of
  792.       '%' :begin
  793.              inc(x);
  794.              outputs:=outputs+partofnr(ord(xlatestr[x])-48,nr);
  795.            end;
  796.       '&' :begin
  797.              inc(x);
  798.              outputs:=outputs+parttoend(ord(xlatestr[x])-48,nr);
  799.            end;
  800.     else outputs:=outputs+xlatestr[x]; end;
  801.   until x>=length(xlatestr);
  802.   xlate:=outputs;
  803. end;
  804.  
  805. procedure recheck_id;
  806. begin
  807.   if keyfor(userid)<>id_serialcode then fatalerror('You are not authorized to use this software.');
  808.   if keyfor(userpass)<>id_passcode then fatalerror('You are not authorized to use this software.');
  809. end;
  810.  
  811. procedure sortphonebook;
  812. type KeyArray = Array[1..maxnums] of ^numberrec;
  813.  
  814. var i        :integer;
  815.     MyArray  :KeyArray;
  816.     Number   :integer;
  817.     s        :numberrec;
  818.  
  819. procedure quicksort(var sortbuf:keyarray;recs:integer);
  820.  
  821. procedure KeySwap(var rr,ss:numberrec);
  822. var t :numberrec;
  823. begin
  824.   t:=rr;
  825.   rr:=ss;
  826.   ss:=t;
  827. end;
  828.  
  829. procedure DoSort(low,high:integer);
  830. var i,j   :integer;
  831.     pivot :numberrec;
  832. begin
  833.   if (low<high) then begin
  834.      i:=low;j:=high;
  835.      pivot:=sortbuf[j]^;
  836.      repeat
  837.        while (i<j) and (SortBuf[i]^.name<=pivot.name) do inc(i);
  838.        while (j>i) and (SortBuf[j]^.name>=pivot.name) do dec(j);
  839.        if i<j then keyswap(sortbuf[i]^,sortbuf[j]^);
  840.      until i>=j;
  841.      keyswap(sortbuf[i]^,sortbuf[high]^);
  842.      if (i-low<high-i) then begin
  843.        DoSort(low,i-1);
  844.        DoSort(i+1,high);
  845.      end else begin
  846.        DoSort(i+1,high);
  847.        DoSort(low,i-1);
  848.      end;
  849.   end;
  850. end;
  851.  
  852. begin
  853.   DoSort(1,Recs);
  854. end;
  855.  
  856. begin
  857.   writeln;
  858.   textattr:=colors.error_reverse;
  859.   write(' * WARNING * ');
  860.   textattr:=colors.error;
  861.   write(' Really sort the phone book? ');
  862.   if not(yesnotoggle(false,'YES','NO')) then begin
  863.     textattr:=colors.normal;
  864.     writeln;
  865.     write('Operation cancelled.');
  866.     exit;
  867.   end;
  868.   textattr:=colors.normal;
  869.   number:=0;
  870.   for i:=1 to maxnums do begin
  871.     if numbers[i]^.name<>'-Unused-' then begin
  872.       inc(number);
  873.       new(myarray[number]);
  874.       myarray[number]^:=numbers[i]^;
  875.     end;
  876.   end;
  877.   writeln;
  878.   write('Sorting ',number,' numbers...');
  879.   QuickSort(MyArray,Number);
  880.   writeln;
  881.   write('Writing new phone book...');
  882.   sosopen;
  883.   sosfopen(phonebookname);
  884.   for i:=1 to number do begin
  885.     numbers[i]^:=myarray[i]^;
  886.     myarray[i]^.name:=scrambled(myarray[i]^.name);
  887.     myarray[i]^.number:=scrambled(myarray[i]^.number);
  888.     soswrite(myarray[i],sizeof(myarray[i]^));
  889.     dispose(myarray[i]);
  890.   end;
  891.   s.name:=scrambled(blankpbentry);
  892.   s.number:='';
  893.   for i:=number+1 to maxnums do begin
  894.     numbers[i]^.name:=blankpbentry;
  895.     numbers[i]^.number:='';
  896.     soswrite(@s,sizeof(s));
  897.   end;
  898.   sosclose;
  899.   writeln;
  900.   write('Operation completed.');
  901. end;
  902.  
  903. function countryfor(nr:string):string;
  904. var s  :string[3];
  905.     x  :word;
  906.     os :string;
  907. begin
  908.   if nr='' then begin
  909.     countryfor:='';
  910.     exit;
  911.   end;
  912.   if nr[1]<>'+' then begin
  913.     countryfor:='???';
  914.     exit;
  915.   end;
  916.   s:=partofnr(1,nr);
  917.   os:=s+' unknown';
  918.   for x:=1 to ccodecnt do if ccodes[x]^.cc=s then os:=ccodes[x]^.country;
  919.   countryfor:=os;
  920. end;
  921. end.
  922.