emulvt.pas

包含常用Internet协议TCP,UDP、HTTP、FTP、Telnet等

{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Program:      EMULVT.PAS
Description:  Delphi component which does Ansi terminal emulation
              Not every escape sequence is implemented, but a large subset.
Author:       Fran鏾is PIETTE
EMail:        http://users.swing.be/francois.piette  [e-mail]
              http://www.rtfm.be/fpiette             [e-mail]
              [e-mail]
Creation:     May, 1996
Version:      2.15
Support:      Use the mailing list [e-mail] See website for details.
Legal issues: Copyright (C) 1997-2000 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: [phone]
              <[e-mail]>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

Updates:
Jul 22, 1997  Some optimization
              Adapted to Delphi 3
Sep 05, 1997  Version 2.01
Dec 16, 1997  V2.02 Corrected a bug int the paint routine which caused GDI
                    resource leak when color was used.
Feb 24, 1998  V2.03 Added AddFKey function
Jul 15, 1998  V2.04 Adapted to Delphi 4 (moved DoKeyBuffer to protected section)
Dec 04, 1998  V2.05 Added 'single char paint' and 'char zoom' features.
Dec 09, 1998  V2.10 Added graphic char drawing using graphic primitives
                    Added (with permission) scroll back code developed by Steve
                    Endicott <[e-mail]>
Dec 21, 1998  V2.11 Corrected some screen update problems related to scrollback.
                    Added fixes from Steve Endicott.
                    Beautified code.
Mar 14, 1999  V2.12 Added OnKeyDown event.
                    Corrected a missing band at right of screen when painting.
Aug 15, 1999  V2.13 Moved KeyPress procedure to public section for BCB4 compat.
Aug 20, 1999  V2.14 Added compile time options. Revised for BCB4.
Nov 12, 1999  V2.15 Corrected display attribute error in delete line.
                    Checked for range in SetLines/GetLine

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit Emulvt;

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }
{$IFNDEF VER80} { Not for Delphi 1                    }
    {$H+}       { Use long strings                    }
    {$J+}       { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF VER110} { C++ Builder V3.0                    }
    {$ObjExportAll On}
{$ENDIF}
{$IFDEF VER125} { C++ Builder V4.0                    }
    {$ObjExportAll On}
{$ENDIF}

interface

{$DEFINE SINGLE_CHAR_PAINT}
{$DEFINE CHAR_ZOOM}

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ClipBrd;

const
  EmulVTVersion      = 215;
  CopyRight : String = ' TEmulVT (c) 1996-2000 F. Piette V2.15 ';
  MAX_ROW            = 50;
  MAX_COL            = 132;
  TopMargin          = 4;
  LeftMargin         = 6;
  RightMargin        = 6;
  BottomMargin       = 4;
  NumPaletteEntries  = 16;

type
  TBackColors     = (vtsBlack, vtsRed,     vtsGreen, vtsYellow,
                     vtsBlue,  vtsMagenta, vtsCyan,  vtsWhite);

  TScreenOption   = (vtoBackColor, vtoCopyBackOnClear);
  TScreenOptions  = set of TScreenOption;
  TXlatTable      = array [0..255] of char;
  PXlatTable      = ^TXlatTable;
  TFuncKeyValue   = String[50];
  PFuncKeyValue   = ^TFuncKeyValue;
  TFuncKey        = record
                        ScanCode : Char;
                        Shift    : TShiftState;
                        Ext      : Boolean;
                        Value    : TFuncKeyValue;
                    end;
  TFuncKeysTable  = array [0..63] of TFuncKey;
  PFuncKeysTable  = ^TFuncKeysTable;
  TKeyBufferEvent = procedure (Sender : TObject; Buffer : PChar; Len : Integer) of object;
  TKeyDownEvent   = procedure (Sender        : TObject;
                               var VirtKey   : Integer;
                               var Shift     : TShiftState;
                               var ShiftLock : Boolean;
                               var ScanCode  : Char;
                               var Ext       : Boolean) of object;


