tnemulvt.pas

BaiduMp3 search baidu mp3

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

Program:      TNEMULVT.PAS
Description:  Delphi component combining both TnCnx and EmulVT components.
              Hence it does ANSI emulation using TCP/IP telnet protocol.
Author:       Fran鏾is PIETTE
Creation:     May, 1996
Version:      2.14
EMail:        http://www.overbyte.be       [e-mail]
              http://www.rtfm.be/fpiette   [e-mail]
              [e-mail]
Support:      Use the mailing list [e-mail]
              Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1996-2005 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: [phone]
              <[e-mail]> <[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 Revised Connect method to be callable from FormCreate event
             Adapted to Delphi 3
Sep 05, 1997 TnCnx made public, Minor change to method visibility
             Added OnTermType and OnDataAvailable events.
Sep 23, 1997 V202. Added local echo support (incomplete because we should ask
             the remote host not to echo characters. Will implement later)
             Added TnEmultVTVersion
Sep 24, 1997 V2.03 Complete local echo support.
Sep 25, 1997 V2.04 Port to C++Builder
Feb 19, 1998 V2.05 Replaced private section by protected.
             Added TriggerDataAvailable virtual function.
Dec 21, 1998 V2.06 Added fixes from Steve Endicott.
Mar 01, 1999 V2.07 Added conditional compile for BCB4. Thanks to James
             Legg <[e-mail]>.
Mar 14, 1999 V2.08 Added OnKeyDown event to allow key trapping.
             Ignore any exception when sending fct keys.
Aug 15, 1999 V2.09 Move KeyPress procedure to public section for BCB4 compat.
Aug 20, 1999 V2.10 Added compile time options. Revised for BCB4.
Sep 25, 1999 V2.11 Corrected GetSelTextBuf so that lines are returned in
             corrected order (they where returned in reverse order).
             Thanks to Laurent Navarro <[e-mail]> for finding
             this bug and fixing it.
Jan 12, 2002 V2.12 Replaced TnCnx public member by TnConn property to avoid
             conflit with unit named TnCnx. This will require change in your
             own code if you used this property. Added a notification procedure
             to remove FTnCnx if component is externally destroyed. Added code
             to check if we still have the component with us.
Oct 23, 2002 V2.13 Changed Buffer arg in OnDataAvailable to Pointer instead
             of PChar to avoid Delphi 7 messing everything with AnsiChar.
May 31, 2004 V2.14 Used ICSDEFS.INC, removed unused unit


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit TnEmulVT;

{$R-}           { Range Check off                     }
{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }
{$I ICSDEFS.INC}
{$IFDEF DELPHI6_UP}
    {$WARN SYMBOL_PLATFORM   OFF}
    {$WARN SYMBOL_LIBRARY    OFF}
    {$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
{$IFNDEF VER80}   { Not for Delphi 1                    }
    {$H+}         { Use long strings                    }
    {$J+}         { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF BCB3_UP}
    {$ObjExportAll On}
{$ENDIF}

interface

uses
    Messages,
{$IFDEF USEWINDOWS}
    Windows,
{$ELSE}
    WinTypes, WinProcs,
{$ENDIF}
    SysUtils, Classes, Graphics, Controls,
    Forms, EmulVT, TnCnx, IniFiles, TnOptFrm, WSocket;

const
  TnEmultVTVersion = 214;
  CopyRight : String = ' TTnEmulVT (c) 1996-2005 F. Piette V2.14 ';

type
  TTnEmulVTDataAvailable = procedure (Sender  : TObject;
                                      Buffer  : Pointer;
                                      var Len : Integer) of object;
  TTnEmulVT = class(TEmulVT)
  protected
    FTnCnx              : TTnCnx;
    FError              : Word;
    FIniFilename        : String;
    FSectionName        : String;
    FKeyName            : String;
    FHostName           : String;
    FPort               : String;
    FTag                : LongInt;
    FUpperLock          : Boolean;
    FLocalEcho          : Boolean;
    FOnSessionClosed    : TNotifyEvent;
    FOnSessionConnected : TNotifyEvent;
    FOnNamesClick       : TNotifyEvent;
    FOnSendLoc          : TNotifyEvent;
    FOnTermType         : TNotifyEvent;
    FOnLocalEcho        : TNotifyEvent;
    FOnDataAvailable    : TTnEmulVTDataAvailable;
    FMouseDown          : Boolean;
    FMouseCaptured      : Boolean;
    FMouseTop           : Integer;
    FMouseLeft          : Integer;
    FFocusDrawn         : Boolean;
    FFocusRect          : TRect;
    procedure   TriggerDataAvailable(Buffer : Pointer; Len: Integer); virtual;
    procedure   TnCnxDataAvailable(Sender: TTnCnx; Buffer : Pointer; Len : Integer);
    procedure   TnCnxSessionClosed(Sender: TTnCnx; Erc: Word);
    procedure   TnCnxSessionConnected(Sender: TTnCnx; Erc: Word);
    procedure   TnCnxSendLoc(Sender: TObject);
    procedure   TnCnxTermType(Sender: TObject);
    procedure   TnCnxLocalEcho(Sender: TObject);
    procedure   Display(Msg : String);
    procedure   DoKeyBuffer(Buffer : PChar; Len : Integer); override;
    procedure   MouseDown(Button: TMouseButton; Shift: TShiftState;
                          X, Y: Integer); override;
    procedure   MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure   MouseUp(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
{$IFNDEF BCB_FLAG}
    procedure   Notification(AComponent : TComponent;
                             Operation  : TOperation); override;
{$ENDIF}
    procedure   SetOnEndOfRecord(Value : TNotifyEvent);
    function    GetOnEndOfRecord : TNotifyEvent;
    procedure   SetLocation(Value : String);
    function    GetLocation : String;
    procedure   SetHostName(newValue : String);
  public
    procedure   RequestLocalEcho(newValue : Boolean);
    function    GetLocalEcho : Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   Connect;
    procedure   Disconnect;
    procedure   EditOptions;
    procedure   RestoreOptions;
    function    IsConnected : Boolean;
    function    Send(Data : Pointer; Len : Integer) : Integer;
    function    SendStr(Data : String) : Integer;
    function    GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
    procedure   KeyPress(var Key: Char); override;
    property    TnConn     : TTnCnx  read FTnCnx;
  published
    property IniFilename   : String  read FIniFileName write FIniFileName;
    property SectionName   : String  read FSectionName write FSectionName;
    property KeyName       : String  read FKeyName     write FKeyName;
    property Error         : Word    read FError       write FError;
    property HostName      : String  read FHostName    write SetHostName;
    property Port          : String  read FPort        write FPort;
    property Tag           : LongInt read FTag         write FTag;
    property Location      : String  read GetLocation  write SetLocation;
    property UpperLock     : Boolean read FUpperLock   write FUpperLock;
    property LocalEcho     : Boolean read FLocalEcho   write FLocalEcho;

    property OnKeyDown;
    property OnSessionClosed    : TNotifyEvent         read  FOnSessionClosed
                                                       write FOnSessionClosed;
    property OnSessionConnected : TNotifyEvent         read  FOnSessionConnected
                                                       write FOnSessionConnected;
    property OnEndOfRecord : TNotifyEvent              read  GetOnEndOfRecord
                                                       write SetOnEndOfRecord;
    property OnNamesClick : TNotifyEvent               read  FOnNamesClick
                                                       write FOnNamesClick;
    property OnSendLoc :    TNotifyEvent               read  FOnSendLoc
                                                       write FOnSendLoc;
    property OnTermType :    TNotifyEvent              read  FOnTermType
                                                       write FOnTermType;
    property OnLocalEcho :    TNotifyEvent             read  FOnLocalEcho
                                                       write FOnLocalEcho;
    property OnDataAvailable : TTnEmulVTDataAvailable  read  FOnDataAvailable
                                                       write FOnDataAvailable;
  end;

procedure Register;

implementation

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Register;
begin
  RegisterComponents('FPiette', [TTnEmulVT]);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure FontToIni(Font : TFont; IniFile : TIniFile; Section : String);
var
    nBuf     : Integer;
begin
    IniFile.WriteString(Section,  'FontName',  Font.Name);
    IniFile.WriteInteger(Section, 'FontSize',  Font.Size);
    IniFile.WriteInteger(Section, 'FontPitch', ord(Font.Pitch));
    nBuf := 0;
    if fsBold in Font.Style then
        nBuf := nBuf or 1;
    if fsItalic in Font.Style then
        nBuf := nBuf or 2;
    if fsUnderline in Font.Style then
        nBuf := nBuf or 4;
    if fsStrikeOut in Font.Style then
        nBuf := nBuf or 8;
    IniFile.WriteInteger(Section, 'FontStyle', nBuf);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure IniToFont(Font : TFont; IniFile : TIniFile; Section : String);
var
    FontName : String;
    nBuf     : Integer;
begin
    FontName := IniFile.ReadString(Section, 'FontName', '*');
    if FontName <> '*' then begin
        Font.Name  := FontName;
        Font.Size  := IniFile.ReadInteger(Section, 'FontSize', 9);
        Font.Pitch := TFontPitch(IniFile.ReadInteger(Section, 'FontPitch', 12));
        nBuf       := IniFile.ReadInteger(Section, 'FontStyle', 0);
        Font.Style := [];
        if (nBuf and 1) <> 0 then
            Font.Style := Font.Style + [fsBold];
        if (nBuf and 2) <> 0 then
            Font.Style := Font.Style + [fsItalic];
        if (nBuf and 4) <> 0 then
            Font.Style := Font.Style + [fsUnderline];
        if (nBuf and 8) <> 0 then
            Font.Style := Font.Style + [fsStrikeOut];
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TTnEmulVT.Create(AOwner: TComponent);
var
    Rect : TRect;
begin
    inherited Create(AOwner);

    if TnCnxVersion < 203 then
        raise Exception.Create('TTnEmulVT need TTnCnx version 2.03 or higher ' +
                               'Please download last release from ' +
                               'http://www.overbyte.be');

    FTnCnx                    := TTnCnx.Create(Self);
    FTnCnx.OnDataAvailable    := TnCnxDataAvailable;
    FTnCnx.OnSessionClosed    := TnCnxSessionClosed;
    FTnCnx.OnSessionConnected := TnCnxSessionConnected;
    FTnCnx.OnSendLoc          := TnCnxSendLoc;
    FTnCnx.OnTermType         := TnCnxTermType;
    FTnCnx.OnLocalEcho        := TnCnxLocalEcho;

    FIniFileName := 'TNEMULVT.INI';
    FSectionName := 'Windows';
    FKeyName     := 'TnEmulVT';
    FPort        := 'telnet';
    Rect.Top     := -1;
    SelectRect   := Rect;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor  TTnEmulVT.Destroy;
begin
    if Assigned(FTnCnx) then begin
        FTnCnx.Free;
        FTnCnx := nil;
    end;
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFNDEF BCB_FLAG}
procedure TTnEmulVT.Notification(
    AComponent : TComponent;
    Operation  : TOperation);
begin
    inherited Notification(AComponent, operation);
    if Operation = opRemove then begin
        if AComponent = FTnCnx then
            FTnCnx:= nil;
    end;
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.SetHostName(newValue : String);
begin
    FHostName := newValue;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnEmulVT.GetLocalEcho : Boolean;
begin
    if Assigned(FTnCnx) then
        Result := FTnCnx.LocalEcho
    else
        Result := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.RequestLocalEcho(newValue : Boolean);
begin
    if Assigned(FTnCnx) then begin
        if newValue then
            FTnCnx.DontOption(TN_ECHO)
        else
            FTnCnx.DoOption(TN_ECHO);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.SetLocation(Value : String);
begin
    if Assigned(FTnCnx) then
        FTnCnx.Location := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnEmulVT.GetLocation : String;
begin
    if Assigned(FTnCnx) then
        Result := FTnCnx.Location;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.Display(Msg : String);
begin
    WriteStr(Msg);
    Repaint;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.SetOnEndOfRecord(Value : TNotifyEvent);
begin
    if Assigned(FTnCnx) then
        FTnCnx.OnEndOfRecord := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnEmulVT.GetOnEndOfRecord : TNotifyEvent;
begin
    if Assigned(FTnCnx) then
        Result := FTnCnx.OnEndOfRecord;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.TnCnxSendLoc(Sender: TObject);
begin
    if Assigned(FOnSendLoc) then
        FOnSendLoc(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.TnCnxTermType(Sender: TObject);
begin
    if Assigned(FOnTermType) then
        FOnTermType(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.TnCnxLocalEcho(Sender: TObject);
begin
    if Assigned(FOnLocalEcho) then
        FOnLocalEcho(Self);
end;