adscript.pas

测试用例

          oBaud:
            TApdCustomComPort(Comport).Baud := StrToInt(tData);        

          oDataBits:
            TApdCustomComPort(Comport).DataBits := StrToInt(tData);    

          oFlow:
            SetFlow(tData);                                            

          oParity:
            SetParity(tData);                                          

          oStopBits:
            TApdCustomComPort(Comport).StopBits := StrToInt(tData);    

          oWsTelnet:
            if CheckWinsockPort then
              TApdCustomWinsockPort(ComPort).WsTelnet := Boolean(Timeout);

          oSetRetry:
            Retry := Timeout;

          oSetFilename:
            if CheckProtocol then
              Protocol.FileName := tData;                              

          oSetFileMask:
            if CheckProtocol then
              Protocol.FileMask := tData;                              

          oSetDirectory:
            if CheckProtocol then
              Protocol.DestinationDirectory := tData;                  

          oSetWriteRename:
            if CheckProtocol then
              Protocol.WriteFailAction := wfWriteRename;

          oSetWriteFail:
            if CheckProtocol then
              Protocol.WriteFailAction := wfWriteFail;

          oSetWriteAnyway:
            if CheckProtocol then
              Protocol.WriteFailAction := wfWriteAnyway;

          oSetZWriteProtect:
            if CheckProtocol then
              Protocol.ZmodemFileOption := zfoWriteProtect;

          oSetZWriteClobber:
            if CheckProtocol then
              Protocol.ZmodemFileOption  := zfoWriteClobber;

          oSetZWriteNewer:
            if CheckProtocol then
              Protocol.ZmodemFileOption := zfoWriteNewer;

          oSetZSkipNoFile:
            if CheckProtocol then
              Protocol.ZmodemSkipNoFile := Boolean(Timeout);
        end;

      scUpload,
      scDownload:
        if CheckProtocol then begin
          { Set a finish hook }
          SaveProtocolFinish := Protocol.OnProtocolFinish;
          Protocol.OnProtocolFinish := ScriptProtocolFinish;
          Protocol.ProtocolType := ValidateProtocol(tData);             
          { Deactivate terminal }
          if Assigned(FTerminal) then begin
            if FTerminal is TAdCustomTerminal then begin
              OldActive := TAdCustomTerminal(Terminal).Active;
              TAdCustomTerminal(Terminal).Active := False;
            end;
          end;

          { Start the transfer }
          if Command = scUpload then
            Protocol.StartTransmit
          else
            Protocol.StartReceive;
          ScriptState := ssWait;
        end else
          LastCondition := ccFail;

      scSendBreak:
        ComPort.SendBreak(Timeout, False);

      scChDir:
        ChDir(tData);                                                  

      scDelete:
        DeleteFiles(tData);                                            

      scGoto:
        { Goto label }
        NextIndex := FindLabel(tData);                                 

      scDisplay:
        ScriptDisplay(tData);                                          

      scDelay:
        begin
          TimerTrigger := ComPort.AddTimerTrigger;
          ComPort.SetTimerTrigger(TimerTrigger, MSecs2Ticks(Timeout), True);
          Continuing := True;
          ScriptState := ssWait;
        end;

      scRun:
        ExecuteExternal(tData, Boolean(Timeout));                      

      scUserFunction:                                                  
        begin                                                          
          if assigned (FOnScriptUserFunction) then                     
            FOnScriptUserFunction (Self, tData, tDataEx);              
        end;                                                           

      scExit:                                                          
        begin                                                          
          ScriptState := ssFinished;                                   
          if (tData = 'SUCCESS') or (tData = 'OK') or (tData = '') then   
            StopScript (ccSuccess)                                     
          else if tData = 'TIMEOUT' then                               
            StopScript (ccTimeout)                                     
          else if tData = 'FAIL' then                                  
            StopScript (ccFail)                                        
          else begin                                                   
            try                                                        
              StopScript (StrToInt (tData));                           
            except                                                     
              on EConvertError do                                      
                StopScript (ccBadExitCode);                            
            end;                                                       
          end;                                                         
        end;                                                           

    end;

    { Generate OnScriptPostStep event }
    ScriptCommandFinish(TApdScriptNode(CommandNodes[NodeIndex]),
                        LastCondition);
  end;

