Set dp branch as trunk

QueryParserComp.pas

@@ -0,0 +1,724 @@
+unit QueryParserComp;
+
+interface
+
+uses
+  Classes, Sysutils;
+
+resourcestring
+  sTextNotSet = 'You must set the TextToParse property first.';
+  sIllegalSpecialChar = 'Illegal special character.';
+  sIllegalStringChar = 'Illegal string delimiter.';
+
+type
+  TTokenType = (ttString, ttSymbol, ttComment, ttDelimiter, ttSpecialChar,
+    ttStatementDelimiter, ttCommentedSymbol, ttCommentDelimiter);
+  TSetOfChar = set of Char;
+  TComment = array[0..1] of string;
+  TCharacterType = (ctSymbol, ctBeginComment, ctEndComment, ctDelimiter,
+    ctString, ctSpecialChar);
+  TCommentType = set of (cmt1, cmt2, cmt3);
+
+const
+  CR = #13;
+  LF = #10;
+  TAB = #9;
+  CRLF = CR + LF;
+  Delimiters: TSetOfChar = [' ', ',', ';', CR, LF, TAB];
+  Comments: array[0..2] of TComment = (('/*', '*/'), ('#', LF), ('//', LF));
+
+type
+  TEndOfStatement = procedure(Sender: TObject; SQLStatement: String) of object;
+
+  TQueryParserComp = class(TComponent)
+  private
+    FStream: TStringStream;
+    FEOF: Boolean;
+    FToken: String;
+    FTokenType: TTokenType;
+    FComment: Boolean;
+    FString: Boolean;
+    FWasString: Boolean;
+    FCommentType: TCommentType;
+    FStringDelimiters: String;
+    FLastStringDelimiterFound: String;
+    FSymbolsCount: Integer;
+    FSpecialCharacters: String;
+    FRemoveStrDelimiter: Boolean;
+    FStringToParse: String;
+    FGoPosition: Integer;
+    FOnStatementDelimiter: TEndOfStatement;
+    FCountFromStatement: Boolean;
+    FStatementDelimiters: TStringList;
+    FStringDelimiter: Char;
+    FGenerateOnStmtDelimiter: Boolean;
+    procedure Init;
+    procedure SetStringToParse(AStringToParse: String);
+    function StatementDelimiter: Boolean;
+    function CheckForBeginComment: Boolean;
+    function CheckForEndComment(Character: Char): Boolean;
+    function CharacterType(Character: Char): TCharacterType;
+    function CheckCharcterType(Character: Char): Boolean;
+    function StringDelimiter(Character: Char): Boolean;
+    function SpecialCharacter(Character: Char): Boolean;
+    procedure RemoveStringDelimiter(var Source: String);
+    procedure SetDelimiterType(Source: String);
+    procedure SetToken;
+    procedure SetSD(ASD: TStringList);
+    procedure SetSpecialCharacters(ASpecialCharacters: String);
+    procedure SetStringDelimiters(AStringDelimiters: String);
+  protected
+    procedure DoStatementDelimiter; dynamic;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure LoadStringToParse(FileName: string);
+    procedure First;
+    procedure FirstToken;
+    procedure NextToken;
+    function GetNextSymbol : string;
+    property EndOfFile: Boolean read FEOF;
+    property Comment: Boolean read FComment;
+    property Token: String read FToken;
+    property TokenType: TTokenType read FTokenType;
+    property CurrentStringDelimiter: Char read FStringDelimiter;
+    property SymbolsCount: Integer read FSymbolsCount default 0;
+    property StringStream: TStringStream read FStream;
+  published
+    property IsEOFStmtDelimiter: Boolean read FGenerateOnStmtDelimiter
+      write FGenerateOnStmtDelimiter;
+    property StringDelimiters: String read FStringDelimiters
+      write SetStringDelimiters;
+    property SpecialCharacters: String read FSpecialCharacters
+      write SetSpecialCharacters;
+    property RemoveStrDelimiter: Boolean read FRemoveStrDelimiter
+      write FRemoveStrDelimiter;
+    property CountFromStatement: Boolean read FCountFromStatement
+      write FCountFromStatement;
+    property TextToParse: String read FStringToParse
+      write SetStringToParse;
+    property StatementDelimiters: TStringList read FStatementDelimiters write SetSD;
+    property OnStatementDelimiter: TEndOfStatement read FOnStatementDelimiter
+      write FOnStatementDelimiter;
+  end;
+
+procedure Register;
+
+implementation
+
+{ TSQLParser }
+
+procedure Register;
+begin
+  RegisterComponents('Samples', [TQueryParserComp]);
+end;
+
+constructor TQueryParserComp.Create(AOwner: TComponent);
+begin
+  inherited;
+  FStatementDelimiters := TStringList.Create;
+  FStatementDelimiters.Add('GO');
+  FStatementDelimiters.Add(';');
+  FCountFromStatement := True;
+end;
+
+procedure TQueryParserComp.LoadStringToParse(FileName: string);
+var
+  fs:TFileStream;
+  size:integer;
+begin
+
+  fs:= TFileStream.Create(FileName, fmOpenRead);
+
+  size:= fs.Size;
+
+  if Assigned(FStream) then
+    FStream.Free;
+
+  FStream := TStringStream.Create('');
+  FStream.CopyFrom(fs,size);
+  fs.Free;
+  Init;
+  First;
+end;
+
+procedure TQueryParserComp.FirstToken;
+begin
+  Init;
+  NextToken;
+end;
+
+function TQueryParserComp.CheckForBeginComment: Boolean;
+var
+  Buffer: String;
+begin
+  Result := False;
+  if not FEOF and not FString then
+  begin
+    Buffer := FStream.ReadString(1);
+    if cmt1 in FCommentType then
+      if Buffer[1] = '*' then
+      begin
+        FCommentType := [cmt1];
+        Result := True;
+      end;
+    if cmt2 in FCommentType then
+      if Buffer[1] = '/' then
+      begin
+        FCommentType := [cmt2];
+        Result := True;
+      end;
+    if cmt3 in FCommentType then
+      if Buffer[1] = '-' then
+      begin
+        FCommentType := [cmt3];
+        Result := True;
+      end;
+    FStream.Seek(-1, soFromCurrent);
+  end;
+end;
+
+procedure TQueryParserComp.SetDelimiterType(Source: String);
+begin
+  FToken := Source[1];
+
+  if ((cmt2 in FCommentType) or (cmt3 in FCommentType)) and FComment
+    and ((Source[1] = CR) or (Source[1] = LF)) then
+  begin
+    FComment := False;
+    FTokenType := ttCommentDelimiter;
+  end
+  else
+    FTokenType := ttDelimiter;
+end;
+
+procedure TQueryParserComp.NextToken;
+var
+  Buffer: String;
+  ETextNotSet: Exception;
+begin
+  if FEOF then
+    Exit;
+
+  if not Assigned(FStream) then
+  begin
+    ETextNotSet := Exception.Create(sTextNotSet);
+    raise ETextNotSet;
+  end;
+
+  if not FString then
+    FStringDelimiter := ' ';
+
+  FToken := '';
+  if not FEOF then
+  begin
+    Buffer := FStream.ReadString(1);
+    if Length(Buffer) > 0 then
+    begin
+      if (Buffer[1] in Delimiters) and not (FString or FComment)then
+        SetDelimiterType(Buffer)
+      else
+      begin
+        if FStream.Position > 0 then
+          FStream.Seek(-1, soFromCurrent);
+        SetToken;
+      end;
+    end
+    else
+      FEOF := True;
+  end;
+
+  case FTokenType of
+    ttSymbol: Inc(FSymbolsCount);
+    ttString:
+      begin
+        FStringDelimiter := FToken[1];
+        if FRemoveStrDelimiter then
+          RemoveStringDelimiter(FToken);
+      end;
+  end;
+
+  if StatementDelimiter then
+    FTokenType := ttStatementDelimiter;
+
+  if FEOF then
+  begin
+    FLastStringDelimiterFound := '';
+    FWasString := False;
+    FString := False;
+
+    if FGenerateOnStmtDelimiter then
+      DoStatementDelimiter;
+  end;
+end;
+
+function TQueryParserComp.GetNextSymbol : string;
+begin
+    GetNextSymbol:= '';
+    while ( not EndOfFile) do
+    begin
+        NextToken;
+        if (TokenType=ttSymbol) then
+        begin
+            GetNextSymbol:= Token;
+            break;
+        end
+    end
+
+end;
+
+function TQueryParserComp.StatementDelimiter: Boolean;
+var
+  i: Integer;
+begin
+  Result := False;
+  if not FString then
+    for i := 0 to FStatementDelimiters.Count - 1 do
+    begin
+      Result := (UpperCase(FToken) = UpperCase(FStatementDelimiters.Strings[i]));
+      if Result then
+      begin
+        if FCountFromStatement then
+          FSymbolsCount := 0;
+        DoStatementDelimiter;
+        Break;
+      end;
+    end;
+end;
+
+function TQueryParserComp.CharacterType(Character: Char): TCharacterType;
+begin
+  Result := ctSymbol;
+  case Character of
+    '/':
+    begin
+      if not FComment then
+      begin
+        FCommentType := [cmt1, cmt2];
+        if CheckForBeginComment then
+          Result := ctBeginComment;
+      end;
+    end;
+    '-':
+    begin
+      if not FComment then
+      begin
+        FCommentType := [cmt3];
+        if CheckForBeginComment then
+          Result := ctBeginComment;
+      end;
+    end;
+    '*':
+    begin
+      if CheckForEndComment(Character) then
+        Result := ctEndComment;
+    end;
+    CR, LF, ' ', ',', TAB:
+    begin
+      if CheckForEndComment(Character) then
+        Result := ctEndComment
+      else
+        Result := ctDelimiter;
+
+      if FString and ((Character = CR) or (Character = LF)) then
+      begin
+        FString := False;
+        FWasString := False;
+        Result := ctDelimiter;
+      end;
+    end;
+  end;
+
+  if not FString then
+    if SpecialCharacter(Character) then
+    begin
+      if not FComment then
+        Result := ctSpecialChar;
+    end;
+
+  if not FComment then
+    if StringDelimiter(Character) then
+    begin
+      Result := ctSymbol;
+      if FString then
+      begin
+        FLastStringDelimiterFound := '';
+        FWasString := True;
+        FString := False;
+      end
+      else
+      begin
+        FWasString := False;
+        FString := True;
+      end;
+    end;
+end;
+
+function TQueryParserComp.CheckForEndComment(Character: Char): Boolean;
+var
+  Buffer: String;
+begin
+  Result := False;
+
+  if not FComment or FString then
+    Exit;
+
+  if not FEOF then
+  begin
+    if cmt1 in FCommentType then
+    begin
+      Buffer := FStream.ReadString(1);
+      if Buffer[1] = '/' then
+        Result := True;
+
+      FStream.Seek(-1, soFromCurrent);
+    end;
+    if (cmt2 in FCommentType) or (cmt3 in FCommentType) then
+    begin
+      if (Character = CR) or (Character = LF) then
+        Result := True;
+    end;
+  end;
+end;
+
+function TQueryParserComp.CheckCharcterType(Character: Char): Boolean;
+var
+  Buffer: String;
+begin
+  Result := False;
+  case CharacterType(Character) of
+    ctBeginComment:
+    begin
+      if not FComment then
+      begin
+        if FToken <> '' then
+        begin
+          FStream.Seek(-1, soFromCurrent);
+          FTokenType := ttSymbol;
+        end
+        else
+        begin
+          FComment := True;
+          FToken := FToken + Character;
+          Buffer := FStream.ReadString(1);
+          FToken := FToken + Buffer;
+          FTokenType := ttComment;
+        end;
+        Result := True;
+      end;
+    end;
+    ctEndComment:
+    begin
+      if FComment then
+      begin
+        Result := True;
+        if FToken <> '' then
+        begin
+          FStream.Seek(-1, soFromCurrent);
+          FTokenType := ttCommentedSymbol;
+        end
+        else
+        begin
+          FComment := False;
+          FToken := FToken + Character;
+          if FCommentType = [cmt1] then
+          begin
+            Buffer := FStream.ReadString(1);
+            FToken := FToken + Buffer;
+          end;
+          FTokenType := ttComment;
+        end;
+      end;
+    end;
+    ctSymbol:
+    begin
+      FToken := FToken + Character;
+      if FComment then
+        FTokenType := ttCommentedSymbol
+      else
+      begin
+        if FString or FWasString then
+        begin
+          if FWasString then
+          begin
+            FTokenType := ttString;
+            FWasString := False;
+
+
+            Result := True;
+          end
+          else
+            FTokenType := ttString;
+        end
+        else
+          FTokenType := ttSymbol;
+      end;
+    end;
+    ctSpecialChar:
+    begin
+      if FToken <> '' then
+      begin
+        FStream.Seek(-1, soFromCurrent);
+        FTokenType := ttSymbol;
+      end
+      else
+      begin
+        FToken := FToken + Character;
+        FTokenType := ttSpecialChar;
+      end;
+      Result := True;
+    end;
+    ctDelimiter:
+    begin
+      FTokenType := ttDelimiter;
+      Result := True;
+    end;
+  end
+end;
+
+procedure TQueryParserComp.RemoveStringDelimiter(var Source: String);
+var
+  EndOfString: Integer;
+  i: Integer;
+begin
+  for i := 1 to Length(FStringDelimiters) do
+  begin
+    EndOfString := 1;
+    while not (EndOfString = 0) do
+    begin
+      EndOfString := Pos(FStringDelimiters[i], Source);
+      if EndOfString <> 0 then
+      begin
+        FLastStringDelimiterFound := Copy(FStringDelimiters, i, 1);
+        Delete(Source, EndOfString, 1);
+      end;
+    end;
+  end;
+end;
+
+function TQueryParserComp.StringDelimiter(Character: Char): Boolean;
+var
+  i: Integer;
+  Buffer: String;
+begin
+  Result := False;
+
+  for i := 1 to Length(FStringDelimiters) do
+    if (Character = FStringDelimiters[i]) then
+    begin
+      if (FLastStringDelimiterFound = '') then
+        FLastStringDelimiterFound := FStringDelimiters[i];
+
+      if (FLastStringDelimiterFound = FStringDelimiters[i]) then
+      begin
+        if not FEOF then
+          Buffer := FStream.ReadString(1);
+
+        if Length(Buffer) > 0 then
+        begin
+          if Buffer[1] <> Character then
+          begin
+            FStream.Seek(-1, soFromCurrent);
+            Result := True;
+          end
+          else
+            FToken := FToken + Buffer;
+        end
+        else
+          Result := True;
+      end;
+    end;
+end;
+
+function TQueryParserComp.SpecialCharacter(Character: Char): Boolean;
+var
+  i: Integer;
+begin
+  Result := False;
+  for i := 1 to Length(FSpecialCharacters) do
+    if Character = FSpecialCharacters[i] then
+      Result := True;
+end;
+
+procedure TQueryParserComp.SetToken;
+var
+  EndToken: Boolean;
+  Buffer: String;
+begin
+  EndToken := False;
+  while not (EndToken or FEOF) do
+  begin
+    FEOF := FStream.Position >= FStream.Size-1;
+    Buffer := FStream.ReadString(1);
+    
+    if not (Buffer[1] in Delimiters) then
+      EndToken := CheckCharcterType(Buffer[1])
+    else
+    begin
+      if not (FString or FComment) then
+      begin
+        EndToken := True;
+        FStream.Seek(-1, soFromCurrent);
+      end
+      else
+      begin
+        if FString and ((Buffer[1] = CR) or (Buffer[1] = LF)) then
+        begin
+          FString := False;
+          FWasString := False;
+          EndToken := True;
+        end
+        else
+          if FComment and ((cmt2 in FCommentType) or
+             (cmt3 in FCommentType)) and ((Buffer[1] = CR) or
+             (Buffer[1] = LF)) then
+          begin
+            EndToken := True;
+            FStream.Seek(-1, soFromCurrent);
+            FComment := False;
+            FCommentType := [];
+          end
+          else
+            FToken := FToken + Buffer;
+      end;
+    end;
+  end; //while
+end;
+
+destructor TQueryParserComp.Destroy;
+begin
+  if Assigned(FStream) then
+    FStream.Free;
+
+  inherited Destroy;
+end;
+
+procedure TQueryParserComp.DoStatementDelimiter;
+var
+  Buffer: String;
+  CurrentPosition: Integer;
+begin
+  if Assigned(FOnStatementDelimiter) then
+  begin
+    CurrentPosition := FStream.Position;
+    FStream.Seek(FGoPosition, soFromBeginning);
+    Buffer := FStream.ReadString(CurrentPosition-FGoPosition-Length(FToken));
+    FStream.Seek(Length(FToken), soFromCurrent);
+    if FStream.Position >= FStream.Size then
+      FEOF := True;
+
+    FGoPosition := FStream.Position;
+
+    if FCountFromStatement then
+      FSymbolsCount := 0;
+
+    FOnStatementDelimiter(Self, Trim(Buffer));
+  end;
+end;
+
+procedure TQueryParserComp.SetStringToParse(AStringToParse: String);
+begin
+
+  if AStringToParse = '' then
+    Exit;
+
+  if Assigned(FStream) then
+    FStream.Free;
+
+  TrimRight(AStringToParse);
+  FStream := TStringStream.Create(AStringToParse);
+  FStringToParse := AStringToParse;
+
+  Init;
+end;
+
+procedure TQueryParserComp.SetSD(ASD: TStringList);
+begin
+  FStatementDelimiters.Assign(ASD);
+end;
+
+procedure TQueryParserComp.First;
+begin
+  Init;
+end;
+
+procedure TQueryParserComp.Init;
+var
+  ETextNotSet: Exception;
+begin
+  if not Assigned(FStream) then
+  begin
+    ETextNotSet := Exception.Create(sTextNotSet);
+    raise ETextNotSet;
+  end;
+
+  FStream.Seek(0, soFromBeginning);
+  FToken := '';
+  FTokenType := ttString;
+  FComment := False;
+  FCommentType := [];
+  FEOF := False;
+  FSymbolsCount := 0;
+  FGoPosition := 0;
+  FLastStringDelimiterFound := '';
+  FWasString := False;
+  FString := False;
+end;
+
+procedure TQueryParserComp.SetSpecialCharacters(ASpecialCharacters: String);
+var
+  i: Integer;
+  k: Integer;
+  IllegalSpecialChar: Exception;
+begin
+  for i := 1 to Length(ASpecialCharacters) do
+  begin
+    for k := 0 to FStatementDelimiters.Count - 1 do
+    begin
+      if (Pos(ASpecialCharacters[i], FStatementDelimiters.Strings[k]) <> 0) then
+      begin
+        IllegalSpecialChar := Exception.Create(sIllegalSpecialChar);
+        raise IllegalSpecialChar;
+      end;
+    end;
+
+    if (ASpecialCharacters[i] in Delimiters) or
+      (Pos(ASpecialCharacters[i], FStringDelimiters) <> 0) then
+    begin
+      IllegalSpecialChar := Exception.Create(sIllegalSpecialChar);
+      raise IllegalSpecialChar;
+    end;
+  end;
+
+  FSpecialCharacters := ASpecialCharacters;
+end;
+
+procedure TQueryParserComp.SetStringDelimiters(AStringDelimiters: String);
+var
+  i: Integer;
+  k: Integer;
+  IllegalStringChar: Exception;
+begin
+  for i := 1 to Length(AStringDelimiters) do
+  begin
+    for k := 0 to FStatementDelimiters.Count - 1 do
+    begin
+      if (Pos(AStringDelimiters[i], FStatementDelimiters.Strings[k]) <> 0) then
+      begin
+        IllegalStringChar := Exception.Create(sIllegalStringChar);
+        raise IllegalStringChar;
+      end;
+    end;
+
+    if (AStringDelimiters[i] in Delimiters) or
+      (Pos(AStringDelimiters[i], FSpecialCharacters) <> 0) then
+    begin
+      IllegalStringChar := Exception.Create(sIllegalStringChar);
+      raise IllegalStringChar;
+    end;
+  end;
+
+  FStringDelimiters := AStringDelimiters;
+end;
+
+end.