adscript.pas

测试用例

  if Assigned(FComport) then begin
    if not (FComport is TApdWinsockPort) then
      raise EApdScriptError.Create(ecNotWinsockPort, CurrentLine);
  end else begin
    FComport := TApdWinsockPort.Create(Self);
    CreatedPort := True;
  end;
  Result := Assigned(FComport);
end;

{ Validate and format baud }
function TApdCustomScript.ValidateBaud(const Baud: string): string;
var
  I: Integer;
begin
  Result := UpperCase(Baud);
  for I := 1 to Length(Result) do begin
    if Pos(Result[I], '1234567890') <> 0 then Continue;
    raise EApdScriptError.Create(ecBadOption, CurrentLine);
  end;
end;

{ Validate and format databits }
function TApdCustomScript.ValidateDataBits(const DataBits: string): string;
begin
  Result := UpperCase(DataBits);
  if Result = '5' then Exit;
  if Result = '6' then Exit;
  if Result = '7' then Exit;
  if Result = '8' then Exit;
  raise EApdScriptError.Create(ecBadOption, CurrentLine);
end;

{ Validate and format flow }
function TApdCustomScript.ValidateFlow(const Flow: string): string;
begin
  Result := UpperCase(Flow);
  if Result = 'RTS/CTS' then Exit;
  if Result = 'XON/XOFF' then Exit;
  if Result = 'NONE' then Exit;
  raise EApdScriptError.Create(ecBadOption, CurrentLine);
end;

{ Validate and format parity }
function TApdCustomScript.ValidateParity(const Parity: string): string;
begin
  Result := UpperCase(Parity);
  if Result = 'NONE' then Exit;
  if Result = 'ODD' then Exit;
  if Result = 'EVEN' then Exit;
  if Result = 'MARK' then Exit;
  if Result = 'SPACE' then Exit;
  raise EApdScriptError.Create(ecBadOption, CurrentLine);
end;

{ Validate and format stopbits }
function TApdCustomScript.ValidateStopBits(const StopBits: string): string;
begin
  Result := UpperCase(StopBits);
  if Result = '1' then Exit;
  if Result = '2' then Exit;
  raise EApdScriptError.Create(ecBadOption, CurrentLine);
end;


{ Process all script triggers }
procedure TApdCustomScript.AllTriggers(CP: TObject; Msg, TriggerHandle, Data: Word);
var
  I: Integer;
  {.$IFDEF DebugScript}
  S: string;
  {.$ENDIF}

  { Remove data and timer triggers }
  procedure RemoveTriggers;
  var
    I: Integer;
  begin
    for I := 1 to MaxDataTriggers 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;
  end;

