rtcparseex.pas

著名的SecureBlackBox控件完整源码

  else
    Result := '';
  end;

procedure TRtcParseEx.SetValue(Index: String; const AValue: String);
  var
    idx: Integer;
  begin
  if Assigned(FVariables) then
    begin
    {$IFDEF AnsiUpperCase}
    Index := AnsiUpperCase(Trim(Index));
    {$ELSE}
    Index := UpperCase(Trim(Index));
    {$ENDIF}

    // set the value of variable named 'Index'
    idx := FVariables.IndexOf(Index);
    if idx >= 0 then
      begin
      if Assigned(Fvariables.Objects[idx]) then
        TString(FVariables.Objects[idx]).Value := AValue
      else
        FVariables.Objects[idx]:=TString.Create(AValue);
      end
    else
      if not Silent then
        raise ERtcParse.Create('Unknown Variable: ' + Index);
    end;
  end;

procedure TRtcParseEx.SetSource(AValue: String);
begin
  // set the new source string and (re)build the variables list
  if FSource <> AValue then begin
    FSource := AValue;
    Parse;
  end;
end;

procedure TRtcParseEx.SetTokenOpen(AValue: String);
  begin
  // set the new open token delimiter and (re)build the variables list
  if (AValue <> '') and (FTokenOpen <> AValue) then
    begin
    FTokenOpen := Trim(AValue);
    Parse;
    end;
  end;

procedure TRtcParseEx.SetTokenClose(AValue: String);
  begin
  // set the new close token delimiter and (re)build the variables list
  if (AValue <> '') and (FTokenClose <> AValue) then
    begin
    FTokenClose := Trim(AValue);
    Parse;
    end;
  end;

procedure TRtcParseEx.Parse;
var
  lTokenOpen, lTokenClose: Integer;
  posStart: Integer;
  posEnd: Integer;
  variable: String;
  idx: Integer;
begin
  if (FSource <> '') then begin
    // clear/create the existing variable list
    if Assigned(FVariables) then
      begin
        Clear;
        FVariables.Clear;
      end
    else
      FVariables := TStringList.Create;

    // clear/create the existing conditions list
    if Assigned(FConditions) then
      begin
        Clear;
        FConditions.Clear;
      end
    else
      FConditions := TStringList.Create;

    lTokenOpen := Length(FTokenOpen);
    lTokenClose := Length(FTokenClose);

    // look for the tokens in the source string and extract the variables
    posStart := FindPos(FTokenOpen, FSource, 1);
    while posStart > 0 do begin
      posEnd := FindPos(FTokenClose, FSource, posStart+lTokenOpen);
      if (posEnd <= 0) then Break;

      // extract the variable name from the source string
      variable := Copy(FSource, posStart+lTokenOpen, posEnd-(posStart+lTokenOpen));
      if variable <> '' then begin
        {$IFDEF AnsiUpperCase}
        variable := AnsiUpperCase(Trim(variable));
        {$ELSE}
        variable := UpperCase(Trim(variable));
        {$ENDIF}

        if Copy(variable, 1, 8) = BEGIN_INCLUDE then
          begin
            variable := Copy(variable, 9, MAXINT);
            Delete(FSource, posStart, lTokenOpen + 8 + Length(variable) + lTokenClose);
            variable := _IncludeTrailingPathDelimiter(GetPathRelativeTo(FIncludePath, ExtractFilePath(variable))) +
              ExtractFileName(variable);
            if FileExists(variable) then
              Insert(Read_File(variable), FSource, posStart);
            posEnd := posStart - 1;
          end

        else if Copy(variable, 1, 3) = BEGIN_CONDITION then
          begin
            variable := Copy(variable, 4, MAXINT);
            idx := FConditions.IndexOf(variable);
            if (idx < 0) then
              FConditions.AddObject(variable, TCondition.Create);
          end

        else if Copy(variable, 1, 7) = ELSE_CONDITION then
          begin
            // nothing to do
          end

        else if Copy(variable, 1, 6) = END_CONDITION then
          begin
            // nothing to do
          end

        else
          begin
            // we don't want duplicated variable names
            idx := FVariables.IndexOf(variable);
            if (idx < 0) then
              FVariables.AddObject(variable, TString.Create);
          end;
      end;
      posStart := FindPos(FTokenOpen, FSource, posEnd+1);
    end;
  end;
end;

constructor TRtcParseEx.Create(AFilename: String = '');
begin
  inherited Create;

  // set the default values for the parser
  FSource := '';
  FSilent := False;
  FTokenOpen := '<%';
  FTokenClose := '%>';
  FVariables := nil;
  FConditions := nil;

  FIncludePath := '';

  // load the source string from a file
  if AFilename <> '' then
    try
      LoadFromFile(AFilename);
    except
    end;
end;

destructor TRtcParseEx.Destroy;
  begin
  // clear the variable list and clean up any allocated memory
  Clear;
  FreeAndNil(FVariables);
  FreeAndNil(FConditions);

  inherited;
  end;

procedure TRtcParseEx.Clear;
  var
    count: Integer;
  begin
  // clear all variables parsed from source string
  if Assigned(FVariables) then
    begin
    for count := 0 to FVariables.Count-1 do
      if Assigned(FVariables.Objects[count]) then
        begin
        FVariables.Objects[count].Free;
        FVariables.Objects[count] := nil;
        end;
    end;
  if Assigned(FConditions) then
    begin
    for count := 0 to FConditions.Count-1 do
      if Assigned(FConditions.Objects[count]) then
        begin
        FConditions.Objects[count].Free;
        FConditions.Objects[count] := nil;
        end;
    end;
  end;

