adscript.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   ADSCRIPT.PAS 4.06                   *}
{*********************************************************}
{* TApdScript component                                  *}
{*********************************************************}

{Conditional defines that may affect this unit}
{$I AWDEFINE.INC}

{Required options}
{$G+,X+,F+,I+}
{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}

{.$DEFINE DebugScript}   
{!!.02} { Remode references to Win16 }
unit AdScript;
  {-Script processor for Async Professional }

interface

uses
  {-----RTL}
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ShellAPI,
  {-----APD}
  OoMisc,
  AdExcept,
  AdPort,
  AdWnPort,
  AdTrmEmu,
  AdProtcl;

const

  { Various limits }
  MaxDataTriggers = 20;
  MaxCommandLength = 128;  { Maximum length of a script command }
  MaxCommands = 300;       { Maximum number of commands in a script file }
  DefRetryCnt = 3;         { Default retry count }
  MaxBufSize = 32767;      { Old value of MaxInt }

  { Defaults }
  DefDisplayToTerminal = True;

  { Other constants }
  CmdSepChar = '|';

  { Error codes }
  ecNotACommand      = 9901;  { First token is not a valid command }
  ecBadFormat1       = 9902;  { Bad format for 1st argument }
  ecBadFormat2       = 9903;  { Bad format for 2nd argument }
  ecInvalidLabel     = 9904;  { Referenced label doesn't exist }
  ecBadOption        = 9905;  { Bad option in SET command }
  ecTooManyStr       = 9906;  { Too many substrings in WaitMulti }
  ecNoScriptCommands = 9907;  { No script commands }
  ecCommandTooLong   = 9908;  { Length exceeds MaxCommandLength }
  ecNotWinsockPort   = 9909;  { Winsock used without a WinsockPort }

  { Condition codes }
  ccNone          = 0;     { Not assigned }
  ccSuccess       = 1;     { Last operation succeeded or first match }
  ccIndexFirst    = 1;     { First possible index }
                           { ...WAITMULTI matches }
  ccIndexLast     = 128;   { Last possible index }
  ccTimeout       = 1001;  { Last operation timed out }
  ccFail          = 1002;  { Last operation failed or too many timeouts }
  ccBadExitCode   = 1003;  { Tried to exit script with bad exit code } 

type
  { Exceptions }
  EApdScriptError = class(EApdException)
    constructor Create(Code: Cardinal; BadLineNum: Cardinal);
  end;

  { Types of script commands }
  TApdScriptCommand = (
    scNoCommand,         { Not a command }
    scComment,           { Comment }
    scLabel,             { A label that can be jumped to }
    scInitPort,          { Open a TApdCustomComPort in serial mode }
    scInitWnPort,        { Open a TApdWinsockPort in Winsock mode }
    scDonePort,          { Close a TApdCustomComPort }
    scSend,              { Send text }
    scWait,              { Wait timeout seconds for text }
    scWaitMulti,         { Wait for multiple strings }
    scIf,                { Check single condition and jump }
    scDisplay,           { Display string }
    scGoto,              { Unconditional jump }
    scSendBreak,         { Send break of N milliseconds }
    scDelay,             { Delay for N milliseconds }
    scSetOption,         { Set an option }
    scUpload,            { Transmit a file }
    scDownload,          { Receive a file }
    scChDir,             { Change drive/directory }
    scDelete,            { Delete file mask }
    scRun,               { Execute a command or application }
    scUserFunction,      { Execute a user function (via event) }       
    scExit);             { Exit script with return value }             

  { SET options }
  TOption = (
    oNone,
    oBaud,               { Set comport's Baud }
    oDataBits,           { Set comport's DataBits }
    oFlow,               { Set comport's flow control }
    oParity,             { Set comport's Parity }
    oStopBits,           { Set comport's StopBits }
    oWsTelnet,           { Set Winsock port's WsTelnet }
    oSetRetry,           { Set retry count }
    oSetDirectory,       { Set directory for uploads/downloads }
    oSetFilemask,        { Set filemask for uploads }
    oSetFilename,        { Set filename for receives }
    oSetWriteFail,       { Set WriteFail for protocol receives }
    oSetWriteRename,     { Set WriteRename for protocol receives }
    oSetWriteAnyway,     { Set WriteAnyway for protocol receives }
    oSetZWriteClobber,   { Set WriteClobber option for zmodem receives }
    oSetZWriteProtect,   { Set WriteProtect option for zmodem receives }
    oSetZWriteNewer,     { Set WriteNewer option for zmodem receives }
    oSetZSkipNoFile);    { Set SkipNoFile option true/false for zmodem receives }

  { Script node }
  TApdScriptNode = class(TObject)
    Command   : TApdScriptCommand;  { Command type }
    Data      : string;             { Data associated with command }
    DataEx    : string;             { Additional data associated with command }
    Option    : TOption;            { Option for SET commands }
    Timeout   : Cardinal;           { Timeout associated with command }
    Condition : Cardinal;           { Condition match }

    { Create a new node }
    constructor Create(ACommand: TApdScriptCommand; AnOption: TOption;
      const AData, ADataEx: string; ATimeout: Cardinal; ACondition: Cardinal);
  end;

  { Script execution states }
  TScriptState = (ssNone, ssReady, ssWait, ssFinished);

  { Script event types }
  TScriptFinishEvent = procedure(CP: TObject; Condition: Integer) of object;
  TScriptCommandEvent = procedure(CP: TObject; Node: TApdScriptNode;
                                  Condition: Integer) of object;
  TScriptDisplayEvent = procedure(CP: TObject; const Msg: string) of object;
  TScriptUserFunctionEvent = procedure (      CP        : TObject;
                                        const Command   : String;
                                        const Parameter : String) of object; 
  TScriptParseVariableEvent = procedure (      CP       : TObject;
                                         const Variable : String;
                                         var   NewValue : String) of object; 
  TScriptExceptionEvent = procedure (Sender   : TObject;               
                                     E        : Exception;             
                                     Command  : TApdScriptNode;        
                                     var Continue : Boolean) of object; 

  { Script processing object }
  TApdCustomScript = class(TApdBaseComponent)
  protected
    { Owned APRO components }
    FComPort        : TApdCustomComPort;
    FProtocol       : TApdCustomProtocol;
    FTerminal       : TApdBaseWinControl;

    { Loading fields }
    FScriptFile     : string;
    FScriptCommands : TStrings;
    CurrentLine     : Cardinal;
    Modified        : Boolean;
    CommandNodes    : TList;

    { Processing fields }
    NodeIndex          : Integer;
    NextIndex          : Integer;
    TimerTrigger       : Cardinal;
    DataTrigger        : array[1..MaxDataTriggers] of Cardinal;
    TriggerCount       : Cardinal;
    SaveOnTrigger      : TTriggerEvent;
    ScriptState        : TScriptState;
    CreatedPort        : Boolean;
    SaveOpen           : Boolean;
    OpenedPort         : Boolean;
    CreatedProtocol    : Boolean;
    LastCondition      : Cardinal;
    SaveProtocolFinish : TProtocolFinishEvent;
    OldActive          : Boolean;
    Continuing         : Boolean;
    Closing            : Boolean;
    Retry              : Byte;
    Attempts           : Byte;
    FInProgress        : Boolean;
    FDisplayToTerminal : Boolean;

    { Events }
    FOnScriptFinish        : TScriptFinishEvent;
    FOnScriptCommandStart  : TScriptCommandEvent;
    FOnScriptCommandFinish : TScriptCommandEvent;
    FOnScriptDisplay       : TScriptDisplayEvent;
    FOnScriptUserFunction  : TScriptUserFunctionEvent;                 
    FOnScriptParseVariable : TScriptParseVariableEvent;                
    FOnScriptException     : TScriptExceptionEvent;                    

    { Loading methods }
    procedure SetScriptFile(const NewFile: string);
    procedure SetScriptCommands(Values: TStrings);
    procedure ValidateLabels;
    procedure CreateCommand(CmdType: TApdScriptCommand;
      const Data1, Data2: string); virtual;
    procedure AddToScript(const S: string); virtual;

    { Validation methods }
    function CheckProtocol: Boolean;
    function CheckWinsockPort: Boolean;
    function ValidateBaud(const Baud: string): string;
    function ValidateDataBits(const DataBits: string): string;
    function ValidateFlow(const Flow: string): string;
    function ValidateParity(const Parity: string): string;
    function ValidateStopBits(const StopBits: string): string;

    { Processing methods }
    procedure AllTriggers(CP: TObject; Msg, TriggerHandle, Data: Word);
    procedure ExecuteExternal(const S: string; Wait: Boolean); virtual;
    procedure GoContinue;
    procedure ParseURL(const URL: string; var Addr, Port: string);
    procedure LogCommand (      Index   : Cardinal;
                                Command : TApdScriptCommand;           
                          const Node    : TApdScriptNode);             
    procedure ProcessNextCommand;
    procedure ProcessTillWait;
    procedure ScriptProtocolFinish(CP: TObject; ErrorCode: Integer);
    procedure SetFlow(const FlowOpt: string);
    procedure SetParity(const ParityOpt: string);

    { Event methods }
    procedure ScriptFinish(Condition: Integer); virtual;
    procedure ScriptCommandStart(Node: TApdScriptNode; Condition: Integer);
    procedure ScriptCommandFinish(Node: TApdScriptNode; Condition: Integer);
    procedure ScriptDisplay(const Msg: string);
    function GenerateScriptException (E       : Exception;             
                                      Command : TApdScriptNode) : Boolean; 

    { Misc methods }
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Loaded; override;
    procedure AddDispatchLogEntry (const Msg: String);                 

  public
    { Constructors/destructors }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    { Load script file }
    procedure PrepareScript;

    { Process script file }
    procedure StartScript;
    procedure StopScript(Condition: Integer);
    procedure CancelScript;

    { Processing }
    property InProgress: Boolean
      read FInProgress;

    property ComPort: TApdCustomComPort
      read FComPort write FComPort;
    property Protocol: TApdCustomProtocol
      read FProtocol write FProtocol;
    property Terminal: TApdBaseWinControl
      read FTerminal write FTerminal;
    property DisplayToTerminal: Boolean
      read FDisplayToTerminal write FDisplayToTerminal
      default DefDisplayToTerminal;
    property ScriptFile: string
      read FScriptFile write SetScriptFile;
    property ScriptCommands: TStrings
      read FScriptCommands write SetScriptCommands stored True;
    property OnScriptFinish: TScriptFinishEvent
      read FOnScriptFinish write FOnScriptFinish;
    property OnScriptCommandStart: TScriptCommandEvent
      read FOnScriptCommandStart write FOnScriptCommandStart;
    property OnScriptCommandFinish: TScriptCommandEvent
      read FOnScriptCommandFinish write FOnScriptCommandFinish;
    property OnScriptDisplay: TScriptDisplayEvent
      read FOnScriptDisplay write FOnScriptDisplay;
    property OnScriptParseVariable : TScriptParseVariableEvent         
             read FOnScriptParseVariable write FOnScriptParseVariable; 
    property OnScriptUserFunction : TScriptUserFunctionEvent           
             read FOnScriptUserFunction write FOnScriptUserFunction;
    property OnScriptException : TScriptExceptionEvent                 
             read FOnScriptException write FOnScriptException;         
  end;

  TApdScript = class(TApdCustomScript)
  published
    property ComPort;
    property Protocol;
    property Terminal;
    property DisplayToTerminal;
    property ScriptFile;
    property ScriptCommands;
    property OnScriptFinish;
    property OnScriptCommandStart;
    property OnScriptCommandFinish;
    property OnScriptDisplay;
    property OnScriptParseVariable;                                    
    property OnScriptUserFunction;                                     
  end;

{.$IFDEF DebugScript}                                                  
const
  { Types of script commands }
  ScriptStr: array[TApdScriptCommand] of string[14] = (                
    'scNoCommand',
    'scComment',
    'scLabel',
    'scInitPort',
    'scInitWnPort',
    'scDonePort',
    'scSend',
    'scWait',
    'scWaitMulti',
    'scIf',
    'scDisplay',
    'scGoto',
    'scSendBreak',
    'scDelay',
    'scSetOption',
    'scUpload',
    'scDownload',
    'scChDir',
    'scDelete',
    'scRun',
    'scUserFunction',                                                  
    'scExit');                                                         
{.$ENDIF}                                                              

{==========================================================================}

implementation

type
  StringBuffer = array[0..MaxCommandLength - 1] of Char;

{$IFDEF DebugScript}
var
  Dbg: Text;
{$ENDIF}

{ General purpose routines }

{ Return protocol type based on S }
function ValidateProtocol(const S: string): TProtocolType;
var
  TempStr: string;
begin
  TempStr := UpperCase(S);
  if TempStr = 'XMODEM' then
    ValidateProtocol := ptXmodem
  else if TempStr = 'XMODEMCRC' then
    ValidateProtocol := ptXmodemCRC
  else if TempStr = 'XMODEM1K' then
    ValidateProtocol := ptXmodem1K
  else if TempStr = 'XMODEM1KG' then
    ValidateProtocol := ptXmodem1KG
  else if TempStr = 'YMODEM' then
    ValidateProtocol := ptYmodem
  else if TempStr = 'YMODEMG' then
    ValidateProtocol := ptYmodemG
  else if TempStr = 'ZMODEM' then
    ValidateProtocol := ptZmodem
  else if TempStr = 'KERMIT' then
    ValidateProtocol := ptKermit
  else if TempStr = 'ASCII' then
    ValidateProtocol := ptAscii
  else
    ValidateProtocol := ptNoProtocol;
end;

{ Return a comport number from S }
function CheckComport(const S: string): Byte;
var
  Code: Integer;