begin

  {.$IFDEF DebugScript}
  case Msg of
    APW_TRIGGERAVAIL : S := 'APW_TRIGGERAVAIL';
    APW_TRIGGERDATA  : S := 'APW_TRIGGERDATA';
    APW_TRIGGERTIMER : S := 'APW_TRIGGERTIMER';
    APW_TRIGGERSTATUS: S := 'APW_TRIGGERSTATUS';
    else                S := IntToStr(Msg);
  end;

  AddDispatchLogEntry ('Entering AllTrigers' + S + ' ' +
                       IntToStr (TriggerHandle) + ' ' +
                       IntToStr (Data));

  {$IFDEF DebugScript}
  WriteLn(Dbg,'entering AllTriggers: ', S, ' ',
           TriggerHandle, ' ', Data);
  {$ENDIF}

  { Call the old OnTrigger }
  if Assigned(SaveOnTrigger) then
    SaveOnTrigger(CP, Msg, TriggerHandle, Data);

  { Check for timeouts }
  if (Msg = APW_TRIGGERTIMER) and (TriggerHandle = TimerTrigger) then begin
    {$IFDEF DebugScript}
    WriteLn(Dbg,'got timeout trigger');
    {$ENDIF}
    AddDispatchLogEntry ('Got timeout trigger');


    { Got a timeout, remove triggers and continue processing script }
    RemoveTriggers;
    if not Continuing then begin
      { A real timeout, check for retries }
      Inc(Attempts);
      if Attempts >= Retry then
        LastCondition := ccFail
      else
        LastCondition := ccTimeout;
    end else
      { Just using a timer to regain control, don't change condition }
      Continuing := False;

    { Continue processing }
    ScriptState := ssReady;
    ProcessTillWait;
  end else if (Msg = APW_TRIGGERDATA) then begin
    for I := 1 to TriggerCount do begin
      if TriggerHandle = DataTrigger[I] then begin
        {$IFDEF DebugScript}
        WriteLn(Dbg,'got data trigger');
        {$ENDIF}

        AddDispatchLogEntry ('Got data trigger');

        { Got a data trigger match, remove triggers and go process }
        RemoveTriggers;
        LastCondition := I;
        ScriptState := ssReady;
        ProcessTillWait;

        { Reset attempt count for next go'round }
        Attempts := 0;
      end;
    end;
  end;

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

{ Execute command }
procedure TApdCustomScript.ExecuteExternal(const S: string; Wait: Boolean);
var
  Str : PChar;
begin
  Str := StrAlloc(Length(S)+1);
  StrPCopy(Str, S);
  try
    if Wait then
      ApWinExecAndWait32(Str, nil, SW_SHOWNORMAL)
    else
      ShellExecute(0, nil, Str, nil, nil, SW_SHOWNORMAL);
  finally
    StrDispose(Str);
  end;
end;

{ Separate URL into address and port elements }
procedure TApdCustomScript.ParseURL(const URL: string; var Addr, Port: string);
var
  TempStr: string;
  Psn: Integer;
begin
  if URL = '' then Exit;

  { Strip protocol if it exists }
  Psn := Pos('//', URL);
  if Psn = 0 then begin
    TempStr := URL;
  end else begin
    TempStr := Copy(URL, Psn+2, (Length(URL) - Psn+2));
  end;

  { Separate Address and Port }
  Psn := Pos(':', TempStr);
  if Psn = 0 then begin
    Addr := TempStr;
    Port := 'telnet';
  end else begin
    Addr := Copy(TempStr, 1, Psn-1);
    Port := Copy(TempStr, Psn+1, (Length(TempStr) - Psn+1));
  end;
end;

{$IFDEF DebugScript}

{ Write the current command to debug }
procedure WriteCommand(Index: Cardinal; const Node: TApdScriptNode);
begin
  with Node do
    WriteLn(Dbg,'index: ', Index, '  command: ',
          ScriptStr[Command], ' ',
          Data, ' ',
          Timeout, ' ',
          Condition);
end;
{$ENDIF}

procedure TApdCustomScript.LogCommand (      Index   : Cardinal;       
                                             Command : TApdScriptCommand; 
                                       const Node    : TApdScriptNode);
begin                                                                  
  AddDispatchLogEntry ('Index: ' + IntToStr(Index) +                   
      '  Command: ' +                                                  
      ScriptStr[TApdScriptNode(CommandNodes[Index]).Command] +         
      ' ' + TApdScriptNode(CommandNodes[Index]).Data +                 
      ' ' + IntToStr(TApdScriptNode(CommandNodes[Index]).TimeOut) +    
      ' ' + IntToStr(TApdScriptNode(CommandNodes[Index]).Condition));  
end;                                                                   

{ Process a script command }
procedure TApdCustomScript.ProcessNextCommand;
var
  I: Integer;
  Addr, Port: string;
  tData, tDataEx: string;                                              


  { Return the index of the label named Name }
  function FindLabel(const Name: string): Integer;
  var
    I: Integer;
  begin
    for I := 0 to CommandNodes.Count-1 do
      with TApdScriptNode(CommandNodes[I]) do begin
        if (Command = scLabel) and (Data = Name) then begin
          Result := I;
          Exit;
        end;
      end;

    { Can't ever get here....but if we do force the script to exit }
    Result := CommandNodes.Count;
  end;

  { Add all substring triggers }
  procedure AddMultiTriggers(S: string);
  var
    Len    : Byte;
    SepPos : Byte;
    Sub    : string;
  begin
    FillChar(DataTrigger, SizeOf(DataTrigger), 0);
    TriggerCount := 0;
    repeat
      SepPos := Pos(CmdSepChar, S);
      if SepPos = 0 then
        Len := 255
      else
        Len:= SepPos-1;
      Sub := Copy(S, 1, Len);
      Inc(TriggerCount);
      DataTrigger[TriggerCount] := ComPort.AddDataTrigger(Sub, True);
      Delete(S, 1, SepPos);
    until SepPos = 0;
  end;

  function ParseUserVariables (const S : string) : string;             
  begin                                                                
    result := S;                                                       
    if Length(S) > 0 then                                              
      if S[1] = '$' then                                               
        if assigned (FOnScriptParseVariable) then begin                
          FOnScriptParseVariable (Self, S, Result);                    
        end;                                                           
  end;                                                                 

begin
  with TApdScriptNode(CommandNodes[NodeIndex]) do begin
    {$IFDEF DebugScript}

    WriteCommand(NodeIndex, TApdScriptNode(CommandNodes[NodeIndex]));
    {$ENDIF}
    LogCommand (NodeIndex, Command, TApdScriptNode(CommandNodes[NodeIndex])); 

    { Generate OnScriptCommandStart event }
    ScriptCommandStart(TApdScriptNode(CommandNodes[NodeIndex]),
                       LastCondition);

    { Process it... }
    NextIndex := NodeIndex + 1;
    ScriptState := ssReady;

    tData := ParseUserVariables (Data);                                
    tDataEx := ParseUserVariables (DataEx);                            

    case Command of
      scLabel: { Advance to next command } ;

      scInitPort:
        begin
          OpenedPort := True;
          SaveOpen := ComPort.Open;
          ComPort.DeviceLayer := dlWin32;
          ComPort.ComNumber := CheckComPort(tData);                    
          ComPort.Open := True;
        end;

      scInitWnPort:
        begin
          OpenedPort := True;
          SaveOpen := ComPort.Open;
          if CheckWinsockPort then begin
            ParseURL(tData, Addr, Port);                               
            TApdCustomWinsockPort(ComPort).DeviceLayer := dlWinsock;
            TApdCustomWinsockPort(ComPort).WsAddress := Addr;
            TApdCustomWinsockPort(ComPort).WsPort := Port;
            ComPort.Open := True;
          end;
        end;

      scDonePort:
        begin
          OpenedPort := False;
          ComPort.Open := False;
        end;

      scSend :
        { Send the data }
        ComPort.Output := tData;                                       

      scWait :
        { Set up triggers to do the waiting }
        try
          { Add/set the triggers }
          DataTrigger[1] := 0;
          TimerTrigger := 0;
          TriggerCount := 1;
          DataTrigger[1] := ComPort.AddDataTrigger(tData, True);       
          TimerTrigger := ComPort.AddTimerTrigger;
          ComPort.SetTimerTrigger(TimerTrigger, MSecs2Ticks(Timeout), True);
          ScriptState := ssWait;
        except
          { Cleanup triggers and reraise exception }
          if DataTrigger[1] <> 0 then
            ComPort.RemoveTrigger(DataTrigger[1]);
          FillChar(DataTrigger, SizeOf(DataTrigger), 0);
          if TimerTrigger <> 0 then
          ComPort.RemoveTrigger(TimerTrigger);
          TriggerCount := 0;
          TimerTrigger := 0;
          raise;
        end;

      scWaitMulti:
        try
          { Add/set triggers }
          FillChar(DataTrigger, SizeOf(DataTrigger), 0);
          AddMultiTriggers(tData);                                     
          TimerTrigger := ComPort.AddTimerTrigger;
          ComPort.SetTimerTrigger(TimerTrigger, MSecs2Ticks(Timeout), True);
          ScriptState := ssWait;
        except
          for I := 1 to MaxDataTriggers do
            if DataTrigger[I] <> 0 then
              ComPort.RemoveTrigger(DataTrigger[I]);
          FillChar(DataTrigger, SizeOf(DataTrigger), 0);
          TriggerCount := 0;
          if TimerTrigger <> 0 then
            ComPort.RemoveTrigger(TimerTrigger);
          TimerTrigger := 0;
          raise;
        end;

      scIf  :
        { If processing }
        if Condition = LastCondition then begin
          { Matches last condition, jump to specified label }
          NextIndex := FindLabel(tData);                               
          {$IFDEF DebugScript}
          WriteLn(Dbg,'  matched  ');
          {$ENDIF}
          AddDispatchLogEntry ('  Matched ');                          
        end else begin
          {$IFDEF DebugScript}
          WriteLn(Dbg,'  not matched  ');
          {$ENDIF}
          AddDispatchLogEntry ('  not matched ');                      
        end;

      scSetOption:
        case Option of