procedure TRtcParseEx.LoadFromFile(const aFilename: String);
begin
  if FileExists(aFileName) then
    begin
      FIncludePath := _IncludeTrailingPathDelimiter(ExtractFilePath(ExpandFileName(AFilename)));
      FSource:=Read_File(aFileName);
      Parse;
    end
  else
    raise ERtcParse.Create('File not found: ' + aFilename);
end;

function TRtcParseEx.Output: String;

  function _OutputStr(const FSource : string) : string;
    var
      lSource: Integer;
      lTokenOpen: Integer;
      lTokenClose: Integer;

      copyStart: Integer;
      posStart: Integer;
      posEnd: Integer;
      variable: String;
      idx: Integer;
      S : string;
      posStart_End_Condition : Integer;
    begin
    if FSource <> '' then
      begin
      lSource := Length(FSource);
      lTokenOpen := Length(FTokenOpen);
      lTokenClose := Length(FTokenClose);

      copyStart := 1;
      Result := '';

      // look for the tokens and replace matching variables with their values
      posStart := FindPos(FTokenOpen, FSource, 1);
      while posStart > 0 do
        begin
        Result := Result + Copy(FSource, copyStart, posStart-copyStart);

        posEnd := FindPos(FTokenClose, FSource, posStart+1);
        if posEnd <= 0 then Break;

        // extract the variable name from the source string
        variable := Copy(FSource, posStart+lTokenOpen, posEnd-(posStart+lTokenOpen));
        if variable <> '' then
          begin
          {$IFDEF AnsiUpperCase}
          variable := AnsiUpperCase(Trim(variable));
          {$ELSE}
          variable := UpperCase(Trim(variable));
          {$ENDIF}

          if Copy(variable, 1, 3) = BEGIN_CONDITION then
            begin
            variable := Copy(variable, 4, MAXINT);
            idx := FConditions.IndexOf(variable);
            if (idx >= 0) then
              begin
              copyStart := posEnd + lTokenClose;
              posEnd := FindPos(FTokenClose, FSource, posStart+1);

              S := UpperCase(FTokenOpen + END_CONDITION + variable);
              posStart_End_Condition := FindPosUp(S, FSource, posEnd+1);

              posStart := FindPosUp(UpperCase(FTokenOpen + ELSE_CONDITION + variable), FSource, posEnd+1);

              if posStart > posStart_End_Condition then
                posStart := -1;

              if posStart > 0 then
                begin
                if Condition[variable] then
                  Result := Result + _OutputStr(Copy(FSource, copyStart, posStart-copyStart));

                posEnd := FindPos(FTokenClose, FSource, posStart+1);
                copyStart := posEnd + lTokenClose;

                posStart := FindPosUp(S, FSource, posEnd+1); // FTokenOpen + END_CONDITION + variable

                if not Condition[variable] then
                  Result := Result + _OutputStr(Copy(FSource, copyStart, posStart-copyStart));

                posEnd := FindPos(FTokenClose, FSource, posStart+1);
                end
              else
                begin
                posStart := FindPosUp(S, FSource, posEnd+1); // FTokenOpen + END_CONDITION + variable

                posEnd := FindPos(FTokenClose, FSource, posStart+1);

                if Condition[variable] then
                  Result := Result + _OutputStr(Copy(FSource, copyStart, posStart-copyStart));
                end;
              end;
            end
          else
            begin
            // only replace the variable if it is present in list
            idx := FVariables.IndexOf(variable);
            if idx >= 0 then
              Result := Result + VariableValue[idx];
            end;
          end;

        copyStart := posEnd + lTokenClose;
        posStart := FindPos(FTokenOpen, FSource, posEnd+1);
        end;

      // make sure that remaining part of FSource is returned
      if copyStart < lSource then
        Result := Result + Copy(FSource, copyStart, lSource-copyStart+1);
      end
    else
      Result:='';
    end;
  begin
  Result := _OutputStr(FSource);
  end;

function TRtcParseEx.GetCondition(Index: string): boolean;
var
  idx: Integer;
begin
  // return the value of condition named 'Index'
  if Assigned(FConditions) then
    begin
      {$IFDEF AnsiUpperCase}
      Index := AnsiUpperCase(Trim(Index));
      {$ELSE}
      Index := UpperCase(Trim(Index));
      {$ENDIF}

      idx := FConditions.IndexOf(Index);
      if (idx >= 0) and Assigned(FConditions.Objects[idx]) then
        Result := TCondition(FConditions.Objects[idx]).Value
      else
        Result := False;
    end
  else
    Result := False;
end;

procedure TRtcParseEx.SetCondition(Index: string; const Value: boolean);
var
  idx: Integer;
begin
  if Assigned(FConditions) then begin
    {$IFDEF AnsiUpperCase}
    Index := AnsiUpperCase(Trim(Index));
    {$ELSE}
    Index := UpperCase(Trim(Index));
    {$ENDIF}

    // set the value of condition named 'Index'
    idx := FConditions.IndexOf(Index);
    if idx >= 0 then
      begin
        if Assigned(FConditions.Objects[idx]) then
          TCondition(FConditions.Objects[idx]).Value := Value
        else
          FConditions.Objects[idx] := TCondition.Create(Value);
      end
    else
      if not Silent then
        raise ERtcParse.Create('Unknown Condition: ' + Index);
  end;
end;

{ TCondition }

constructor TCondition.Create(AValue: boolean);
begin
  inherited Create;
  Value := AValue;
end;

end.