jvhlparser.pas

数据表对拷程序。 做这个程序的本意是

            Inc(P);
            while CharInSet(P[0], StIdSymbols) do
              Inc(P);
            SetString(Result, F, P - F);
          end
          else
            if P[0] = '''' then
    { pascal string constant }
            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 (P[0] in ['=', '<', '>']) 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 (P[0] in [#0, ' ', '=', '<', '>']) do
          Inc(P);
        SetString(Result, F, P - F);
      end;
  end;
  Return;
end;

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

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

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

function TJvIParser.GetPosBeg(Index: Integer): Integer;
var
  i: Integer;
  S: string;
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 TJvIParser.SetHistorySize(Size: Integer);
{$IFDEF DEBUG}
var
  i: Integer;
{$ENDIF}
begin
  while Size > FHistorySize do
  begin
    FHistory.Add('');
    Inc(FHistorySize);
  end;
  while Size < FHistorySize do
  begin
    FHistory.Delete(0);
    Dec(FHistorySize);
  end;
{$IFDEF DEBUG}
  for i := 0 to FHistorySize - 1 do
    FHistory[i] := '';
{$ENDIF}
  FHistoryPtr := 0;
end;

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

procedure TJvIParser.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.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;
  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 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 (St[i] < '0') or (St[i] > '9') then
        Exit;
  Result := True;
end;

function IsIntConstant(const St: string): Boolean;
var
  i, j: Integer;
  Sym: TSetOfChar;
begin
  Result := False;
  if (Length(St) = 0) or ((Length(St) = 1) and (St[1] = '$')) then
    Exit;
  Sym := StConstSymbols10;
  if (St[1] = '-') or (St[1] = '$') then
  begin
    if Length(St) = 1 then
      Exit
    else
      j := 2;
    if St[1] = '$' then
      Sym := StConstSymbols;
  end
  else
    j := 1;
  for i := j to Length(St) do
    if not CharInSet(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 CharInSet(ID[1], StIdFirstSymbols) then
    Exit;
  for i := 1 to L do
  begin
    if not CharInSet(ID[1], StIdSymbols) 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;
end.