home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TSHELL12.ZIP / KEYAHEAD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-21  |  2.8 KB  |  123 lines
  1.  
  2. (*
  3.  * keyahead - put keys into the double-dos type ahead buffer for
  4.  *            the current side of the system
  5.  *
  6.  * author:  s.h. smith, 9-dec-85
  7.  *
  8.  *)
  9.  
  10. type
  11.    regpack =      record
  12.                      ax,bx,cx,dx,
  13.                      bp,si,di,ds,
  14.                      es,flags:         Integer;
  15.                   end;
  16.  
  17. var
  18.    reg:    regpack;
  19.    i,j:    integer;
  20.    params: string[128];
  21.    c:      char;
  22.  
  23.  
  24.    procedure keychar(c: char);
  25.    begin
  26.       reg.ax := $e300 + ord(c);   {send char c to key buffer}
  27.       msdos(reg);
  28.    end;
  29.  
  30.    procedure funkey(c: char);
  31.    begin
  32.       keychar(#27);
  33.       keychar(c);
  34.    end;
  35.  
  36. begin
  37.    if paramcount = 0 then
  38.    begin
  39.       writeln(^G);
  40.       writeln('usage:  keyahead STRING');
  41.       writeln;
  42.       writeln('action:  places STRING into dosble-dos type-ahead buffer');
  43.       writeln;
  44.       writeln('STRING may contain:');
  45.       writeln('  ^X              produces control character CTRL-X');
  46.       writeln('  ^N              produces function key Fn');
  47.       writeln('  ^0              produces function key F10');
  48.       writeln('  ^!              produces ";"');
  49.       writeln('  ^#              produces "="');
  50.       writeln('  ^[              produces "["');
  51.       writeln('  [filename.ext]  produces "filename"');
  52.       halt;
  53.    end;
  54.  
  55.    params := '';
  56.    for i := 1 to paramcount do
  57.    begin
  58.       if params = '' then
  59.          params := paramstr(i)
  60.       else
  61.          params := params + ' ' + paramstr(i);
  62.    end;
  63.  
  64.    i := 1;
  65.  
  66.    while i <= length(params) do
  67.    begin
  68.       c := params[i];
  69.       i := i + 1;
  70.  
  71.  
  72.       if c = '[' then           {[filename.ext] causes extention stripping}
  73.       begin
  74.          repeat
  75.             c := params[i];     {output the filename}
  76.             i := i + 1;
  77.             keychar(c);
  78.          until (params[i] in ['.',']']) or (i > length(params));
  79.  
  80.          if params[i] <> ']' then
  81.          repeat
  82.             c := params[i];     {skip the .ext, if any}
  83.             i := i + 1;
  84.          until (params[i] = ']') or (i > length(params));
  85.  
  86.          if i > length(params) then
  87.             writeln(^G'error:  missing "]" in filename stripping request');
  88.  
  89.          i := i + 1;   {skip over the ']'}
  90.       end
  91.       else
  92.  
  93.  
  94.       if c = '^' then
  95.       begin
  96.          c := upcase(params[i]);
  97.          i := i + 1;
  98.  
  99.          case c of
  100.             '!':  keychar(';');
  101.  
  102.             '#':  keychar('=');
  103.  
  104.             '[':  keychar('[');
  105.  
  106.             '0':  funkey('D');           {F10 key}
  107.  
  108.             '1'..'9':
  109.                   funkey( chr( ord(c)-ord('1')+ord(';') ));
  110.  
  111.             else                      {process all other control chars}
  112.                keychar( chr( ord(c) - ord('@') ));
  113.          end;
  114.       end
  115.  
  116.       else
  117.          keychar(c);
  118.    end;
  119.  
  120. end.
  121.  
  122.  
  123.