rtcparseex.pas

著名的SecureBlackBox控件完整源码

{
  @html(<b>)
  Extended Parser
  @html(</b>)
  - Copyright (c) Danijel Tkalcec
  @html(<br><br>)

  This unit defines an extended parser which is designed to be used either
  stand-alone or hand-in-hand with any of the RTC components. RTC parser uses
  a source string as Template and replaces tokens inside TokenOpen and TokenClose.
  If you are writing a Web Server, you can use this parser to generate dynamic content
  by using HTML templates designed with any Web Page Editor.

  Conditions:
    <%if:condition_name%>
      ...
    <%elseif:condition_name%>
      ...
    <%endif:condition_name%>

  Include:
    <%include:file_name%>  
}

unit rtcParseEx;
{$H+}

interface

{$include rtcDefs.inc}

uses
  Classes, SysUtils, rtcParse;

const
  BEGIN_CONDITION  = 'IF:';
  ELSE_CONDITION   = 'ELSEIF:';
  END_CONDITION    = 'ENDIF:';
  BEGIN_INCLUDE    = 'INCLUDE:';


type
  // @exclude
  TCondition = class(TObject)
  public
    Value: boolean;
    constructor Create(AValue: boolean = False);
  end;

  { @abstract(Extended Template parser)
    Extended parser which is designed to be used either stand-alone or
    hand-in-hand with any of the RTC components. RTC parser uses
    a source string as Template and replaces tokens inside TokenOpen and TokenClose.
    If you are writing a Web Server, you can use this parser to generate dynamic content
    by using HTML templates designed with any Web Page Editor. }
  TRtcParseEx = class(TObject)
  private
    FSource: String;
    FSilent: Boolean;
    FTokenClose: String;
    FTokenOpen: String;
    FVariables: TStringList;
    FConditions: TStringList;
    FIncludePath : string;


    // @exclude
    function FindPos(const Substr, Str: String; StartPos: Integer = 1): Integer;
    // Uppercase case-insensitive FindPos
    function FindPosUp(const Substr, Str: String; StartPos: Integer = 1): Integer;

    // @exclude
    function GetCount: Integer;
    // @exclude
    function GetVariableName(Index: Integer): String;
    // @exclude
    procedure SetVariableName(Index: Integer; const AValue: String);
    // @exclude
    function GetVariableValue(Index: Integer): String;
    // @exclude
    procedure SetVariableValue(Index: Integer; const AValue: String);
    // @exclude
    function GetValue(Index: String): String;
    // @exclude
    procedure SetValue(Index: String; const AValue: String);

    // @exclude
    procedure SetSource(AValue: String);

    // @exclude
    procedure SetTokenOpen(AValue: String);
    // @exclude
    procedure SetTokenClose(AValue: String);

    // @exclude
    function GetCondition(Index: string): boolean;
    // @exclude
    procedure SetCondition(Index: string; const Value: boolean);

  protected
    { @exclude
      Parses the source string and builds a list of variables and
      list of conditions names }
    procedure Parse;

  public
    { Constructor: use to create a parser object.
      Pass FileName as parameter to load local file as Source template. }
    constructor Create(AFilename: String = '');

    { Destructor: when you are done using the parser,
      you should destroy it by calling Free. }
    destructor Destroy; override;

    { Clears values for all variables parsed from the source string.
      Using Clear, you can re-use your Source Template to generate more
      outputs with different content, since only values for variables will
      be removed, while Source and known variable names remain. }
    procedure Clear;

    { Loads the source string from a file }
    procedure LoadFromFile(const aFilename: String);

    { Generates the output, replacing all variables with their associated values }
    function Output: String;

    { Gets count of variables parsed from the source string }
    property Count: Integer read GetCount default 0;

    { Name of the 'index'-th variable parsed from the source string (starting from 0) }
    property VariableName[Index: Integer]: String read GetVariableName write SetVariableName;
    { Value of the 'index'-th variable parsed from the source string (starting from 0) }
    property VariableValue[Index: Integer]: String read GetVariableValue write SetVariableValue;
    { Value of the variable with the name 'Index' parsed from the source String }
    property Value[Index: String]: String read GetValue write SetValue; default;

    property Condition[Index: string]: boolean read GetCondition write SetCondition;
    property Conditions : TStringList read FConditions;

    { Source string (Template) to use when generating the output }
    property Source: String read FSource write SetSource;

    { Prevents an exception from being raised when trying to set the value
      of a non-existent variable }
    property Silent: Boolean read FSilent write FSilent default False;
    { String to use for opening token. Default is <% }
    property TokenOpen: String read FTokenOpen write SetTokenOpen;
    { String to use for closing token. Default is %> }
    property TokenClose: String read FTokenClose write SetTokenClose;
  end;

function _IncludeTrailingPathDelimiter(const S: string): string;

implementation

uses
  Windows;

const
  ShLWApiDll = 'SHLWAPI.DLL';

function PathCombine(szDest:PChar; lpszDir:PChar; lpszFile:PChar):PChar;stdcall;
   external ShLwApiDll name 'PathCombineA';

function GetPathRelativeTo (Root : string; FilePath : string): string;
var
  PS : PChar;