type
  { TLine is an object used to hold one line of text on screen }
  TLine = class(TObject)
  public
    Txt : array [0..MAX_COL] of Char;
    Att : array [0..MAX_COL] of Byte;
    constructor Create;
    procedure   Clear(Attr : Byte);
  end;
  TLineArray      = array [0..16382] of TLine;
  PLineArray      = ^TLineArray;

  { TScreen is an object to hold an entire screen of line and handle }
  { Ansi escape sequences to update this virtual screen              }
  TScreen = class(TObject)
  public
    FLines           : PLineArray;
    FRow             : Integer;
    FCol             : Integer;
    FRowSaved        : Integer;
    FColSaved        : Integer;
    FScrollRowTop    : Integer;
    FScrollRowBottom : Integer;
    FAttribute       : Byte;
    FForceHighBit    : Boolean;
    FReverseVideo    : Boolean;
    FUnderLine       : Boolean;
    FRowCount        : Integer;
    FColCount        : Integer;
    FBackRowCount    : Integer;
    FBackEndRow      : Integer;
    FBackColor       : TBackColors;
    FOptions         : TScreenOptions;
    FEscBuffer       : String[80];
    FEscFlag         : Boolean;
    Focused          : Boolean;
    FAutoLF          : Boolean;
    FAutoCR          : Boolean;
    FAutoWrap        : Boolean;
    FCursorOff       : Boolean;
    FCKeyMode        : Boolean;
    FNoXlat          : Boolean;
    FNoXlatInitial   : Boolean;
    FCntLiteral      : Integer;
    FCarbonMode      : Boolean;
    FXlatInputTable  : PXlatTable;
    FXlatOutputTable : PXlatTable;
    FCharSetG0       : Char;
    FCharSetG1       : Char;
    FCharSetG2       : Char;
    FCharSetG3       : Char;
    FAllInvalid      : Boolean;
    FInvRect         : TRect;
    FOnCursorVisible : TNotifyEvent;
    constructor Create;
    destructor  Destroy; override;
    procedure   AdjustFLines(NewCount : Integer);
    procedure   CopyScreenToBack;
    procedure   SetRowCount(NewCount : Integer);
    procedure   SetBackRowCount(NewCount : Integer);
    procedure   InvRect(nRow, nCol : Integer);
    procedure   InvClear;
    procedure   SetLines(I : Integer; Value : TLine);
    function    GetLines(I : Integer) : TLine;
    procedure   WriteChar(Ch : Char);
    procedure   WriteStr(Str : String);
    function    ReadStr : String;
    procedure   GotoXY(X, Y : Integer);
    procedure   WriteLiteralChar(Ch : Char);
    procedure   ProcessEscape(EscCmd : Char);
    procedure   SetAttr(Att : Char);
    procedure   CursorRight;
    procedure   CursorLeft;
    procedure   CursorDown;
    procedure   CursorUp;
    procedure   CarriageReturn;
    procedure   ScrollUp;
    procedure   ScrollDown;
    procedure   ClearScreen;
    procedure   BackSpace;
    procedure   Eol;
    procedure   Eop;
    procedure   ProcessESC_D;                { Index                   }
    procedure   ProcessESC_M;                { Reverse index           }
    procedure   ProcessESC_E;                { Next line               }
    procedure   ProcessCSI_u;                { Restore Cursor          }
    procedure   ProcessCSI_I;                { Select IBM char set     }
    procedure   ProcessCSI_J;                { Clear the screen        }
    procedure   ProcessCSI_K;                { Erase to End of Line    }
    procedure   ProcessCSI_L;                { Insert Line             }
    procedure   ProcessCSI_M;                { Delete Line             }
    procedure   ProcessCSI_m_lc;             { Select Attributes       }
    procedure   ProcessCSI_n_lc;             { Cursor position report  }
    procedure   ProcessCSI_at;               { Insert character        }
    procedure   ProcessCSI_r_lc;             { Scrolling margins       }
    procedure   ProcessCSI_s_lc;             { Save cursor location    }
    procedure   ProcessCSI_u_lc;             { Restore cursor location }
    procedure   ProcessCSI_7;                { Save cursor location    }
    procedure   ProcessCSI_8;                { Restore cursor location }
    procedure   ProcessCSI_H;                { Set Cursor Position     }
    procedure   ProcessCSI_h_lc;             { Terminal mode set       }
    procedure   ProcessCSI_l_lc;             { Terminal mode reset     }
    procedure   ProcessCSI_A;                { Cursor Up               }
    procedure   ProcessCSI_B;                { Cursor Down             }
    procedure   ProcessCSI_C;                { Cursor Right            }
    procedure   ProcessCSI_D;                { Cursor Left             }
    procedure   ProcessCSI_P;                { Delete Character        }
    procedure   ProcessCSI_S;                { Scroll up               }
    procedure   ProcessCSI_T;                { Scroll down             }
    procedure   process_charset_G0(EscCmd : Char);{ G0 character set   }
    procedure   process_charset_G1(EscCmd : Char);{ G1 character set   }
    procedure   process_charset_G2(EscCmd : Char);{ G2 character set   }
    procedure   process_charset_G3(EscCmd : Char);{ G3 character set   }
    procedure   UnimplementedEscape(EscCmd : Char);
    procedure   InvalidEscape(EscCmd : Char);
    function    GetEscapeParam(From : Integer; var Value : Integer) : Integer;
    property    OnCursorVisible : TNotifyEvent read  FonCursorVisible
                                               write FOnCursorVisible;
    property    Lines[I : Integer] : TLine read GetLines write SetLines;
  end;

  { TCustomEmulVT is an visual component wich does the actual display }
  { of a TScreen object wich is the virtual screen                    }
  { No property is published. See TEmulVT class                       }
  TCustomEmulVT = class(TCustomControl)
  private
    FScreen          : TScreen;
    FFileHandle      : TextFile;
    FCursorVisible   : Boolean;
    FCaretShown      : Boolean;
    FCaretCreated    : Boolean;
    FLineHeight      : Integer;
    FLineZoom        : Single;
    FCharWidth       : Integer;
    FCharZoom        : Single;
    FGraphicDraw     : Boolean;
    FInternalLeading : Integer;
    FBorderStyle     : TBorderStyle;
    FBorderWidth     : Integer;
    FAutoRepaint     : Boolean;
    FFont            : TFont;
    FVScrollBar      : TScrollBar;
    FTopLine         : Integer;
    FLocalEcho       : Boolean;
    FOnKeyBuffer     : TKeyBufferEvent;
    FOnKeyDown       : TKeyDownEvent;
    FFKeys           : Integer;
    FMonoChrome      : Boolean;
    FLog             : Boolean;
    FAppOnMessage    : TMessageEvent;
    FFlagCirconflexe : Boolean;
    FFlagTrema       : Boolean;
    FSelectRect      : TRect;
    FPal             : HPalette;
    FPaletteEntries  : array[0..NumPaletteEntries - 1] of TPaletteEntry;
    procedure   WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure   WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure   WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure   WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure   WMPaletteChanged(var Message : TMessage); message WM_PALETTECHANGED;
    procedure   VScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure   SetCaret;
    procedure   AdjustScrollBar;
    function    ProcessFKeys(ScanCode: Char; Shift: TShiftState; Ext: Boolean) : Boolean;
    function    FindFKeys(ScanCode: Char; Shift: TShiftState;
                          Ext: Boolean) : PFuncKeyValue;
    procedure   CursorVisibleEvent(Sender : TObject);
    procedure   SetFont(Value : TFont);
    procedure   SetAutoLF(Value : Boolean);
    procedure   SetAutoCR(Value : Boolean);
    procedure   SetXlat(Value : Boolean);
    procedure   SetLog(Value : Boolean);
    procedure   SetRows(Value : Integer);
    procedure   SetCols(Value : Integer);
    procedure   SetBackRows(Value : Integer);
    procedure   SetTopLine(Value : Integer);
    procedure   SetBackColor(Value : TBackColors);
    procedure   SetOptions(Value : TScreenOptions);
    procedure   SetLineHeight(Value : Integer);
    function    GetAutoLF : Boolean;
    function    GetAutoCR : Boolean;
    function    GetXlat : Boolean;
    function    GetRows : Integer;
    function    GetCols : Integer;
    function    GetBackRows : Integer;
    function    GetBackColor : TBackColors;
    function    GetOptions : TScreenOptions;
  protected
    procedure   AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
    procedure   DoKeyBuffer(Buffer : PChar; Len : Integer); virtual;
    procedure   PaintGraphicChar(DC   : HDC;
                                 X, Y : Integer;
                                 rc   : PRect;