adscript.pas

测试用例

      Result := ccSuccess
    else if TempStr = 'TIMEOUT' then
      Result := ccTimeout
    else if TempStr = 'FAIL' then
      Result := ccFail
    else if not Str2Card(S, Result) then
      Result := ccNone;
  end;

  procedure ConvertCtlChars(const S: string);
  var
    I, J: Integer;
  begin
    J := 0;
    I := 1;
    while (I <= Length(S)) do begin
      if S[I] <> '^' then
        StrBuffer[J] := S[I]
      else begin
        if S[I+1] = '^' then
          StrBuffer[J] := '^'
        else
          StrBuffer[J] := Char(Byte(Upcase(S[I+1]))-Ord('@'));
        Inc(I);
      end;
      Inc(J);
      Inc(I);
      if (J > MaxCommandLength) then
        raise EApdScriptError.Create(ecCommandTooLong, CurrentLine);
    end;
    {$IFOPT H+}
    SetLength(Data, J);
    {$ELSE}
    Data[0] := Char(J);
    {$ENDIF}
    Move (StrBuffer, Data[1], J);
  end;

  { Typecast timeout to boolean }
  procedure SetTrueFalse;
  var
    TempStr: string;
  begin
    TempStr := UpperCase(Data2);
    if (TempStr = 'TRUE') or (TempStr = 'ON') then
      Timeout := Cardinal(True)
    else if (TempStr = 'FALSE') or (TempStr = 'OFF') then
      Timeout := Cardinal(False)
    else
       raise EApdScriptError.Create(ecBadFormat2, CurrentLine);
  end;

  { Verify Data1 is a valid option and save data }
  procedure SetOption;
  var
    TempStr: string;
  begin
    TempStr := UpperCase(Data1);
    if TempStr = 'BAUD' then begin
      Option := oBaud;
      Data := ValidateBaud(Data2);
    end else if TempStr = 'DATABITS' then begin
      Option := oDataBits;
      Data := ValidateDataBits(Data2);
    end else if TempStr = 'FLOW' then begin
      Option := oFlow;
      Data := ValidateFlow(Data2);
    end else if TempStr = 'PARITY' then begin
      Option := oParity;
      Data := ValidateParity(Data2);
    end else if TempStr = 'STOPBITS' then begin
      Option := oStopBits;
      Data := ValidateStopBits(Data2);
    end else if TempStr = 'WSTELNET' then begin
      Option := oWsTelnet;
      SetTrueFalse;
    end else if TempStr = 'RETRY' then begin
      Option := oSetRetry;
      if not Str2Card(Data2, Timeout) then
        raise EApdScriptError.Create(ecBadFormat2, CurrentLine);
    end else if TempStr = 'DIRECTORY' then begin
      Option := oSetDirectory;
      Data := UpperCase(Data2);
    end else if TempStr = 'FILEMASK' then begin
      Option := oSetFilemask;
      Data := UpperCase(Data2);
    end else if TempStr = 'FILENAME' then begin
      Option := oSetFilename;
      Data := UpperCase(Data2);
    end else if TempStr = 'WRITEFAIL' then
      Option := oSetWriteFail
    else if TempStr = 'WRITERENAME' then
      Option := oSetWriteRename
    else if TempStr = 'WRITEANYWAY' then
      Option := oSetWriteAnyway
    else if TempStr = 'ZWRITECLOBBER' then
      Option := oSetZWriteClobber
    else if TempStr = 'ZWRITEPROTECT' then
      Option := oSetZWriteProtect
    else if TempStr = 'ZWRITENEWER' then
      Option := oSetZWriteNewer
    else if TempStr = 'ZSKIPNOFILE' then begin
      Option := oSetZSkipNoFile;
      SetTrueFalse;
    end else begin
      raise EApdScriptError.Create(ecBadOption, CurrentLine);
      Exit;
    end;
  end;

  { Count the number of separator chars }
  function ValidateWaitMulti(const S: string): Boolean;
  var
    I: Integer;
    Count: Cardinal;
  begin
    Count := 0;
    for I := 1 to Length(S) do
      if S[I] = CmdSepChar then
        Inc(Count);
    ValidateWaitMulti := Count <= MaxDataTriggers;
  end;