begin
  Result := FilePath;
  if (Result <> '') and (Result[1] = '\') and (Result[2] <> '\') then
    Result := '.' + Result;
  PS := AllocMem(MAX_PATH);
  try
    if PathCombine(PS, PChar(Root), PChar(Result) ) <> nil then
      Result := PS;
  finally
    FreeMem(PS);
  end;
end;

function _IncludeTrailingPathDelimiter(const S: string): string;
begin
  Result := S;
  if not IsPathDelimiter(Result, Length(Result)) then
    Result := Result + '\';
end;

function Read_File(const fname:string; Loc,Size:int64):string; overload;
  var
    fHandle: Integer;
    sRead: Int64;
  begin
  Result := '';
  fHandle := FileOpen(fname, fmOpenRead+fmShareDenyNone);
  if fHandle < 0 then
    raise ERtcParse.Create('Unable to open file: ' + fname)
  else
    begin
    if Loc < 0 then
      Loc := 0;
    try
      if Size < 0 then
        Size := FileSeek(fHandle, Int64(0), 2) - Loc;
      if FileSeek(fHandle, Loc, 0) <> Loc then
        raise ERtcParse.Create('Unable to seek to location: ' + IntToStr(Loc));
      SetLength(Result, Size);
      sRead := FileRead(fHandle, Result[1], Size);
      if sRead < Size then
        SetLength(Result, sRead);
    finally
      FileClose(fHandle);
      end;
    end;
  end;

function Read_File(const fname:string):string; overload;
  begin
  Result:=Read_File(fname,0,-1);
  end;


{ TRtcParseEx }

function TRtcParseEx.FindPos(const Substr, Str: String; StartPos: Integer = 1): Integer;
  var
    lenStr: Integer;
    lenSubstr: Integer;
    x, y: Integer;
  begin
  lenStr := Length(Str);
  lenSubstr := Length(Substr);

  case lenSubstr of
    0: Result := 0;

    1: begin
      Result := 0;
      for x:= StartPos to lenStr do
        if (Substr[1] = Str[x]) then
          begin
          Result := x;
          Break;
          end;
      end;
    2: begin
      Result := 0;
      for x := StartPos to lenStr-1 do
        if ((Substr[1] = Str[x]) and (SubStr[2] = Str[x+1])) then
          begin
          Result := x;
          Break;
          end;
      end;
    else
      begin
      Result := 0;
      for x := StartPos to lenStr-lenSubstr+1 do
        if ((Substr[1] = Str[x]) and (Substr[2] = Str[x+1]) and (Substr[3] = Str[x+2])) then
          begin
          Result := x;
          for y := 3 to lenSubstr-1 do
            if (Substr[1+y] <> Str[x+y]) then
              begin
              Result := 0;
              Break;
              end;
          if Result > 0 then
            Break;
          end;
      end;
    end;
  end;

function TRtcParseEx.FindPosUp(const Substr,Str: String; StartPos: Integer = 1): Integer;
  var
    lenStr: Integer;
    lenSubstr: Integer;
    x, y: Integer;
  begin
  lenStr := Length(Str);
  lenSubstr := Length(Substr);

  case lenSubstr of
    0: Result := 0;

    1: begin
      Result := 0;
      for x:= StartPos to lenStr do
        if Substr[1] = UpCase(Str[x]) then
          begin
          Result := x;
          Break;
          end;
      end;
    2: begin
      Result := 0;
      for x := StartPos to lenStr-1 do
        if ((Substr[1] = UpCase(Str[x])) and (SubStr[2] = UpCase(Str[x+1]))) then
          begin
          Result := x;
          Break;
          end;
      end;
    else
      begin
      Result := 0;
      for x := StartPos to lenStr-lenSubstr+1 do
        if ((Substr[1] = UpCase(Str[x])) and (Substr[2] = UpCase(Str[x+1])) and (Substr[3] = UpCase(Str[x+2]))) then
          begin
          Result := x;
          for y := 3 to lenSubstr-1 do
            if (Substr[1+y] <> UpCase(Str[x+y])) then
              begin
              Result := 0;
              Break;
              end;
          if Result > 0 then
            Break;
          end;
      end;
    end;
  end;

function TRtcParseEx.GetCount: Integer;
  begin
  if Assigned(FVariables) then
    Result := FVariables.Count
  else
    Result := 0;
  end;

function TRtcParseEx.GetVariableName(Index: Integer): String;
  begin
  // return the selected variable's name
  if Assigned(FVariables) and (Index >= 0) and (Index < FVariables.Count) then
    Result := FVariables.Strings[Index]
  else
    Result := '';
  end;

procedure TRtcParseEx.SetVariableName(Index: Integer; const AValue: String);
  begin
  // set the selected variable's name
  if Assigned(FVariables) and (Index >= 0) and (Index < FVariables.Count) then
    FVariables.Strings[Index] := AValue;
  end;

function TRtcParseEx.GetVariableValue(Index: Integer): String;
  begin
  // return the selected variable's value
  if Assigned(FVariables) and (Index >= 0) and (Index < FVariables.Count) and
     Assigned(FVariables.Objects[Index]) then
    Result := TString(FVariables.Objects[Index]).Value
  else
    Result := '';
  end;

procedure TRtcParseEx.SetVariableValue(Index: Integer; const AValue: String);
  begin
  // set the selected variable's value
  if Assigned(FVariables) and (Index >= 0) and (Index < FVariables.Count) then
    if Assigned(Fvariables.Objects[Index]) then
      TString(FVariables.Objects[Index]).Value := AValue
    else
      FVariables.Objects[Index]:=TString.Create(AValue);
  end;

function TRtcParseEx.GetValue(Index: String): String;
  var
    idx: Integer;
  begin
  // return the value of variable named 'Index'
  if Assigned(FVariables) then
    begin
    {$IFDEF AnsiUpperCase}
    Index := AnsiUpperCase(Trim(Index));
    {$ELSE}
    Index := UpperCase(Trim(Index));
    {$ENDIF}

    idx := FVariables.IndexOf(Index);
    if (idx >= 0) and Assigned(FVariables.Objects[idx]) then
      Result := TString(FVariables.Objects[idx]).Value
    else
      Result := '';
    end