rm_jvhlparser.pas

这是一个功能强大

    begin
      Inc(P);
      while P[0] <> #0 do
      begin
        if P[0] = '''' then
          if P[1] = '''' then
            Inc(P)
          else
            Break;
        Inc(P);
      end;
      if P[0] <> #0 then
        Inc(P);
      SetString(Result, F, P - F);
      I := 2;
      while I < Length(Result) - 1 do
      begin
        if Result[I] = '''' then
          Delete(Result, I, 1);
        Inc(I);
      end;
    end
    else
    if (FStyle in [psCpp, psCocoR]) and (P[0] = '"') then
    { C++ string constant }
    begin
      Inc(P);
      while P[0] <> #0 do
      begin
        if (P[0] = '"') and (P[-1] <> '\') then
          Break;
        if (P[0] = '"') and (P[-1] = '\') then
        begin
         // count the backslashes, on even backslahses it is a string end
          I := 1;
          while (P - 1 - I > F) and (P[-1 - I] = '\') do
            Inc(I);
          if I and $01 = 0 then
            Break;  { same but faster than: if I mod 2 = 0 then Break; }
        end;
        Inc(P);
      end;
      if P[0] <> #0 then
        Inc(P);
      SetString(Result, F, P - F);
    end
    else
    if ((FStyle in [psPython, psVB, psHtml]) and (P[0] = '"')) or
      ((FStyle in [psPerl, psPhp]) and (P[0] = '"') and ((P = FpcPos) or (P[-1] <> '/'))) then
    { Python, VB, Html, Perl string constant }
    begin
      Inc(P);
      while P[0] <> #0 do
      begin
        if P[0] = '"' then
          Break;
        Inc(P);
      end;
      if P[0] <> #0 then
        Inc(P);
      SetString(Result, F, P - F);
    end
    else
    if P[0] = #0 then
      Result := ''
    else
    begin
      Result := P[0];
      Inc(P);
    end;
  end
  else { html }
  begin
    if CharInSetW(P[0], ['=', '<', '>']) or
      ((P <> pcProgram) and (P[0] = '/') and (P[-1] = '<')) then
    begin
      Result := P[0];
      Inc(P);
    end
    else
    if P[0] = '"' then
    { Html string constant }
    begin
      Inc(P);
      while P[0] <> #0 do
      begin
        if P[0] = '"' then
          Break;
        Inc(P);
      end;
      if P[0] <> #0 then
        Inc(P);
      SetString(Result, F, P - F);
    end
    else
    begin
      while not CharInSetW(P[0], [#0, ' ', '=', '<', '>']) do
        Inc(P);
      SetString(Result, F, P - F);
    end;
  end;
  Return;
end;

function TJvIParserW.HistoryInd(Index: Integer): Integer;
begin
  Result := FHistoryPtr - 1 - Index;
  if Result < 0 then
    Result := Result + FHistorySize;
end;

function TJvIParserW.GetHistory(Index: Integer): WideString;
begin
  Result := FHistory[HistoryInd(Index)];
end;

function TJvIParserW.GetPosEnd(Index: Integer): Integer;
begin
  Result := Integer(FHistory.Objects[HistoryInd(Index)]) + 1;
end;

function TJvIParserW.GetPosBeg(Index: Integer): Integer;
var
  I: Integer;
  S: WideString;
begin
  I := HistoryInd(Index);
  S := FHistory[I];
  Result := Integer(FHistory.Objects[I]) - Length(S) + 1;
  case FStyle of
    psPascal:
      if S[1] = '''' then
        for I := 2 to Length(S) - 1 do
          if S[I] = '''' then
            Dec(Result);
  end;
end;

procedure TJvIParserW.SetHistorySize(Size: Integer);
begin
  while Size > FHistorySize do
  begin
    FHistory.Add('');
    Inc(FHistorySize);
  end;
  while Size < FHistorySize do
  begin
    FHistory.Delete(0);
    Dec(FHistorySize);
  end;
  FHistoryPtr := 0;
end;

function TJvIParserW.GetPos: Integer;
begin
  Result := pcPos - FpcProgram;
end;

procedure TJvIParserW.RollBack(Index: Integer);
begin
  FpcPos := PosEnd[Index] + FpcProgram;
  Dec(FHistoryPtr, Index);
  if FHistoryPtr < 0 then
    FHistoryPtr := FHistorySize + FHistoryPtr;
end;

//============================================================================

procedure ParseString(const S: string; Ss: TStrings);
var
  Parser: TJvIParser;
  Token: string;
begin
  Ss.BeginUpdate;
  Ss.Clear;
  Parser := TJvIParser.Create;
  try
    Parser.pcProgram := PChar(S);
    Parser.pcPos := Parser.pcProgram;
    Token := Parser.Token;
    while Token <> '' do
    begin
      Ss.Add(Token);
      Token := Parser.Token;
    end;
  finally
    Parser.Free;
    Ss.EndUpdate;
  end;
end;

procedure ParseStringW(const S: WideString; Ss: TWStrings);
var
  Parser: TJvIParserW;
  Token: WideString;
begin
  Ss.BeginUpdate;
  Ss.Clear;
  Parser := TJvIParserW.Create;
  try
    Parser.pcProgram := PWideChar(S);
    Parser.pcPos := Parser.pcProgram;
    Token := Parser.Token;
    while Token <> '' do
    begin
      Ss.Add(Token);
      Token := Parser.Token;
    end;
  finally
    Parser.Free;
    Ss.EndUpdate;
  end;
end;

function IsStringConstant(const St: string): Boolean;
var
  LS: Integer;
begin
  LS := Length(St);
  Result := (LS >= 2) and (((St[1] = '''') and (St[LS] = '''')) or
    ((St[1] = '"') and (St[LS] = '"')));
end;

function IsStringConstantW(const St: WideString): Boolean;
var
  LS: Integer;
begin
  LS := Length(St);
  Result := (LS >= 2) and (((St[1] = '''') and (St[LS] = '''')) or
    ((St[1] = '"') and (St[LS] = '"')));
end;

function IsRealConstant(const St: string): Boolean;
var
  I, J: Integer;
  Point: Boolean;
begin
  Result := False;
  if (St = '.') or (St = '') then
    Exit;
  if St[1] = '-' then
    if Length(St) = 1 then
      Exit
    else
      J := 2
  else
    J := 1;
  Point := False;
  for I := J to Length(St) do
    if St[I] = '.' then
      if Point then
        Exit
      else
        Point := True
    else
    if not (St[I] in DigitSymbols) then
      Exit;
  Result := True;
end;

function IsRealConstantW(const St: WideString): Boolean;
var
  I, J: Integer;
  Point: Boolean;
begin
  Result := False;
  if (St = '.') or (St = '') then
    Exit;
  if St[1] = '-' then
    if Length(St) = 1 then
      Exit
    else
      J := 2
  else
    J := 1;
  Point := False;
  for I := J to Length(St) do
    if St[I] = '.' then
      if Point then
        Exit
      else
        Point := True
    else
    if (St[I] < WideChar('0')) or (St[I] > WideChar('9')) then
      Exit;
  Result := True;
end;

function IsIntConstant(const St: string): Boolean;
var
  I, J: Integer;
  Sym: TSysCharSet;
begin
  Result := False;
  if (Length(St) = 0) or ((Length(St) = 1) and (St[1] = '$')) then
    Exit;
  Sym := DigitSymbols;
  if (St[1] = '-') or (St[1] = '$') then
  begin
    if Length(St) = 1 then
      Exit
    else
      J := 2;
    if St[1] = '$' then
      Sym := HexadecimalSymbols;
  end
  else
    J := 1;
  for I := J to Length(St) do
    if not (St[I] in Sym) then
      Exit;
  Result := True;
end;

function IsIntConstantW(const St: WideString): Boolean;
var
  I, J: Integer;
  Sym: TSysCharSet;
begin
  Result := False;
  if (Length(St) = 0) or ((Length(St) = 1) and (St[1] = '$')) then
    Exit;
  Sym := DigitSymbols;
  if (St[1] = '-') or (St[1] = '$') then
  begin
    if Length(St) = 1 then
      Exit
    else
      J := 2;
    if St[1] = '$' then
      Sym := HexadecimalSymbols;
  end
  else
    J := 1;
  for I := J to Length(St) do
    if not CharInSetW(St[I], Sym) then
      Exit;
  Result := True;
end;

function IsIdentifier(const ID: string): Boolean;
var
  I, L: Integer;
begin
  Result := False;
  L := Length(ID);
  if L = 0 then
    Exit;
  if not (ID[1] in IdentifierFirstSymbols) then
    Exit;
  for I := 1 to L do
  begin
    if not (ID[1] in IdentifierSymbols) then
      Exit;
  end;
  Result := True;
end;

function IsIdentifierW(const ID: WideString): Boolean;
var
  I, L: Integer;
begin
  Result := False;
  L := Length(ID);
  if L = 0 then
    Exit;
  if not CharInSetW(ID[1], IdentifierFirstSymbols) then
    Exit;
  for I := 1 to L do
  begin
    if not CharInSetW(ID[1], IdentifierSymbols) then
      Exit;
  end;
  Result := True;
end;

function GetStringValue(const St: string): string;
begin
  if IsStringConstant(St) then
    Result := Copy(St, 2, Length(St) - 2)
  else
    Result := St;
end;

function GetStringValueW(const St: WideString): WideString;
begin
  if IsStringConstant(St) then
    Result := Copy(St, 2, Length(St) - 2)
  else
    Result := St;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.