home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / editrout.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  7.2 KB  |  272 lines
  1. unit editrout;
  2.  
  3. interface
  4. uses crt,dos,extras,bbp_vars;
  5. procedure editbase(var def:string;maxlen:byte;numbersonly,upcaseonly,hideinput:boolean);
  6. procedure edit(var def:string;maxlen:byte);
  7. procedure edituc(var def:string;maxlen:byte);
  8. procedure editpass(var def:string;maxlen:byte);
  9. procedure editint(var i:integer);
  10. procedure editword(var w:word);
  11. procedure editbyte(var b:byte);
  12. procedure editli(var l:longint);
  13. procedure editdate(var date:longint);
  14.  
  15. var hidechar,
  16.     spacechar      :char;
  17.     errortonefreq,
  18.     errortonelen   :word;
  19.  
  20. implementation
  21.  
  22. procedure errorbeep;
  23. begin
  24.   sound(errortonefreq);
  25.   delay(errortonelen);
  26.   nosound;
  27. end;
  28.  
  29. procedure editint(var i:integer);
  30. var s:string;
  31.     v:integer;
  32. begin
  33.   str(i,s);
  34.   repeat
  35.     editbase(s,6,false,false,false);
  36.     val(s,i,v);
  37.     if v<>0 then errorbeep;
  38.   until v=0;
  39. end;
  40.  
  41. procedure editword(var w:word);
  42. var s:string;
  43.     v:integer;
  44. begin
  45.   str(w,s);
  46.   repeat
  47.     editbase(s,5,true,false,false);
  48.     val(s,w,v);
  49.     if v<>0 then errorbeep;
  50.   until v=0;
  51. end;
  52.  
  53. procedure editbyte(var b:byte);
  54. var s:string;
  55.     v:integer;
  56. begin
  57.   str(b,s);
  58.   repeat
  59.     editbase(s,3,true,false,false);
  60.     val(s,b,v);
  61.   until v=0;
  62. end;
  63.  
  64. procedure editli(var l:longint);
  65. var s:string;
  66.     v:integer;
  67. begin
  68.   str(l,s);
  69.   repeat
  70.     editbase(s,11,true,false,false);
  71.     val(s,l,v);
  72.   until v=0;
  73. end;
  74.  
  75. procedure edituc(var def:string;maxlen:byte);
  76. begin
  77.   editbase(def,maxlen,false,true,false);
  78. end;
  79.  
  80. procedure editpass(var def:string;maxlen:byte);
  81. begin
  82.   editbase(def,maxlen,false,true,true);
  83. end;
  84.  
  85. procedure editdate(var date:longint);
  86. function w2str(w:word):string;
  87. var s:string;
  88. begin
  89.   str(w,s);
  90.   if w<10 then s:='0'+s;
  91.   w2str:=s;
  92. end;
  93. var dt:datetime;
  94.     xs:word;
  95.     v :integer;
  96.     s :string;
  97.     l :longint;
  98.     w :word;
  99. begin
  100.   xs:=wherex;
  101.   unpacktime(date,dt);
  102.   textattr:=cyan;
  103.   with dt do begin
  104.     write(w2str(month),'/',w2str(day),'/',year,'  ',w2str(hour),':',w2str(min),':',w2str(sec));
  105.     gotoxy(xs,wherey);
  106.     s:=w2str(month); repeat edit(s,2); val(s,month,v); until v=0;
  107.     write(w2str(month),'/');
  108.     s:=w2str(day); repeat edit(s,2); val(s,day,v); until v=0;
  109.     write(w2str(day),'/');
  110.     s:=w2str(year); repeat edit(s,4); val(s,year,v); until v=0;
  111.     write(w2str(year),'  ');
  112.     s:=w2str(hour); repeat edit(s,2); val(s,hour,v); until v=0;
  113.     write(w2str(hour),':');
  114.     s:=w2str(min); repeat edit(s,2); val(s,min,v); until v=0;
  115.     write(w2str(min),':');
  116.     s:=w2str(sec); repeat edit(s,2); val(s,sec,v); until v=0;
  117.     write(w2str(sec));
  118.   end;
  119.   gotoxy(xs,wherey);
  120.   packtime(dt,date);
  121. end;
  122.  
  123. procedure edit(var def:string;maxlen:byte);
  124. begin
  125.   editbase(def,maxlen,false,false,false);
  126. end;
  127.  
  128. procedure editbase(var def:string;maxlen:byte;numbersonly,upcaseonly,hideinput:boolean);
  129. var s,s2,s3     :string;
  130.     ch          :char;
  131.     pos,start,b :byte;
  132.     x           :word;
  133.     firstkey    :boolean;
  134.     insflag     :boolean;
  135.     savedcolor  :byte;
  136. begin
  137.   savedcolor:=textattr;
  138.   insflag:=false;
  139.   firstkey:=true;
  140.   if upcaseonly then s:=uppercase(def) else s:=def;
  141.   start:=wherex-1;
  142.   pos:=length(s)+1;
  143.   textattr:=colors.inputfield;
  144.   if s<>'' then if hideinput then for x:=1 to length(s) do write(hidechar) else write(s);
  145.   for x:=1 to maxlen-length(s) do write(spacechar);
  146.   repeat
  147.     gotoxy(start+pos,wherey);
  148.     if insflag then setcursorsize($1,$7) else setcursorsize($6,$7);
  149.     ch:=readkey;
  150.     if upcaseonly then ch:=upcase(ch);
  151.     if numbersonly then
  152.       while not(ch in ['0','1','2','3','4','5','6','7','8','9','.',^X,^H,#0,#13,#27]) do begin
  153.         errorbeep;
  154.         ch:=readkey;
  155.       end;
  156.     if ch=^X then begin
  157.       s:='';
  158.       pos:=1;
  159.       gotoxy(start+1,wherey);
  160.       write(s);
  161.       for x:=1 to maxlen-length(s) do write(spacechar);
  162.     end;
  163.     if (ch=^H) and (pos<length(s)+1) and (pos>1) then begin
  164.       for x:=pos-1 to length(s)-1 do s[x]:=s[x+1];
  165.       dec(pos);
  166.       b:=ord(s[0]); dec(b); s[0]:=chr(b);
  167.       gotoxy(start+1,wherey);
  168.       write(s);
  169.       for x:=1 to maxlen-length(s) do write(spacechar);
  170.     end;
  171.     if (ch=^H) and (pos=length(s)+1) and (pos>1) then begin
  172.       write(^H+spacechar+^H);
  173.       dec(pos);
  174.       b:=ord(s[0]); dec(b); s[0]:=chr(b);
  175.       if firstkey then firstkey:=false;
  176.     end;
  177.     if ch=#0 then begin
  178.       {ch:=readkey;
  179.       write(ch);
  180.       halt;}
  181.       ch:=readkey;
  182.       if ch='G' then pos:=1;
  183.       if ch='O' then pos:=length(s)+1;
  184.       if ch='R' then insflag:=not(insflag);
  185.  
  186.       if (ch='S') and (pos<=length(s)) then begin
  187.         for x:=pos to length(s)-1 do s[x]:=s[x+1];
  188.         b:=ord(s[0]); dec(b); s[0]:=chr(b);
  189.         gotoxy(start+1,wherey);
  190.         write(s);
  191.         for x:=1 to maxlen-length(s) do write(spacechar);
  192.       end;
  193.  
  194.       if (ch='K') and (pos>1) then begin
  195.         write(^H);
  196.         dec(pos);
  197.       end;
  198.       if (ch='M') and (pos<=length(s)) then begin
  199.         inc(pos);
  200.         write(s[pos-1]);
  201.       end;
  202.       ch:=#0;
  203.       firstkey:=false;
  204.     end else if (pos<=maxlen) and (not(ch in [^X,^H,#13,#27])) then begin
  205.       if insflag then begin
  206.         if length(s)=maxlen then errorbeep else begin
  207.           s2:=ch;
  208.           s3:=copy(s,1,pos-1)+s2+copy(s,pos,length(s)-pos+1);
  209.           s:=s3;
  210.           gotoxy(start+1,wherey);
  211.           if s<>'' then if hideinput then for x:=1 to length(s) do write(hidechar) else write(s);
  212.           inc(pos);
  213.           for x:=1 to maxlen-length(s) do write(spacechar);
  214.           firstkey:=false;
  215.         end;
  216.       end else begin
  217.         if firstkey then begin
  218.           s:='';
  219.           pos:=1;
  220.           gotoxy(start+1,wherey);
  221.           {if hideinput then for x:=1 to length(s) do write(hidechar) else write(s);}
  222.           for x:=1 to maxlen-length(s) do write(spacechar);
  223.           gotoxy(start+1,wherey);
  224.           firstkey:=false;
  225.         end;
  226.         if hideinput then write(hidechar) else write(ch);
  227.         inc(pos);
  228.         if pos>length(s)+1 then begin
  229.           b:=ord(s[0]); inc(b); s[0]:=chr(b);
  230.         end;
  231.         s[pos-1]:=ch;
  232.       end;
  233.     end;
  234.     if (pos>=maxlen) and firstkey and (not(ch in [^X,^H,#13,#27])) then begin
  235.       if firstkey then begin
  236.         s:='';
  237.         pos:=1;
  238.         gotoxy(start+1,wherey);
  239.         {write(s);}
  240.         for x:=1 to maxlen-length(s) do write(spacechar);
  241.         gotoxy(start+1,wherey);
  242.         firstkey:=false;
  243.       end;
  244.       if hideinput then write(hidechar) else write(ch);
  245.       inc(pos);
  246.       if pos>length(s)+1 then begin
  247.         b:=ord(s[0]); inc(b); s[0]:=chr(b);
  248.       end;
  249.       s[pos-1]:=ch;
  250.     end;
  251.   until ch in [#13,#27];
  252.   if ch=#13 then def:=s;
  253.   textattr:=savedcolor;
  254.   gotoxy(start+1,wherey);
  255.   if def<>'' then if hideinput then for x:=1 to length(def) do write(hidechar)
  256.     else write(def);
  257.   for x:=1 to maxlen-length(def) do write(' ');
  258.   gotoxy(start+1,wherey);
  259. end;
  260.  
  261. begin
  262.   if paramstr(1)='/(C)' then begin
  263.     writeln('EDITROUT.PAS - v1.51 - (C) Onkel Dittmeyer / S.L.A.M.');
  264.     writeln('             Flexible line editing toolbox');
  265.     readln;
  266.   end;
  267.   hidechar:='■';
  268.   spacechar:=' ';
  269.   errortonefreq:=300;
  270.   errortonelen:=200;
  271. end.
  272.