adscript.pas

测试用例

  ComPort: Byte;
  TempStr: string;
begin
  TempStr := UpperCase(S);
  CheckComPort := 0;
  if Copy(TempStr, 1, 3) = 'COM' then begin
    TempStr := Copy(TempStr, 4, 255);
    Val(TempStr, ComPort, Code);
    if Code = 0 then
      CheckComPort := ComPort;
  end;
end;

{ Convert a string to a cardinal }
function Str2Card(const S: string; var C: Cardinal): Boolean;
var
  Code: Integer;
begin
  Val(S, C, Code);
  Result := (Code = 0);
end;

{ Delete all files matching Mask }
procedure DeleteFiles(const Mask: string);
var
  SRec: TSearchRec;
begin
  if FindFirst(Mask, faAnyFile, SRec) = 0 then
    repeat
      SysUtils.DeleteFile(SRec.Name);
    until FindNext(SRec) <> 0;
  SysUtils.FindClose(SRec);
end;

{ Search for a terminal in the same form as TComponent }
function SearchTerminal(const C: TComponent): TApdBaseWinControl;

  function FindTerminal(const C: TComponent): TApdBaseWinControl;
  var
    I: Integer;
  begin
    Result := nil;
    if not Assigned(C) then
      Exit;

    { Look through all of the owned components }
    for I := 0 to C.ComponentCount-1 do begin
      if C.Components[I] is TApdBaseWinControl then begin

        { Look for new terminal }
        if C.Components[I] is TAdCustomTerminal then begin
          Result := TApdBaseWinControl(C.Components[I]);
          Exit;
        end;
      end;

      { If this isn't one, see if it owns other components }
      Result := FindTerminal(C.Components[I]);
    end;
  end;

begin
  { Search the entire form }
  Result := FindTerminal(C);
end;

{ Search for a protocol in the same form as TComponent }
function SearchProtocol(const C: TComponent): TApdCustomProtocol;

  function FindProtocol(const C: TComponent): TApdCustomProtocol;
  var
    I: Integer;
  begin
    Result := nil;
    if not Assigned(C) then
      Exit;

    { Look through all of the owned components }
    for I := 0 to C.ComponentCount-1 do begin
      if C.Components[I] is TApdCustomProtocol then begin
        Result := TApdCustomProtocol(C.Components[I]);
        Exit;
      end;

      { If this isn't one, see if it owns other components }
      Result := FindProtocol(C.Components[I]);
    end;
  end;

begin
  { Search the entire form }
  Result := FindProtocol(C);
end;

{ EApdScriptError }

constructor EApdScriptError.Create(Code: Cardinal; BadLineNum: Cardinal);
var
  Msg: string;
begin
  case Code of
    ecNotACommand:
      Msg := 'Not a valid script command';
    ecBadFormat1:
      Msg := 'Bad format for first parameter' + #13 + 'or first parameter missing';
    ecBadFormat2:
      Msg := 'Bad format for second parameter' + #13 + 'or second parameter missing';
    ecInvalidLabel:
      Msg := 'Label is referenced but never defined';
    ecBadOption:
      Msg := 'Bad option in SET command';
    ecTooManyStr:
      Msg := 'Too many strings in WaitMulti command';
    ecCommandTooLong:
      Msg := 'Command string too long';
    ecNotWinsockPort:
      Msg := 'ComPort must be a TApdWinsockPort';
    else
      Msg := 'DOS error ' + IntToStr(Code) + ' while processing script';
  end;
  CreateUnknown('Script Error : ' + Msg + '. Line : ' + IntToStr(BadLineNum), 0);
end;

{ TApdScriptNode }

{ Create a script node }
constructor TApdScriptNode.Create(ACommand: TApdScriptCommand; AnOption: TOption;
  const AData, ADataEx: string; ATimeout: Cardinal; ACondition: Cardinal);
begin
  inherited Create;
  Command := ACommand;
  Option := AnOption;
  Data := AData;
  DataEx := ADataEx;
  Timeout := ATimeout;
  Condition := ACondition;
end;

{ TApdScript }

{ Event handler method for OnScriptFinished }
procedure TApdCustomScript.ScriptFinish(Condition: Integer);
begin
  if Assigned(FOnScriptFinish) then
    FOnScriptFinish(Self, Condition);
end;

{ Event handler method for OnScriptPreStep }
procedure TApdCustomScript.ScriptCommandStart(Node: TApdScriptNode;
                                              Condition: Integer);
begin
  if Assigned(FOnScriptCommandStart) then
    FOnScriptCommandStart(Self, Node, Condition);
end;

{ Event handler method for OnScriptPostStep }
procedure TApdCustomScript.ScriptCommandFinish(Node: TApdScriptNode;
                                               Condition: Integer);
begin
  if Assigned(FOnScriptCommandFinish) then
    FOnScriptCommandFinish(Self, Node, Condition);
end;

{ Event handler method for OnScriptFinished }
procedure TApdCustomScript.ScriptDisplay(const Msg: string);
begin
  if DisplayToTerminal and Assigned(FTerminal) then begin

    { Handle new terminal }
    if FTerminal is TAdCustomTerminal then begin
      TAdCustomTerminal(Terminal).WriteString(Msg);
    end;

  end;

  if Assigned(FOnScriptDisplay) then
    FOnScriptDisplay(Self, Msg);
end;

{ Init Script object }
constructor TApdCustomScript.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  { Create command nodes }
  CommandNodes := TList.Create;
  CommandNodes.Capacity := MaxCommands;

  { Create string list }
  FScriptCommands := TStringList.Create;
  Modified := False;

  { Other inits }
  FInProgress := False;
  FDisplayToTerminal := DefDisplayToTerminal;
  Retry := DefRetryCnt;
  SaveOnTrigger := nil;
  SaveProtocolFinish := nil;
  CreatedPort := False;
  OpenedPort := False;
  CreatedProtocol := False;
  Continuing := False;
  Closing := False;

  { Search for components }
  FComPort := SearchComPort(Owner);
  FTerminal := SearchTerminal(Owner);
  FProtocol := SearchProtocol(Owner);
end;

{ Dispose of script object and associated data }
destructor TApdCustomScript.Destroy;
var
  I: Integer;
begin
  { Get rid of command nodes }
  if CommandNodes.Count > 0 then begin
    for I := 0 to CommandNodes.Count-1 do
      TApdScriptNode(CommandNodes[I]).Free;
  end;
  CommandNodes.Free;

  { Save script file if it changed }
  if Modified and (FScriptFile <> '') then
    FScriptCommands.SaveToFile(FScriptFile);

  { Get rid of script string list }
  FScriptCommands.Free;

  { Get rid of port if we created it }
  if CreatedPort then
    ComPort.Free;

  inherited Destroy;
end;

procedure TApdCustomScript.AddDispatchLogEntry (const Msg: String);    
begin                                                                  
  if not Assigned (FComPort) then
    exit;
  if not Assigned (FComPort.Dispatcher) then
    exit;
  FComPort.Dispatcher.AddDispatchEntry(dtScript,
                                       dstStatus, 0,
                                       @Msg[1],
                                       Length(Msg));
end;

procedure TApdCustomScript.SetScriptFile(const NewFile: string);
begin
  if CompareText(NewFile, FScriptFile) <> 0 then begin

    { Save current commands if they were modified and we have a filename }
    if Modified and
       (FScriptFile <> '') and
       (FScriptCommands.Count <> 0) then
      FScriptCommands.SaveToFile(FScriptFile);

    { Set new file name, load new commands if file exists }
    FScriptFile := NewFile;
    if FileExists(FScriptFile) then begin
      FScriptCommands.Clear;
      FScriptCommands.LoadFromFile(FScriptFile);
    end;
    Modified := False;
  end;
end;

procedure TApdCustomScript.SetScriptCommands(Values: TStrings);
begin
  FScriptCommands.Assign(Values);
  Modified := True;
end;

procedure TApdCustomScript.Notification(AComponent: TComponent;
                                        Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then begin
    { Owned components going away }
    if AComponent = FComPort then
      FComPort := nil;
    if AComponent = FTerminal then

      FTerminal := nil;
    if AComponent = FProtocol then
      FProtocol := nil;
  end else if Operation = opInsert then begin
    { Check for new comport }
    if AComponent is TApdCustomComPort then
      if not Assigned(FComPort) then
        ComPort := TApdCustomComPort(AComponent);

    { Check for new terminal component }
    if AComponent is TAdCustomTerminal then begin
      if not Assigned(FTerminal) then
        FTerminal := TApdBaseWinControl(AComponent);
    end;

    { Check for new protocol component }
    if AComponent is TApdCustomProtocol then begin
      if not Assigned(FProtocol) then
        FProtocol := TApdCustomProtocol(AComponent);
    end;
  end;
end;

{ Load script file if ScriptCommands empty but ScriptFile not }
procedure TApdCustomScript.Loaded;
begin
  inherited Loaded;

  if ScriptCommands.Count = 0 then begin
    try
      PrepareScript;
    except
    end;
  end;
end;

{ Assure all referenced labels exist }
procedure TApdCustomScript.ValidateLabels;
var
  I: Integer;

  { Return true if a label named Name exists }
  function FoundLabel(const Name: string): Boolean;
  var
    I: Integer;
  begin
    Result := True;
    for I := 0 to CommandNodes.Count-1 do
      with TApdScriptNode(CommandNodes[I]) do
        if (Command = scLabel) and (Data = Name) then
          Exit;
    Result := False;
  end;

begin
  if CommandNodes.Count > 0 then
    for I := 0 to CommandNodes.Count-1 do
      with TApdScriptNode(CommandNodes[I]) do
        case Command of
          scIf,
          scGoto:
            if not FoundLabel(Data) then begin
              raise EApdScriptError.Create(ecInvalidLabel, 0);
            end;
        end;
end;

{ Load/error check script }
procedure TApdCustomScript.PrepareScript;
var
  I: Integer;
begin
  { If script file name is not empty, then load into ScriptCommands }
  if FScriptFile <> '' then begin
    FScriptCommands.Clear;
    FScriptCommands.LoadFromFile(FScriptFile);
  end;

  { Clear existing command nodes }
  if CommandNodes.Count > 0 then begin
    for I := 0 to CommandNodes.Count-1 do
      TApdScriptNode(CommandNodes[I]).Free;
    CommandNodes.Clear;
  end;

  { Convert script commands into nodes }
  CurrentLine := 0;
  for I := 0 to ScriptCommands.Count-1 do begin
    Inc(CurrentLine);
    AddToScript(FScriptCommands[I]);
  end;

  { Make sure all referenced labels really exist }
  ValidateLabels;

  {$IFDEF DebugScript}
  WriteLn(Dbg,'script file ', FScriptFile, ' loaded');
  {$ENDIF}
  AddDispatchLogEntry ('Script file ' + FScriptFile + 'loaded ');
end;

{ Create command node }
procedure TApdCustomScript.CreateCommand(CmdType: TApdScriptCommand;
                                         const Data1, Data2: string);
var
  Node      : TApdScriptNode;
  Data      : string;
  DataEx    : string;
  Option    : TOption;
  Timeout   : Cardinal;
  Condition : Cardinal;
  StrBuffer : StringBuffer;

  { Return condition class }
  function ClassifyCondition(const S: string): Cardinal;
  var
    TempStr: string;
  begin
    TempStr := UpperCase(S);
    if TempStr = 'SUCCESS' then