gaadvancedsqlparser.pas

一个sql语法分析程序

procedure TgaCustomSQLStatement.DoTokenParsed;
begin
  CurrentToken := OriginalSQL.NewToken;
  CurrentToken.AssignTokenInfo(OwnerParser);
  CurrentToken.IsOriginal := True;
  CurrentSQL.AddToken(CurrentToken);
  DoTokenAdded(Self, CurrentToken);
end;

function TgaCustomSQLStatement.GetAsString: string;
begin
  Result := CurrentSQL.AsString;
end;

procedure TgaCustomSQLStatement.ModifyStatementInErrorState(Sender: TObject; 
        AToken: TgaSQLTokenObj);
begin
  ;// Do nothing here
end;

procedure TgaCustomSQLStatement.ModifyStatementInNormalState(Sender: TObject; 
        AToken: TgaSQLTokenObj);
begin
  ;// Do nothing here
end;

procedure TgaCustomSQLStatement.ReleaseOwnedItems;
begin
  FCurrentToken := nil;
  FAllFields := nil;
  FAllTables := nil;
  FCurrentSQL := nil;
  FOriginalSQL := nil;
end;

procedure TgaCustomSQLStatement.RemoveField(AField: TgaSQLTokenList);
begin
  AllFields.Remove(AField);
  if Assigned(OwnerStm) then
    OwnerStm.RemoveField(AField);
end;

procedure TgaCustomSQLStatement.RemoveTable(ATable: TgaSQLTokenList);
begin
  AllTables.Remove(ATable);
  if Assigned(OwnerStm) then
    OwnerStm.RemoveTable(ATable);
end;

procedure TgaCustomSQLStatement.SetStatusCode(Value: Integer);
begin
  if FStatusCode <> Value then
  begin
  if Value <> 0 then
    OnTokenAdded := ModifyStatementInErrorState;
  FStatusCode := Value;
  end;
end;

{
***************************** TgaAdvancedSQLParser *****************************
}
destructor TgaAdvancedSQLParser.Destroy;
begin
  FCurrentStatement.Free;
  inherited;
end;

class function TgaAdvancedSQLParser.AddStatementClass(const ATokenSymbol: 
        string; AStatementClass: TgaSQLSTatementClass): Integer;
begin
  Result := StatementClassList.AddObject(UpperCase(ATokenSymbol), TObject(AStatementClass));
end;

procedure TgaAdvancedSQLParser.DoStatementComplete;
begin
  if Assigned(FOnStatementComplete) then
    FOnStatementComplete(Self);
end;

procedure TgaAdvancedSQLParser.DoTokenParsed;
begin
  CurrentStatement.DoTokenParsed;
  inherited;
end;

function TgaAdvancedSQLParser.GetCurrentStatement: TgaCustomSQLStatement;
begin
  if not Assigned(FCurrentStatement) then
    FCurrentStatement := GetStatementClass.Create(Self);
  Result := FCurrentStatement;
end;

function TgaAdvancedSQLParser.GetStatementClass: TgaSQLSTatementClass;
begin
  Result := TgaNoSQLStatement;
  if TokenType = stSymbol then
    Result := GetStatementClassForToken(TokenString);
end;

class function TgaAdvancedSQLParser.GetStatementClassForToken(const 
        ATokenSymbol: string): TgaSQLSTatementClass;
var
  i: Integer;
  lTokenSymbol: string;
begin
  Result := TgaUnkownSQLSTatement;
  lTokenSymbol := UpperCase(ATokenSymbol);
  for i := StatementClassList.Count - 1 downto 0 do
    if StatementClassList[i] = lTokenSymbol then
    begin
      Result := TgaSQLSTatementClass(StatementClassList.Objects[i]);
      Exit;
    end;
end;

class procedure TgaAdvancedSQLParser.RemoveStatementClass(const ATokenSymbol: 
        string; AStatementClass: TgaSQLSTatementClass);
var
  i: Integer;
  lTokenSymbol: string;
begin
  lTokenSymbol := UpperCase(ATokenSymbol);
  for i := StatementClassList.Count - 1 downto 0 do
    if (StatementClassList[i] = lTokenSymbol) and
      (StatementClassList.Objects[i] = TObject(AStatementClass)) then
    begin
      StatementClassList.Delete(i);
      Exit;
    end;