end;

{ Generate the OnScriptException event }                               
function TApdCustomScript.GenerateScriptException (E       : Exception; 
                                                   Command : TApdScriptNode) : Boolean; 
begin                                                                  
  Result := False;                                                     
  if assigned (FOnScriptException) then                                
    FOnScriptException (Self, E, Command, Result);                     
end;                                                                   

{ Process commands until we get to a wait state }
procedure TApdCustomScript.ProcessTillWait;
begin
  {$IFDEF DebugScript}
  WriteLn(Dbg,'entering ProcessTillWait');
  {$ENDIF}
  AddDispatchLogEntry ('Entering ProcessTillWait');                    

  repeat
    { Process the current command }
    try
      { Process the next command }
      if ScriptState = ssReady then
          ProcessNextCommand;

      { Set next command }
      NodeIndex := NextIndex;
      if NodeIndex = CommandNodes.Count then begin
        LastCondition := ccSuccess;
        ScriptState := ssFinished;
      end;
    except
      on E:Exception do begin                                          
        if not GenerateScriptException (E,                             
               TApdScriptNode(CommandNodes[NodeIndex])) then begin     
          ScriptState := ssFinished;
          LastCondition := ccFail;
        end else begin                                                 
          NodeIndex := NodeIndex + 1;                                  
          if NodeIndex = CommandNodes.Count then begin                 
            LastCondition := ccSuccess;                                
            ScriptState := ssFinished;                                 
          end;                                                         
        end;                                                           
      end;                                                             
    end;
  until (ScriptState > ssReady);

  { Waiting or finished? }
  if ScriptState = ssFinished then begin

    {$IFDEF DebugScript}
    ScriptState := ssWait;
    WriteLn(Dbg,'script is finished');
    {$ENDIF}

    AddDispatchLogEntry ('Script is finished');                        

    StopScript(LastCondition);

  end;

  {$IFDEF DebugScript}
  WriteLn(Dbg,'leaving ProcessTillWait: ' + IntToStr(Ord(ScriptState)));
  {$ENDIF}
  AddDispatchLogEntry ('Leaving ProcessTillWait ' +
                       IntToStr(Ord(ScriptState)));                    
end;

