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

Author:       Fran鏾is PIETTE
Description:  TTnScript component add scripting capabilities to TTnEmulVT
Creation:     February 24th, 1998
Version:      1.03
EMail:        http://users.swing.be/francois.piette  francois.piette@swing.be
              http://www.rtfm.be/fpiette             francois.piette@rtfm.be
              francois.piette@pophost.eunet.be
Support:      Use the mailing list twsocket@rtfm.be See website for details.
Legal issues: Copyright (C) 1998-2000 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
              <francois.piette@pophost.eunet.be>

              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.

Quick Reference:

TTnScript is a descendent from TTnEmulVT. It does exactly what TTnEmulVT does
(Ansi terminal emulation) and add some scripting capabilities.
TTnScript follows the received data and search in the data stream for
given strings. When found, an event handler is called.

Strings to search are specified by calling AddEvent. Each string is identified
by an ID (an integer number) which must be unique.

You can remove a string using RemoveEvent, passing the ID you gave when
inserting the string in the list. You can remove all the strings with
RemoveAllEvents.

Each string to search for is associated with another string which will be sent
by the component when the search string is found. This can be used for example
when you search for a login prompt ('login') to send the username when this
prompt is found. Same for password.

Each string to search for is also associated with an event handler which will
be triggered when the string is found, right after having sent the string to
send. This specific event can be used to customize what has to be done when
the string is found (for example update the user interface or query the user
for some value to send).

Finally, each string to search is associated with a set of flags which tells
the component some special actions such as ignoring character case when
comparing text, or make the string persistant (normaly when a string has been
found, it is removed from the list).

Strings are searched in the order they are added to the list. So it can be
very different if you add 'login' and 'password' to search for than if you
add 'login' only and then when 'login' is found, add 'password'.

To scan the data stream, the component use a circular buffer whose dimension
is 80 characters by default. You can change that by assigning InputBufferSize.
The buffer size should be at least twice the size of the longest string to
search. If you use an oversized buffer, you have a performance penalty because
the buffer is searched as each data packet comes into the stream.