end;

procedure TgaAdvancedSQLParser.Reset;
begin
  FreeAndNil(FCurrentStatement);
  inherited;
end;

procedure TgaAdvancedSQLParser.SetCurrentStatement(AStatement: 
        TgaCustomSQLStatement);
begin
  FCurrentStatement := AStatement;
end;

{
**************************** TgaUnkownSQLStatement *****************************
}
function TgaUnkownSQLStatement.GetStatementType: TSQLStatementType;
begin
  Result := sstUnknown;
end;

{
****************************** TgaNoSQLStatement *******************************
}
function TgaNoSQLStatement.GetStatementType: TSQLStatementType;
begin
  Result := sstNoStatementFound;
end;

procedure TgaNoSQLStatement.ModifyStatementInNormalState(Sender: TObject; 
        AToken: TgaSQLTokenObj);
var
  tmpSQLStatement: TgaCustomSQLStatement;
begin
  if OwnerParser.GetStatementClass <> TgaNoSQLStatement then
  begin
    tmpSQLStatement := OwnerParser.GetStatementClass.CreateFromStatement(OwnerParser, Self);
    OwnerParser.SetCurrentStatement(tmpSQLStatement);
    tmpSQLStatement.ModifyStatementInNormalState(Sender, AToken);
    Self.Free;
  end else
    inherited;
end;

{
**************************** TgaListOfSQLTokenLists ****************************
}
constructor TgaListOfSQLTokenLists.Create;
begin
  inherited;
  FOwnsLists := True;
end;

procedure TgaListOfSQLTokenLists.ExecuteTokenAdded(Sender: TObject; AToken: 
        TgaSQLTokenObj);
begin
  ;// Do nothing here
end;

procedure TgaListOfSQLTokenLists.GetAllTokens(ATokenList: TgaSQLTokenList);
var
  AItem: TgaSQLTokenList;
begin
  ATokenList.Clear;
  First;
  while not Eof do
  begin
    AItem := CurrentItem;
    AItem.First;
    while not AItem.Eof do
    begin
      ATokenList.Add(AItem.CurrentItem);
      AItem.Next;
    end;
    Next;
  end;
end;

function TgaListOfSQLTokenLists.GetAsString: string;
begin
  Result := EmptyStr;
  First;
  while not Eof do
  begin
    Result := Result + CurrentItem.AsString;
    Next;
  end;
end;

function TgaListOfSQLTokenLists.GetCurrentItem: TgaSQLTokenList;
begin
  Result := TgaSQLTokenList(inherited CurrentItem);
end;

function TgaListOfSQLTokenLists.GetLastItem: TgaSQLTokenList;
begin
  Result := TgaSQLTokenList(inherited LastItem);
end;

procedure TgaListOfSQLTokenLists.Notify(Ptr: Pointer; Action: 
        TListNotification);
begin
  if OwnsLists then
    if Action = lnDeleted then
      TObject(Ptr).Free;
  inherited;
end;

{
*************************** TgaSQLTokenListBookmark ****************************
}
function TgaSQLTokenListBookmark.GetTokenObj: TgaSQLTokenObj;
begin
  Result := TgaSQLTokenObj(Item);
end;

procedure TgaSQLTokenListBookmark.SetTokenObj(Value: TgaSQLTokenObj);
begin
  Item := Value;
end;

{
******************************** TgaSQLTokenObj ********************************
}
constructor TgaSQLTokenObj.CreatePlaceHolder;
begin
  inherited Create;
  FTokenType := stPlaceHolder;
  FTokenString := EmptyStr;
  FQuoteChar := #0;
  FTokenQuoted := False;
end;

procedure TgaSQLTokenObj.AssignTokenInfo(ASQLParser: TgaBasicSQLParser);
begin
  FTokenType := ASQLParser.TokenType;
  FTokenString := ASQLParser.TokenString;
  FQuoteChar := ASQLParser.QuoteChar;
  FTokenQuoted := ASQLParser.TokenQuoted;
end;

function TgaSQLTokenObj.GetTokenAsString: string;
begin
  Result := TokenString;
  if TokenQuoted then
    Result := QuoteChar + Result + QuoteChar;
  if TokenType = stParameter then
    Result := ':' + Result;