{ Start processing the script in the background }
procedure TApdCustomScript.StartScript;
begin
  if FInProgress then Exit;

  {$IFDEF DebugScript}
  WriteLn(Dbg,'entering StartScript');
  {$ENDIF}
  AddDispatchLogEntry ('Entering StartScript');                        

  { Error if no script... }
  if CommandNodes.Count = 0 then
    { ...but try to load first }
    PrepareScript;

  { Check for no commands }
  if CommandNodes.Count = 0 then                                       
    exit;                                                              
    
  { Inits }
  FInProgress := True;
  Attempts := 0;
  NodeIndex := 0;
  FillChar(DataTrigger, SizeOf(DataTrigger), 0);
  TimerTrigger := 0;
  ScriptState := ssReady;

  { Create a comport if none assigned }
  if not Assigned(FComPort) then begin
    FComPort := TApdComPort.Create(Self);
    CreatedPort := True;

    { If we have a terminal then add it as a port user }
    if Assigned(FTerminal) then begin

      { New terminal }
      if FTerminal is TAdCustomTerminal then begin
        TAdCustomTerminal(Terminal).ComPort := ComPort;
        ComPort.RegisterUser(Terminal.Handle);
      end;

    end;
  end else
    CreatedPort := False;

  { Process until we come till the first wait }
  ProcessTillWait;

  { Take over the comport's OnTrigger handler }
  SaveOnTrigger := ComPort.OnTrigger;
  ComPort.OnTrigger := AllTriggers;

  {$IFDEF DebugScript}
  WriteLn(Dbg,'leaving StartScript');
  {$ENDIF}
  AddDispatchLogEntry ('Leaving StartScript');                         

end;

{ Stop the script and cleanup everything }
procedure TApdCustomScript.StopScript(Condition: Integer);
var
  I: Integer;
begin
  if InProgress then begin

    { Clear all triggers }
    for I := 1 to TriggerCount do
      if DataTrigger[I] <> 0 then
        ComPort.RemoveTrigger(DataTrigger[I]);
    TriggerCount := 0;
    if TimerTrigger <> 0 then
      ComPort.RemoveTrigger(TimerTrigger);
    FillChar(DataTrigger, SizeOf(DataTrigger), 0);
    TimerTrigger := 0;

    { Port cleanups }
    if not CreatedPort then begin
      if OpenedPort then begin
        ComPort.Open := SaveOpen;
      end;
      ComPort.OnTrigger := SaveOnTrigger;
    end else
      { If we created the port, it will get disposed in Destroy }
      if Assigned(FTerminal) then
        ComPort.DeregisterUser(Terminal.Handle);

    if Assigned(FProtocol) then begin
    { Protocol cleanups }
      if CreatedProtocol then
        Protocol.Free
      else
        Protocol.OnProtocolFinish := SaveProtocolFinish;
    end;

    { Signal that script is finished }
    ScriptFinish(Condition);

    FInProgress := False;
  end;
end;

{ Cancel a script in progress }
procedure TApdCustomScript.CancelScript;
begin
  StopScript(ccFail);
end;

{ Fake a timeout so we can exit and re-enter via dispatcher }
procedure TApdCustomScript.GoContinue;
begin
  try
    TimerTrigger := ComPort.AddTimerTrigger;
    ComPort.SetTimerTrigger(TimerTrigger, 1, True);
    Continuing := True;
  except
    CancelScript;
  end;
end;

{ Called when protocol finishes, continues script processing }
procedure TApdCustomScript.ScriptProtocolFinish(CP: TObject; ErrorCode: Integer);
begin
  { Call previous... }
  if Assigned(SaveProtocolFinish) then
    SaveProtocolFinish(CP, ErrorCode);

  { Reactivate terminal }
  if Assigned(FTerminal) then begin

    if FTerminal is TAdTerminal then
      TAdTerminal(Terminal).Active := OldActive;

  end;

  { Set the protocol finish condition }
  if ErrorCode = ecOK then
    LastCondition := ccSuccess
  else
    LastCondition := ccFail;
  ScriptState := ssReady;

  { Don't need this anymore }
  Protocol.OnProtocolFinish := SaveProtocolFinish;

  { Continue with script }
  GoContinue;
end;

procedure TApdCustomScript.SetFlow(const FlowOpt: string);
begin
  if FlowOpt = 'RTS/CTS' then begin
    TApdCustomComport(ComPort).HWFlowOptions := [hwfUseRTS, hwfRequireCTS];
    TApdCustomComport(ComPort).SWFlowOptions := swfNone;
  end else if FlowOpt = 'XON/XOFF' then begin
    TApdCustomComport(ComPort).HWFlowOptions := [];
    TApdCustomComport(ComPort).SWFlowOptions := swfBoth;
  end else if FlowOpt = 'NONE' then begin
    TApdCustomComport(ComPort).HWFlowOptions := [];
    TApdCustomComport(ComPort).SWFlowOptions := swfNone;
  end;
end;

procedure TApdCustomScript.SetParity(const ParityOpt: string);
begin
  if ParityOpt = 'NONE' then
    TApdCustomComport(ComPort).Parity := pNone
  else if ParityOpt = 'ODD' then
    TApdCustomComport(ComPort).Parity := pOdd
  else if ParityOpt = 'EVEN' then
    TApdCustomComport(ComPort).Parity := pEven
  else if ParityOpt = 'MARK' then
    TApdCustomComport(ComPort).Parity := pMark
  else if ParityOpt = 'SPACE' then
    TApdCustomComport(ComPort).Parity := pSpace;
end;

{$IFDEF DebugScript}
initialization
  AssignFile(Dbg, 'debug.txt');
  Rewrite(Dbg);

finalization
  CloseFile(Dbg);
{$ENDIF}
end.