begin
  { Convert data accordingly }
  Data := '';
  Condition := ccNone;
  Timeout := 0;
  Option := oNone;

  case CmdType of
    scLabel:
      begin
        {$IFOPT H+}
        SetLength(Data, Length(Data1));
        {$ELSE}
        Data[0] := Data1[0];
        {$ENDIF}
        Data := Copy(Data1, 2, 255);
      end;

    scSend:
      ConvertCtlChars(Data1);

    scInitPort:
      begin
        Data := Data1;
        if CheckComPort(Data1) = 0 then
          raise EApdScriptError.Create(ecBadFormat1, CurrentLine);
      end;

    scInitWnPort:
      begin
        Data := Data1;
        DataEx := Data2;
        CheckWinsockPort;
      end;

    scDonePort:
      ;

    scWait:
      begin
        ConvertCtlChars(Data1);
        if not Str2Card(Data2, Timeout) then
          raise EApdScriptError.Create(ecBadFormat2, CurrentLine);
      end;

    scIf:
      begin
        Condition := ClassifyCondition(Data1);
        if Condition = ccNone then
          raise EApdScriptError.Create(ecBadFormat1, CurrentLine);
        Data := UpperCase(Data2);
      end;

    scDisplay:
      ConvertCtlChars(Data1);

    scGoto:
      Data := UpperCase(Data1);

    scSendBreak:
      if not Str2Card(Data1, Timeout) then
        raise EApdScriptError.Create(ecBadFormat2, CurrentLine);

    scDelay:
      if not Str2Card(Data1, Timeout) then
        raise EApdScriptError.Create(ecBadFormat2, CurrentLine);

    scSetOption:
      SetOption;

    scUpload,
    scDownload:
      if ValidateProtocol(Data1) = ptNoProtocol then
        raise EApdScriptError.Create(ecBadFormat2, CurrentLine)
      else
        Data := UpperCase(Data1);
    scChDir:
      Data := UpperCase(Data1);

    scDelete:
      Data := UpperCase(Data1);

    scWaitMulti:
      begin
        Data := UpperCase(Data1);
        if not Str2Card(Data2, TimeOut) then
          raise EApdScriptError.Create(ecBadFormat2, CurrentLine);
        if not ValidateWaitMulti(Data1) then
          raise EApdScriptError.Create(ecTooManyStr, CurrentLine);
      end;

    scRun:
      begin
        Data := Data1;
        SetTrueFalse;
      end;

    scUserFunction:
      begin
        Data := Data1;
        DataEx := Data2;
      end;

    scExit:
      begin
        Data := UpperCase(Data1);
      end;

  end;

  { Add it... }
  Node := TApdScriptNode.Create(CmdType, Option, Data, DataEx, Timeout, Condition);
  CommandNodes.Add(Node);
end;