end;

procedure TgaSQLTokenObj.SetTokenInfo(const AString: string; ATokenType: 
        TSQLToken; AQuoted: Boolean; AQuoteChar: char);
begin
  FTokenType := ATokenType;
  FTokenString := AString;
  FQuoteChar := AQuoteChar;
  FTokenQuoted := AQuoted;
end;

function TgaSQLTokenObj.TokenSymbolIs(const S: string): Boolean;
begin
  Result := (TokenType = stSymbol) and (CompareText(FTokenString, S) = 0);
end;

{
******************************* TgaSQLTokenList ********************************
}
constructor TgaSQLTokenList.Create(AOwnerStatement: TgaCustomSQLStatement);
begin
  inherited Create;
  FOwnerStatement := AOwnerStatement;
end;

constructor TgaSQLTokenList.CreateMirror(AOwnerStatement: TgaCustomSQLStatement;
        AMirroredList: TgaSQLTokenList);
var
  IsOk: Boolean;
begin
  if Assigned(AOwnerStatement.OwnerStm) then
  begin
    IsOk := (AMirroredList.DataOwner = AOwnerStatement.OwnerStm.CurrentSQL) or
            (AMirroredList.DataOwner = AOwnerStatement.OwnerStm.OriginalSQL);
  end else
    IsOk := AOwnerStatement.CurrentSQL.DataOwner = AMirroredList.DataOwner;
  if not IsOk then
    raise Exception.Create('List to be mirrored is not the OwnerStatement list');
  FOwnerStatement := AOwnerStatement;
  inherited CreateMirror(AMirroredList);
  SetStartPos(AMirroredList, True);
end;

procedure TgaSQLTokenList.ExecuteTokenAdded(Sender: TObject; AToken: 
        TgaSQLTokenObj);
begin
  ;// Do nothing here
end;

procedure TgaSQLTokenList.GetAllTokens(ATokenList: TgaSQLTokenList);
begin
  ATokenList.Clear;
  First;
  while not Eof do
  begin
    ATokenList.Add(CurrentItem);
    Next;
  end;
end;

function TgaSQLTokenList.GetAsString: string;
begin
  Result := EmptyStr;
  First;
  while not Eof do
  begin
    Result := Result + CurrentItem.TokenAsString;
    Next;
  end;
end;

function TgaSQLTokenList.GetBookmark: TgaSQLTokenListBookmark;
begin
  Result := TgaSQLTokenListBookmark.Create(Self);
end;

function TgaSQLTokenList.GetCurrentItem: TgaSQLTokenObj;
begin
  Result := TgaSQLTokenObj(inherited CurrentItem);
end;

function TgaSQLTokenList.GetTokenObjAsString(ATokenObj: TgaSQLTokenObj): string;
begin
  if Assigned(ATokenObj) then
    Result := ATokenObj.TokenAsString
  else
    Result := EmptyStr;
end;

procedure TgaSQLTokenList.SetCurrentItem(Value: TgaSQLTokenObj);
begin
  if Assigned(OwnerStatement) and (OwnerStatement.CurrentSQL = DataOwner) then
    if not CurrentItem.IsOriginal then
      CurrentItem.Free;
  inherited CurrentItem := Value;
end;

initialization
  StatementClassList := TStringList.Create;
  TgaAdvancedSQLParser.AddStatementClass('SELECT', TgaSelectSQLStatement);
  TgaAdvancedSQLParser.AddStatementClass('UPDATE', TgaUpdateSQLStatement);
  TgaAdvancedSQLParser.AddStatementClass('DELETE', TgaDeleteSQLStatement);
  TgaAdvancedSQLParser.AddStatementClass('INSERT', TgaInsertSQLStatement);

finalization
  TgaAdvancedSQLParser.RemoveStatementClass('SELECT', TgaSelectSQLStatement);
  TgaAdvancedSQLParser.RemoveStatementClass('UPDATE', TgaUpdateSQLStatement);
  TgaAdvancedSQLParser.RemoveStatementClass('DELETE', TgaDeleteSQLStatement);
  TgaAdvancedSQLParser.RemoveStatementClass('INSERT', TgaInsertSQLStatement);
  StatementClassList.Free;

end.