oopstelnet.pas

一个Delphi的Telnet程序示例

    SetCaret;
  end;
end;

procedure TOopsTelnet.ProcessCSI_C;
var Col: Integer;
begin
  if FEscBuffer[2]='=' then begin
    GetEscapeParam(3, Col);  { ^[=s;eC Sets the cursor to start on scanline s and end on scanline e }
    case Col of
      14: SetCaretOff(True);  { ^[14;12C  invisible caret }
      10: SetCaretOff(False); { ^[12;10C  visible caret }
    end;
  end else begin
    GetEscapeParam(2, Col);
    if Col<=0 then Col:=1;
    FCol:=FCol+Col;
    if FCol>=FColCount then begin
      if FAutoWrap then begin
        FCol:=FCol-FColCount;
        Inc(FRow);
        if FRow>=FRowCount then FRow:=FRowCount - 1;
      end else FCol:=FColCount - 1;
    end;
    SetCaret;
  end;
end;

procedure TOopsTelnet.ProcessCSI_D;
var Col: Integer;
begin
  if FEscBuffer[2]='=' then begin
    case FEscBuffer[3] of { ^[=xD Turns the intensity of the background color }
    '0': Exclude(FAttr.Attr, csIntensity);
    '1': Include(FAttr.Attr, csIntensity);
    end;
  end else begin
    GetEscapeParam(2, Col);
    if Col=0 then Col:=1;
    FCol:=FCol-Col;
    if FCol<0 then FCol:=0;
    SetCaret;
  end;
end;

procedure TOopsTelnet.ProcessCSI_E;
var Row: Integer;
begin
  if FEscBuffer[2]='=' then
    case FEscBuffer[3] of
    '0': Exclude(FAttr.Attr, csBlink); { Clears the Blink versus Bold background bit in the 6845 CRT controller }
    '1': Include(FAttr.Attr, csBlink); { Sets the Blink versus Bold background bit in the 6845 CRT controller }
    end
  else begin { Moves active position to beginning of line, n lines down }
    GetEscapeParam(2, Row);
    if Row=0 then Row:=1;
    FRow:=FRow + Row;
    if FRow>=FRowCount then FRow:=FRowCount-1;
    FCol:=0;
    SetCaret;
  end;
end;

procedure TOopsTelnet.ProcessCSI_F;
var ClIdx, Row: Integer;
begin
  if FEscBuffer[2]='=' then begin { Sets foreground }
    GetEscapeParam(3, ClIdx);
    AttrSetFColor(FAttr, ClIdx);
  end else begin { Moves active position to beginning of line, n lines up }
    GetEscapeParam(2, Row);
    if Row=0 then Row:=1;
    FRow:=FRow - Row;
    if FRow<0 then FRow:=0;
    FCol:=0;
    SetCaret;
  end;
end;

procedure TOopsTelnet.ProcessCSI_G;
var ClIdx, Col: Integer;
begin
  if FEscBuffer[2]='=' then begin { Sets background }
    GetEscapeParam(3, ClIdx);
    AttrSetGColor(FAttr, ClIdx);
  end else begin { ^[nG Move the active position in the same way as <HPA> }
    GetEscapeParam(2, Col);
    FCol:=Col+1;
    SetCaret;
  end;
end;

procedure TOopsTelnet.ProcessCSI_H;
var From, Row, Col : Integer;
begin
  if FEscBuffer[2]='=' then begin { Sets reverse foreground }
    FAttr.Color:=FAttr.Color xor $0F;
  end else begin
    From:=GetEscapeParam(2, Row); { ^[H  (Row=0)Cursor and selects graphic }
    if Row=0 then Row:=1;
  //  while (From<=Length(FEscBuffer))and(FEscBuffer[From]=' ') do Inc(From);
    if FEscBuffer[From]=';' then GetEscapeParam(From+1, Col) else Col:=1;
    GotoXY(Col-1, Row-1);
  end;
end;

procedure TOopsTelnet.ProcessCSI_I;
begin
  if FEscBuffer[2]='=' then begin { Sets reverse background }
    FAttr.Color:=FAttr.Color xor $F0;
  end;
end;

procedure TOopsTelnet.ProcessCSI_J;
begin { Clear display. }
  if FEscBuffer[2]='=' then begin { Sets reverse foreground }
    FAttr.Color:=FAttr.Color xor $0F;
  end else begin
    if Length(FEscBuffer)=2 then
      case FEscBuffer[2] of
      '0': ClearLines(FRow, FRowCount-FRow); { erases from active position Display to end of display. }
      '1': ClearLines(0, FRow+1); { erases from the beginning of display to active position. }
      '2': ClearLines(0, FRowCount); { erases entire display }
      end
    else ClearLines(FRow+1, FRowCount-FRow); { erases from active position Display to end of display. }
    Invalidate;
    end;
end;

procedure TOopsTelnet.ProcessCSI_K;
var r: TRect;
    func, ClIdx: Integer;
begin
  if FEscBuffer[2]='=' then begin { Sets graphic background. }
    GetEscapeParam(3, ClIdx);
    AttrSetGColor(FAttr, ClIdx);
  end else begin  { Erases all or part of a line. }
    GetEscapeParam(2, func);
    if func in [0, 1, 2] then ClearLn(Chr(Ord('0')+func)) else Exit;
    r.Left:=TermMargins;
    r.Right:=r.Left + FFontSize.cx * FColCount;
    r.Top:=TermMargins + FFontSize.cy * FRow;
    r.Bottom:=r.Top + FFontSize.cy;
    InvalidateRect(Handle, @r, False);
  end;
end;

procedure TOopsTelnet.ProcessCSI_L;
var iLine: Integer;
begin
  if FEscBuffer[2]='=' then begin
    { ^[=nL Fills new regions with current (n=0) or normal (n=1)
            color attributes.  Default fill behavior is 0.
            Disables (n=2) or enables (n=3; default) iBCS2
            compliance for the TBC (CSIng) sequence.  When iBCS2
            compliance is enabled, TBC may be used to clear tab stops.
            Disables (n=4; default) or enables (n=5) ANSI
            compliance for the SGR 0 (CSI0m) sequence on the
            selected font.  When disabled (the default), SGR 0
            has no effect on the font.  When enabled, SGR 0
            selects the primary font, equivalent to issuing SGR 10 }
  end else begin
    GetEscapeParam(2, iLine);
    if iLine=0 then iLine:=1;
    MoveLines(FRow, FRowCount-FRow, iLine);
    ClearLines(FRow, iLine);
    Invalidate;
  end;
end;

function IntToOct(t: Word): string;
var j, k: integer;
begin
  j:=0; k:=1;
  while k<1000000000 do begin
   j:=(t and $0007)*k + j;
   k:=k*10;
   t:=t shr 3;
  end;
  Result:=IntToStr(j);
end;

procedure TOopsTelnet.ProcessCSI_M;
var dLine: Integer;
    s: string;
begin
  if FEscBuffer[2]='=' then begin { Returns current foreground color attributes }
    case FEscBuffer[3] of
    '0': s:=IntToOct(AttrGetFColor(FAttr))+IntToOct(AttrGetGColor(FAttr))+#10; { normal }
    '1': s:=IntToOct(AttrGetGColor(FAttr))+IntToOct(AttrGetFColor(FAttr))+#10; { reverse }
    '2': s:=''; { graphic ?? }
    else s:='' end;
    if s<>'' then Socket.SendBuf(s[1], Length(s));
  end else begin { Deletes n lines }
    GetEscapeParam(2, dLine);
    if dLine=0 then dLine:=1;
    MoveLines(FRow+dLine, FRowCount-FRow-dLine, -dLine);
    ClearLines(FRowCount-dLine, dLine);
    Invalidate;
  end;
end;

procedure TOopsTelnet.ProcessCSI_P;
var nChar, nCol: Integer;
begin
  GetEscapeParam(2, nChar);
  if nChar<=0 then nChar:=1;
  for nCol:=FCol to FColCount-nChar-1 do begin
    FBufText[FRow, nCol]:=FBufText[FRow, nCol+nChar];
    FBufAttr[FRow, nCol]:=FBufAttr[FRow, nCol+nChar];
    InvLine(FRow);
  end;
  for nCol:=FColCount-nChar-1 to FColCount-1 do begin
    FBufText[FRow, nCol]:=#$20;
    FBufAttr[FRow, nCol]:=FAttr;
    InvLine(FRow);
  end;
end;

procedure TOopsTelnet.ProcessCSI_S;
var nLine: Integer;
begin { Scrolls screen up n lines }
  GetEscapeParam(2, nLine);
  if nLine=0 then nLine:=1;
  MoveLines(nLine, FRowCount-nLine, -nLine);
  ClearLines(FRowCount-nLine, nLine);
  Invalidate;
end;

procedure TOopsTelnet.ProcessCSI_T;
var nLine: Integer;
begin { Scrolls screen down n lines }
  GetEscapeParam(2, nLine);
  if nLine=0 then nLine:=1;
  MoveLines(0, FRowCount-nLine, nLine);
  ClearLines(0, nLine);
  Invalidate;
end;

procedure TOopsTelnet.ProcessCSI_X;
var nChar, i: Integer;
begin { Erases n characters }
  GetEscapeParam(2, nChar);
  if nChar=0 then nChar:=1;
  for i:=FCol to FCol+nChar-1 do
    if i<FColCount then begin
      FBufText[FRow, FCol]:=#$20;
      FBufAttr[FRow, FCol]:=FAttr;
      InvLine(FRow);
    end;
end;

procedure TOopsTelnet.ProcessCSI_Z;
var nTab, i: Integer;
begin { Moves active position back n tab stops }
  GetEscapeParam(2, nTab);
  if nTab=0 then nTab:=1;
  for i:=1 to nTab do begin
    repeat Dec(FCol) until (FCol Mod 8) = 0;
    if FCol<=0 then Break;
  end;
  if FCol<0 then FCol:=0;
  SetCaret;
end;

procedure TOopsTelnet.ProcessCSI_at;
var nChar, nCol: Integer;
begin
  GetEscapeParam(2, nChar);
  if nChar=0 then nChar:=1;
  if (FColCount-FCol-nChar)<=0 then begin ClearLn('0'); Exit end;
  for nCol:=FColCount-1 downto FCol+nChar do begin
    FBufText[FRow, nCol]:=FBufText[FRow, nCol-nChar];
    FBufAttr[FRow, nCol]:=FBufAttr[FRow, nCol-nChar];
    InvLine(Frow);
  end;
  for nCol:=FCol to FCol+nChar-1 do begin
    FBufText[FRow, nCol]:=#$20;
    FBufAttr[FRow, nCol]:=FAttr;
    InvLine(Frow);
  end;
end;

procedure TOopsTelnet.ProcessCSI_h_lc;
var Mode: Integer;
begin
  if FEscBuffer[1]<>'[' then Exit;
  case FEscBuffer[2] of
  '2': FKeyboardLocked:=True; { Locks keyboard.  Ignores keyboard input until unlocked. }
  '?': begin { Set Term Options }
        GetEscapeParam(3, Mode);
        case Mode of
         7: FAutoWrap:=True; { Auto-wrap ON }
        25: SetCaretOff(True); { Caret visible }
        end;
       end;
  end;
end;

procedure TOopsTelnet.ProcessCSI_l_lc;
var Mode: Integer;
begin
  if FEscBuffer[1]<>'[' then Exit;
  case FEscBuffer[2] of
  '2': FKeyboardLocked:=True; { Unlocks keyboard.  Re-enables keyboard input }
  '?': begin { Set Term Options }
        GetEscapeParam(3, Mode);
        case Mode of
         7: FAutoWrap:=False; { Auto-wrap OFF }
        25: SetCaretOff(False); { Caret invisible }
        end;
       end;
  end;
end;

procedure TOopsTelnet.ProcessCSI_m_lc;
  procedure ProcessCSI_Sub_m_lc(i: Integer);
  begin
    case i of
     0: FAttr.Attr:=[];                      { All attributes off }
     1: Include(FAttr.Attr, csBlod);         { Bold intensity }
     4: Include(FAttr.Attr, csUnderline);    { Underscore on }
     5: Include(FAttr.Attr, csBlink);        { Blink on }
     7: Include(FAttr.Attr, csReverse);      { Reverse video }
     8: FAttr.Attr:=[];                      { Sets blank }
     10: begin                               { Selects the primary font }
           Exclude(FAttr.Attr, csCtlchar);
           EXclude(FAttr.Attr, csTabluation)
         end;
     11: Include(FAttr.Attr, csCtlchar);     { Selects the first alternate font, lets #$xx < #32 be displayed as ROM characters. }
     12: Include(FAttr.Attr, csTabluation);  { Selects a second alternate font, toggles high bit of extended ASCII code before displaying as ROM characters. }
     30..37: AttrSetFColor(FAttr, i-30);     { foreground }
     38: Include(FAttr.Attr, csUnderline);   { Enables underline option; white foreground with white underscore }
     39: Exclude(FAttr.Attr, csUnderline);   { Disables underline option }
     40..47: AttrSetGColor(FAttr, i-40);     { background }
    end;
  end;
var From, n: Integer;
begin
  if Length(FEscBuffer)<2 then begin AttrSetDefault(FAttr); Exit end;
  From:=GetEscapeParam(2, n);
  ProcessCSI_Sub_m_lc(n);
  if (From<=Length(FEscBuffer))and(FEscBuffer[From]=';') then begin
    From:=GetEscapeParam(From+1, n);
    ProcessCSI_Sub_m_lc(n);
    if (From<=Length(FEscBuffer))and(FEscBuffer[From]=';') then begin
      GetEscapeParam(From+1, n);
      ProcessCSI_Sub_m_lc(n);
    end;
  end;
end;