An automatic login procedure could looks like this:
    TnScript1.AddEvent(1, 'login',    'root' + #13#10, [efIgnoreCase], nil);
    TnScript1.AddEvent(2, 'password', 'boss' + #13#10, [efIgnoreCase], nil);
    TnScript1.Connect;

The nil argument could be replaced by a procedure (event handler) to make some
computing when the string to search for is found. Here is an example:

    TnScript1.AddEvent(2, 'prompt', '', [efIgnoreCase], PromptEvent);

procedure TForm1.PromptEvent(Sender : TObject; ID : Integer);
begin
    .... Your code goes here. You can do everithing ....
    Label1.Caption := 'Logged !';
    TnScript1.SendStr('ls -l' + #13 + #10);    Like sending some data
end;

Updates:
Mar 14, 1999  V1.01 efIgnoreCase was ignored !
May 13, 1999  V1.02 Made all methods virtual.
Aug 20, 1999  V1.03 Added compile time options. Revised for BCB4.

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit TnScript;

{$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 DUMP}

uses
    Wintypes, WinProcs, Classes, SysUtils, TnEmulVT;

const
    TnScriptVersion    = 1.03;
    CopyRight : String = ' TTnScript (c) 1998-2000 F. Piette V1.03 ';

type
    TnScriptException = class(Exception);
    TEventHandler = procedure (Sender : TObject; ID : Integer) of object;
    TEventFlag    = (efIgnoreCase,         { Ignore case in comparaisons   }
                     efPersistent);        {Do not delete event when found }
    TEventFlags   = set of TEventFlag;
    TDisplayEvent = procedure (Sender : TObject; Msg : String) of object;
    TStringMatch  = procedure (Sender : TObject; ID : Integer) of object;

    TEventDescriptor = record
        ID      : Integer;
        Search  : String;
        ToSend  : String;
        Flags   : TEventFlags;
        Handler : TEventHandler;
    end;
    PEventDescriptor = ^TEventDescriptor;

    TTnScript = class(TTnEmulVT)
    protected
        FEventList        : TList;
        FInputBuffer      : PChar;
        FInputBufferSize  : Integer;
        FInputBufferCount : Integer;
        FInputBufferStart : Integer;
        FOnDisplay        : TDisplayEvent;
        FOnStringMatch    : TStringMatch;
        function  SearchEvent(ID : Integer) : Integer; virtual;
        procedure TriggerDataAvailable(Buffer: PChar; Len: Integer); override;
        function  FindEventString(S : String; Flags : TEventFlags) : Integer; virtual;
        procedure ScanEvents; virtual;
        procedure ProcessInputData(Buffer: PChar; Len: Integer); virtual;
        procedure TriggerDisplay(Msg : String); virtual;
        procedure TriggerStringMatch(ID : Integer); virtual;
        procedure NextOne(var N : Integer); virtual;
        procedure SetInputBufferSize(newSize : Integer); virtual;
    public
        constructor Create(AOwner : TComponent); override;
        destructor  Destroy; override;
        procedure AddEvent(ID      : Integer;
                           Search  : String;
                           ToSend  : String;
                           Flags   : TEventFlags;
                           Handler : TEventHandler); virtual;
        procedure RemoveEvent(ID : Integer); virtual;
        procedure RemoveAllEvents; virtual;
    published
        property InputBufferSize : Integer         read  FInputBufferSize
                                                   write SetInputBufferSize;
        property OnDisplay : TDisplayEvent         read  FOnDisplay
                                                   write FOnDisplay;
        property OnStringMatch : TStringMatch      read  FOnStringMatch
                                                   write FOnStringMatch;

    end;

procedure Register;

implementation

{$IFDEF DUMP}
const
    CtrlCode : array [0..31] of String = ('NUL', 'SOH', 'STX', 'ETX',
                                          'EOT', 'ENQ', 'ACK', 'BEL',
                                          'BS',  'HT',  'LF',  'VT',
                                          'FF',  'CR',  'SO',  'SI',
                                          'DLE', 'DC1', 'DC2', 'DC3',
                                          'DC4', 'NAK', 'SYN', 'ETB',
                                          'CAN', 'EM',  'SUB', 'ESC',
                                          'FS',  'GS',  'RS',  'US');
{$ENDIF}

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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TTnScript.Create(AOwner : TComponent);
begin
    inherited Create(AOwner);
    FEventList := TList.Create;
    SetInputBufferSize(80);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TTnScript.Destroy;
begin
    if Assigned(FEventList) then begin
        FEventList.Free;
        FEventList := nil;
    end;
    if FInputBuffer <> nil then begin
        FreeMem(FInputBuffer, FInputBufferSize);
        FInputBuffer := nil;
    end;
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Set the input buffer size. This will clear any data already in the buffer }
procedure TTnScript.SetInputBufferSize(newSize : Integer);
begin
    { Round the size to the nearest upper 16 bytes limit }
    newSize := ((newSize shr 4) + 1) shl 4;

    { If no change, do nothing }
    if FInputBufferSize = newSize then
        Exit;

    { If buffer already allocated, free it }
    if FInputBuffer <> nil then begin
        FreeMem(FInputBuffer, FInputBufferSize);
        FInputBuffer := nil;
    end;

    { Allocate a new buffer of the given size }
    FInputBufferSize := newSize;
    GetMem(FInputBuffer, FInputBufferSize);

    { Clear the markers }
    FInputBufferStart := 0;
    FInputBufferCount := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnScript.TriggerDisplay(Msg : String);
begin
    if Assigned(FOnDisplay) then
        FOnDisplay(Self, Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnScript.TriggerStringMatch(ID : Integer);
begin
    if Assigned(FOnStringMatch) then
        FOnStringMatch(Self, ID);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnScript.SearchEvent(ID : Integer) : Integer;
begin
    if Assigned(FEventList) then begin
        for Result := 0 to FEventList.Count - 1 do begin
            if PEventDescriptor(FEventList.Items[Result])^.ID = ID then
                Exit;
        end;
    end;
    Result := -1;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Add an event (a string to search for) to the list                         }
procedure TTnScript.AddEvent(
    ID      : Integer;