{ Parse command, add to list, return False if error }
procedure TApdCustomScript.AddToScript(const S: string);
var
  CmdType: TApdScriptCommand;
  Index  : Byte;
  Cmd    : string;
  Data1  : string;
  Data2  : string;

  { Skip data until non-white }
  procedure SkipWhite;
  begin
    if (Index < Length(S)) then
      while ((S[Index] <= ' ') or (S[Index] > #127) or (S[Index] = ',')) and
            (Index < Length(S)) do
        Inc(Index);
  end;

  { Return the next token }
  function GetToken(IsCmd: Boolean): string;
  var
    I     : Byte;
    Delim1: Char;
    Delim2: Char;
    Token : string;
    StrBuffer: StringBuffer;

  begin
    I := 0;

    { if comment, get out quickly }
    if (S[Index] = ';') and IsCmd then begin
      CmdType := scComment;
      Exit;
    end;

    { Handle quotes if present }
    if S[Index] = '''' then begin
      Inc(Index);
      Delim1 := '''';
      Delim2 := '''';
    end else begin
      Delim1 := ' ';
      Delim2 := ',';
    end;

    { Search for ending quote or blank }
    while (S[Index] <> Delim1) and
          (S[Index] <> Delim2) and
          (Index <= Length(S)) do begin
      StrBuffer[I] := S[Index];
      Inc(I);
      Inc(Index);
      if (I > MaxCommandLength) then
        raise EApdScriptError.Create(ecCommandTooLong, CurrentLine);
    end;

    { Skip past ending quote if necessary }
    if Delim1 = '''' then
      Inc(Index);

    {$IFOPT H+}
    SetLength(Token, I);
    {$ELSE}
    Token[0] := Char(I);
    {$ENDIF}

    Move(StrBuffer, Token[1], I);
    GetToken := Token;
  end;

  { Return command class }
  function ClassifyToken(S: string): TApdScriptCommand;
  begin
    if Length(S) = 0 then
      ClassifyToken := scComment
    else if S[1] = ':' then
      ClassifyToken := scLabel
    else if S = 'INITPORT' then
      ClassifyToken := scInitPort
    else if S = 'INITWNPORT' then
      ClassifyToken := scInitWnPort
    else if S = 'DONEPORT' then
      ClassifyToken := scDonePort
    else if S = 'SEND' then
      ClassifyToken := scSend
    else if S = 'WAIT' then
      ClassifyToken := scWait
    else if S = 'IF' then
      ClassifyToken := scIf
    else if S = 'DISPLAY' then
      ClassifyToken := scDisplay
    else if S = 'GOTO' then
      ClassifyToken := scGoto
    else if S = 'SENDBREAK' then
      ClassifyToken := scSendBreak
    else if S = 'DELAY' then
      ClassifyToken := scDelay
    else if S = 'SET' then
      ClassifyToken := scSetOption
    else if S = 'UPLOAD' then
      ClassifyToken := scUpload
    else if S = 'DOWNLOAD' then
      ClassifyToken := scDownload
    else if S = 'CHDIR' then
      ClassifyToken := scChDir
    else if S = 'DELETE' then
      ClassifyToken := scDelete
    else if S = 'WAITMULTI' then
      ClassifyToken := scWaitMulti
    else if S = 'RUN' then
      ClassifyToken := scRun
    else if S[1] = '&' then
      ClassifyToken := scUserFunction
    else if S = 'EXIT' then
      ClassifyToken := scExit
    else
      ClassifyToken := scNoCommand;
  end;

begin
  { Get up to three tokens }
  if (S = '') then
    CmdType := scComment
  else begin
    CmdType := scNoCommand;
    Index := 1;
    SkipWhite;
    Cmd := UpperCase(GetToken(True));
    if (CmdType <> scComment) then begin
      SkipWhite;
      Data1 := GetToken(False);
      SkipWhite;
      Data2 := GetToken(False);
    end;
  end;

  { Process tokens }
  if CmdType <> scComment then
    CmdType := ClassifyToken(Cmd);
  case CmdType of
    scComment: { Comment, ignore line }
      ;
    scNoCommand   : { Error, bad command }
      raise EApdScriptError.Create(ecNotACommand, CurrentLine);
    scUserFunction:
      CreateCommand(CmdType, Cmd, Data1);
    scLabel  : { Label, create node }
      CreateCommand(CmdType, Cmd, '');
    else        { Command, create node }
      CreateCommand(CmdType, Data1, Data2);
  end;
end;

{ Assure protocol exists, create if not, return True if okay }
function TApdCustomScript.CheckProtocol: Boolean;
begin
  if not Assigned(FProtocol) then begin
    FProtocol := TApdProtocol.Create(Self);
    CreatedProtocol := True;
  end;
  Result := Assigned(FProtocol);
end;

{ Assure WinsockPort exists, create or raise exception if not }
function TApdCustomScript.CheckWinsockPort: Boolean;
begin