zscanner.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

  Temp: Char;
  Quote: string;
begin
  Result := InnerStartLex(CurrPos, CurrLineNo, CurrToken);
  if Result <> tokUnknown then Exit;

  Temp := CurrToken[1];
  { Check for brace }
  if Temp in ['(', ')', '{', '}', '[', ']'] then
  begin
    Result := tokBrace;
  end
  { Check for separator }
  else if Temp in [',', ';', ':'] then
  begin
    Result := tokSeparator;
  end
  { Check for delimiters }
  else if IsDelim(Temp) then
  begin
    Result := tokOperator;
  end
  { Check for string }
  else if IsQuote(Temp) then
  begin
    Quote  := Temp;
    Result := tokString;
    while FBufferPos <= FBufferLen do
    begin
      Temp := FBuffer[FBufferPos];
      CurrToken := CurrToken + Temp;
      Inc(FBufferPos);
      if Temp = Quote then
        Break;
    end;
  end
  { Check for digits and identifiers }
  else
  begin
    if IsDigit(Temp) then
      Result := tokInt
    else Result := tokIdent;
    while FBufferPos <= FBufferLen do
    begin
      Temp := FBuffer[FBufferPos];
      if IsDelim(Temp) or (Temp in ['"', '''']) then
        Break;
      if (Result = tokInt) and (Temp = '.') then
        Result := tokFloat;
      CurrToken := CurrToken + Temp;
      Inc(FBufferPos);
    end;
  end;
end;

{ Check is value an alpha }
class function TZScanner.IsAlpha(Value: Char): Boolean;
begin
  Result := not ((Value < ' ') or IsDelim(Value) or IsDigit(Value));
end;

{ Check is value a delimiter }
class function TZScanner.IsDelim(Value: Char): Boolean;
begin
  Result := (Pos(Value, ':;,+-<>/*%^=()[]|&~@#$\`{}!? '#9#10#13) > 0);
end;

{ Check is value a digit }
class function TZScanner.IsDigit(Value: Char): Boolean;
begin
  Result := (Value in ['0'..'9']);
end;

{ Check is value EOL }
class function TZScanner.IsEol(Value: Char): Boolean;
begin
  Result := (Value = #13);
end;

{ Check is value a white space }
class function TZScanner.IsWhite(Value: Char): Boolean;
begin
  Result := (Value in [' ', #9, #10]);
end;

{ Check is value a quote }
class function TZScanner.IsQuote(Value: Char): Boolean;
begin
  Result := (Value in ['"', '''']);
end;

{ Restart lexical analyse }
procedure TZScanner.Restart;
begin
  SetBuffer(FBuffer);
end;

{ TZPasScanner }

const
  MaxPasOp       = 7;
  MaxPasType     = 8;
  MaxPasKeyword  = 33;

  PasOp: array[1..MaxPasOp] of string =
    ('and','or','not','shr','shl','div','mod');
  PasType: array[1..MaxPasType] of string =
    ('integer','longint','byte','char','string','boolean','real','double');
  PasKeyword: array[1..MaxPasKeyword] of string =
    ('with','array','function','case','var','const','until','then','set',
     'record','program','procedure','packed','nil','label','in','repeat',
     'of','goto','forward','for','while','file','else','downto','do','to',
     'type','end','begin','if','true','false');

{ Get lowlevel token }
function TZPasScanner.LowRunLex(var CurrPos, CurrLineNo: Integer;
  var CurrToken: string): Integer;
var
  I: Integer;
  Temp, Temp1: Char;
  Search: string;
begin
  Result := InnerStartLex(CurrPos, CurrLineNo, CurrToken);
  if Result <> tokUnknown then Exit;
  Temp := CurrToken[1];
  { Check for multi-line comment }
  if Temp = '{' then
  begin
    Result := tokComment;
    while FBufferPos <= FBufferLen do
    begin
      Temp := FBuffer[FBufferPos];
      CurrToken := CurrToken + Temp;
      Inc(FBufferPos);
      if Temp = '}' then
        Break;
      if Temp = #13 then
        Inc(FBufferLine);
    end;
  end
  { Check for multi-line comment }
  else if (Temp = '(') and (FBufferPos <= FBufferLen)
    and (FBuffer[FBufferPos] = '*') then
  begin
    Result := tokComment;
    Temp1 := #0;
    while FBufferPos <= FBufferLen do
    begin
      Temp := FBuffer[FBufferPos];
      CurrToken := CurrToken + Temp;
      Inc(FBufferPos);
      if (Temp = ')') and (Temp1 = '*') then
        Break;
      if Temp = #13 then
        Inc(FBufferLine);
      Temp1 := Temp;
    end;
  end;

  { Check for single-line comment }
  if (Temp = '/') and (FBufferPos <= FBufferLen)
    and (FBuffer[FBufferPos] = '/') then
  begin
    Result := InnerProcLineComment(CurrPos, CurrLineNo, CurrToken);
    Exit;
  end;

  { Check for brace }
  if Temp in ['(', ')', '[', ']'] then
  begin
    Result := tokBrace;
  end
  { Check for separator }
  else if (Temp in [',', ';'])
    or ((Temp = ':') and (FBufferPos <= FBufferLen)
      and (FBuffer[FBufferPos] <> '=')) then
  begin
    Result := tokSeparator;
  end
  { Check for delimiters }
  else if Pos(Temp, ':=+-<>/*^@#') > 0 then
  begin
    Result := tokOperator;
    if FBufferPos <= FBufferLen then
      Temp1 := FBuffer[FBufferPos]
    else Temp1 := #0;
    if ((Temp in [':', '>']) and (Temp1 = '='))
      or ((Temp = '<') and (Temp1 in ['=', '>'])) then
    begin
      CurrToken := CurrToken + Temp1;
      Inc(FBufferPos);
    end;
  end;
  if Result <> tokUnknown then Exit;

  { Check for string }
  if Temp = '''' then
  begin
    Result := InnerProcPasString(CurrPos, CurrLineNo, CurrToken);
    Exit;
  end;

  { Check for digits and identifiers }
  Result := InnerProcIdent(CurrPos, CurrLineNo, CurrToken);
  { Check for operators }
  if Result = tokIdent then
  begin
    Search := LowerCase(CurrToken);
    for I := 1 to MaxPasOp do
      if PasOp[I] = Search then
      begin
        Result := tokOperator;
        Exit;
      end;
  end;
  { Check for types }
  if (Result = tokIdent) and ShowType then
  begin
    Search := LowerCase(CurrToken);
    for I := 1 to MaxPasType do
      if PasType[I] = Search then
      begin
        Result := tokType;
        Exit;
      end;
  end;
  { Check for keywords }
  if (Result = tokIdent) and ShowKeyword then
  begin
    Search := LowerCase(CurrToken);
    for I := 1 to MaxPasKeyword do
      if PasKeyword[I] = Search then
      begin
        Result := tokKeyword;
        Exit;
      end;
  end;
end;

{ Unconvert value into string value }
function TZPasScanner.UnwrapString(Value: string): string;
var
  Pos, Len: Integer;
begin
  Result := '';
  if Value = '' then Exit;
  Pos := 1;
  Delete(Value, 1, 1);
  Len := Length(Value);
  while Pos <= Len do
  begin
    if Value[Pos] <> '''' then
      Result := Result + Value[Pos]
    else if (Pos < Len) and (Value[Pos+1] = '''') then
    begin
      Result := Result + '''';
      Inc(Pos);
    end;
    Inc(Pos);
  end;
end;

{ Convert string value into string }
function TZPasScanner.WrapString(Value: string): string;
var
  Pos: Integer;
begin
  Result := '''';
  for Pos := 1 to Length(Value) do
  begin
    Result := Result + Value[Pos];
    if Value[Pos] = '''' then
      Result := Result + Value[Pos];
  end;
  Result := Result + '''';
end;

{ TZCScanner }

const
  MaxCType     = 7;
  MaxCKeyword  = 33;

  CType: array[1..MaxCType] of string =
    ('int','long','short','char','bool','float','double');
  CKeyword: array[1..MaxCKeyword] of string =
    ('with','array','function','case','var','const','until','then','set',
     'record','program','procedure','packed','nil','label','in','repeat',
     'of','goto','forward','for','while','file','else','downto','do','to',
     'type','end','begin','if','true','false');

{ Get lowlevel token }
function TZCScanner.LowRunLex(var CurrPos, CurrLineNo: Integer;
  var CurrToken: string): Integer;
var
  I: Integer;
  Temp, Temp1, Temp2: Char;
  Search: string;
begin
  Result := InnerStartLex(CurrPos, CurrLineNo, CurrToken);
  if Result <> tokUnknown then Exit;

  { Check for multi-line comment }
  Result := InnerProcCComment(CurrPos, CurrLineNo, CurrToken);
  if Result <> tokUnknown then Exit;
  Temp := CurrToken[1];

  { Check for single-line comment }
  if (Temp = '/') and (FBufferPos <= FBufferLen)
    and (FBuffer[FBufferPos] = '/') then
  begin
    Result := InnerProcLineComment(CurrPos, CurrLineNo, CurrToken);
    Exit;
  end;

  { Check for brace }
  if Temp in ['{', '}', '(', ')', '[', ']'] then
  begin
    Result := tokBrace;
  end
  { Check for separator }
  else if (Temp in [',', ';'])
    or ((Temp = ':') and (FBufferPos <= FBufferLen)
      and (FBuffer[FBufferPos] <> '=')) then
  begin
    Result := tokSeparator;
  end
  { Check for delimiters }
  else if Pos(Temp, ':=+-<>/*^@#?%!|&~') > 0 then
  begin
    Result := tokOperator;
    { Check second char }
    if FBufferPos <= FBufferLen then
      Temp1 := FBuffer[FBufferPos]
    else Temp1 := #0;
    if ((Temp in ['+','-','!','|','~','&','*','/','>','%']) and (Temp1 = '='))
      or ((Temp = '<') and (Temp1 in ['=']))
      or ((Temp in ['<','>','|','&','+','-']) and (Temp1 = Temp))
      or ((Temp = '-') and (Temp1 in ['>'])) then
    begin
      CurrToken := CurrToken + Temp1;
      Inc(FBufferPos);
    end;
    { Check third char }
    if (Temp1 <> #0) and (FBufferPos <= FBufferLen) then
      Temp2 := FBuffer[FBufferPos]
    else Temp2 := #0;
    if ((Temp = '>') and (Temp1 = '>') and (Temp2 = '='))
      or ((Temp = '<') and (Temp1 = '<') and (Temp2 = '=')) then
    begin
      CurrToken := CurrToken + Temp2;
      Inc(FBufferPos);
    end;
  end;
  if Result <> tokUnknown then Exit;

  { Check for string }
  if Temp = '"' then
  begin
    Result := InnerProcCString(CurrPos, CurrLineNo, CurrToken);
    Exit;
  end;

  { Check for digits and identifiers }
  Result := InnerProcIdent(CurrPos, CurrLineNo, CurrToken);
  { Check for types }
  if (Result = tokIdent) and ShowType then
  begin
    Search := LowerCase(CurrToken);
    for I := 1 to MaxCType do
      if CType[I] = Search then
      begin
        Result := tokType;
        Exit;
      end;
  end;
  { Check for keywords }
  if (Result = tokIdent) and ShowKeyword then
  begin
    for I := 1 to MaxCKeyword do
      if CKeyword[I] = CurrToken then
      begin
        Result := tokKeyword;
        Exit;
      end;
  end;
end;

{ Unconvert value into string value }
function TZCScanner.UnwrapString(Value: string): string;
var
  N: Integer;
  Ptr1, Ptr2: PChar;
begin
  Result := '';
  if Value = '' then Exit;
  Delete(Value, 1, 1);
  Delete(Value, Length(Value), 1);

  SetLength(Result, Length(Value)+1);
  Ptr1 := PChar(Value);
  Ptr2 := PChar(Result);
  N := 0;
  while Ptr1^ <> #0 do
  begin
    if Ptr1^ <> '\' then
      Ptr2^ := Ptr1^
    else begin
      Inc(Ptr1);
      if Ptr1 = #0 then Break;
      case Ptr1^ of
        'n': Ptr2^ := #10;
        'r': Ptr2^ := #13;
        't': Ptr2^ := #9;
        '0': Ptr2^ := #0;
        else Ptr2^ := Ptr1^;
      end;
    end;
    Inc(N);
    Inc(Ptr1);
    Inc(Ptr2);
  end;
  SetLength(Result, N);
end;

{ Convert string value into string }
function TZCScanner.WrapString(Value: string): string;
var
  I, Add, Len: Integer;
  Ptr: PChar;
begin
  Add := 0;
  Len := Length(Value);
  for I := 1 to Len do
    if Value[I] in ['''','"','\',#9,#10,#13,#0] then
      Inc(Add);
  SetLength(Result, Len + Add);
  Ptr := PChar(Result);
  for I := 1 to Len do
  begin
    if Value[I] in ['''','"','\',#9,#10,#13,#0] then
    begin
      Ptr^ := '\';
      Inc(Ptr);
      case Value[I] of
        #9:  Ptr^ := 't';
        #10: Ptr^ := 'n';
        #13: Ptr^ := 'r';
        #0:  Ptr^ := '0';
        else Ptr^ := Value[I];
      end;
    end else
      Ptr^ := Value[I];
    Inc(Ptr);
  end;
  Result := '"' + Result + '"';
end;


end.