zsqlscript.pas

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

begin
  repeat
    Result := SqlToken(Buffer, Term, DatabaseType);
  until (Result <> #9) and (Result <> #10) and (Result <> #13);
end;

{ Check if start with command }
function SqlStartWith(Buffer, Value, Term: string;
  DatabaseType: TDatabaseType): Boolean;
var
  Token1, Token2: string;
begin
  Result := True;
  while Value <> '' do
  begin
    Token1 := SqlToken(Buffer, Term, DatabaseType);
    Token2 := StrTok(Value, ' '#9#10#13);
    if Token2 = '' then Exit;
    Result := Result and StrCaseCmp(Token1, Token2);
    if not Result then Exit;
  end;
end;

{ Check if command start with command }
function CmdStartWith(Buffer, Value: string): Boolean;
var
  Token1, Token2: string;
begin
  Result := True;
  while Value <> '' do
  begin
    Token1 := StrTok(Buffer, ' '#9#10#13);
    Token2 := StrTok(Value, ' '#9#10#13);
    if Token2 = '' then Exit;
    Result := Result and StrCaseCmp(Token1, Token2);
    if not Result then Exit;
  end;
end;

{ Extract sql query }
function ExtractSqlQuery(var Buffer: string; Term: string;
  DatabaseType: TDatabaseType): string;
var
  Token: string;
  NewLine: Boolean;
begin
  Result := '';
  NewLine := True;
  while Buffer <> '' do
  begin
    if SkipComment(Buffer, DatabaseType) and (Result <> '') then
      Result := Result + ' ';
    if SkipTerm(Buffer, Term, DatabaseType) then
      Break;
    ExtractLowToken(Buffer, Token);
    if Token = #10 then Token := #13;
    if NewLine and (Token = #13) then
      Continue;
    NewLine := (Token = #13);
    Result := Result + Token;
  end;
end;

{ Check a reserved sql word }
function CheckKeyword(DatabaseType: TDatabaseType; Value: string): Boolean;
begin
  Value := UpperCase(Value);
  Result := True;
  { Check universal keywords }
  if (Value = 'WHERE') or (Value = 'INTO') or (Value = 'GROUP')
    or (Value = 'ORDER') or (Value = 'HAVING') or (Value = 'FROM')
    or (Value = 'FOR') then Exit;
  { Check MySql keywords }
  if (DatabaseType = dtMySql) and ((Value = 'PROCEDURE')
    or (Value = 'LIMIT')) then Exit;
  { Check PostgreSql keywords }
  if (DatabaseType = dtPostgreSql) and ((Value = 'LIMIT')) then Exit;
  { Check Oracle keywords }
  if (DatabaseType = dtOracle) and ((Value = 'START')) then Exit;
  { Check MS SQL keywords }
  if (DatabaseType = dtMsSql) and ((Value = 'COMPUTE')
    or (Value = 'OPTION')) then Exit;
  { Check Interbase, MS SQL, PostgreSql and Oracle keywords }
  if (DatabaseType in [dtInterbase, dtMsSql, dtPostgreSql, dtOracle])
    and ((Value = 'UNION')) then Exit;
  { Check PostgreSql and Oracle keywords }
  if (DatabaseType in [dtPostgreSql, dtOracle])
    and ((Value = 'INTERSECT') or (Value = 'EXCEPT')) then Exit;
  Result := False;
end;

{ Extract from sql query select and from parts }
function SplitSelect(Sql: string; DatabaseType: TDatabaseType;
  var Select, From: string): Boolean;
var
  Token: string;
begin
  Select := '';
  From := '';
  Result := False;

  Token := SqlTokenEx(Sql, ';', DatabaseType);
  if not StrCaseCmp(Token, 'SELECT') then Exit;
  Result := True;

  while Sql <> '' do
  begin
    Token := SqlTokenEx(Sql, ';', DatabaseType);
    if StrCaseCmp(Token, 'FROM') then
      Break;
    if StrCaseCmp(Token, 'INTO') then
    begin
      while (SqlTokenEx(Sql, ';', DatabaseType) <> 'FROM') and (Sql <> '') do;
      Break;
    end;
    if CheckKeyword(DatabaseType, Token) then
      Exit;
    Select := Select + Token;
    if (Sql <> '') and (Sql[1] in [' ', #9, #10, #13]) then
      Select := Select + ' ';
  end;

  while (Sql <> '') and (Sql[1] <> ';') do
  begin
    Token := SqlTokenEx(Sql, ';', DatabaseType);
    if CheckKeyword(DatabaseType, Token) then
      Exit;
    From := From + Token;
    if (Sql <> '') and (Sql[1] in [' ', #9, #10, #13]) then
      From := From + ' ';
  end;
end;

{ Define position of sql parts }
function DefineSqlPos(Sql: string; DatabaseType: TDatabaseType;
  var SelectStartPos, WhereStartPos, WherePos, OrderPos: Integer): Boolean;
type
  TSeekState = (ssNone, ssFrom, ssWhere, ssOrder);
var
  Temp, Token: string;
  SaveLen: Integer;
  SavePos: Integer;
  State: TSeekState;
begin
  SelectStartPos := 0;
  WhereStartPos := 0;
  WherePos := 0;
  OrderPos := 0;
  SaveLen := Length(Sql) + 1;
  State := ssNone;

  Result := (UpperCase(SqlTokenEx(Sql, ';', DatabaseType)) = 'SELECT');
  if not Result then Exit;

  { Skip select list keywords }
  while True do
  begin
    Temp := Sql;
    Token := UpperCase(SqlTokenEx(Sql, ';', DatabaseType));
    if (Token = 'DISTINCT') or (Token = 'ALL') or (Token = 'DISTINCTROW') then
      Continue;
    if (DatabaseType = dtMySql) and ((Token = 'STRAIGNT_JOIN')
      or (Token = 'SQL_SMALL_RESULT') or (Token = 'SQL_BIG_RESULT')
      or (Token = 'SQL_BUFFER_RESULT') or (Token = 'HIGH_PRIORITY')) then
      Continue;
    Sql := Temp;
    SelectStartPos := SaveLen - Length(Sql);
    Break;
  end;

  while (Sql <> '') and (Sql[1] <> ';')
    and ((WherePos = 0) or (OrderPos = 0)) do
  begin
    SavePos := SaveLen - Length(Sql);
    Token := UpperCase(SqlTokenEx(Sql, ';', DatabaseType));
    { Set where start pos }
    if (State = ssWhere) and (WhereStartPos = 0) then
      WhereStartPos := SaveLen - Length(Sql) - Length(Token);
    if not CheckKeyword(DatabaseType, Token) then
      Continue;
    { Check for Where position }
    if (Token = 'FROM') and (WherePos = 0) then
    begin
      State := ssFrom;
      Continue;
    end;
    if (Token = 'WHERE') and (WherePos = 0) then
    begin
      State := ssWhere;
      Continue;
    end;
    if (State = ssFrom) and (WherePos = 0) then
    begin
      WherePos := -SavePos;
      State := ssNone;
    end;
    if (State = ssWhere) and (WherePos = 0) then
    begin
      WherePos := SavePos;
      State := ssNone;
    end;
    { Check for Order position }
    if (Token = 'ORDER') and (OrderPos = 0) then
    begin
      State := ssOrder;
      Continue;
    end;
    if (State = ssOrder) and (OrderPos = 0) then
    begin
      OrderPos := SavePos;
      State := ssNone;
    end;
    if (Token = 'COMPUTE') or (Token = 'FOR') then
    begin
      if WherePos = 0 then
        WherePos := -SavePos;
      if OrderPos = 0 then
        OrderPos := -SavePos;
    end;
  end;

  if (State = ssWhere) and (WherePos = 0) then
    WherePos := SaveLen;
  if (State = ssOrder) and (OrderPos = 0) then
    OrderPos := SaveLen;
end;

{ Compose sql statement }
function ComposeSelect(Sql, WhereAdd, OrderAdd: string;
  WhereStartPos, WherePos, OrderPos: Integer): string;
var
  Temp: string;
begin
  Temp := '';
  Result := Sql;
  { Update positions }
  if WherePos = 0 then WherePos := - Length(Sql) - 1;
  if OrderPos = 0 then OrderPos := - Length(Sql) - 1;
  if WhereAdd = '' then WherePos := 0;
  if OrderAdd = '' then OrderPos := 0;
  { Insert where statement}
  if WhereAdd <> '' then
  begin
    if (WhereStartPos > 0) and (WherePos > 0) then
    begin
      Insert('(', Result, WhereStartPos);
      if WherePos < 0 then Dec(WherePos)
      else Inc(WherePos);
      if OrderPos < 0 then Dec(OrderPos)
      else Inc(OrderPos);
    end;
    if WherePos < 0 then
      Temp := ' WHERE ' + WhereAdd
    else Temp := ') AND ' + WhereAdd;
    WherePos := Abs(WherePos);
    Insert(Temp, Result, WherePos);
    if OrderPos < 0 then
      OrderPos := OrderPos - Length(Temp)
    else OrderPos := OrderPos + Length(Temp);
  end;
  { Insert order by statement }
  if OrderAdd <> '' then
  begin
    if OrderPos < 0 then
      Temp := ' ORDER BY ' + OrderAdd
    else Temp := ', ' + OrderAdd;
    OrderPos := Abs(OrderPos);
    Insert(Temp, Result, OrderPos);
  end;
end;

{ Define table names in SELECT query }
procedure ExtractTables(From: string; Tables, Aliases: TStrings);
var
  Token, Table, Alias: string;
  NextTable, Find: Boolean;
  I: Integer;
begin
  Tables.Clear;
  Aliases.Clear;

{ Extract table names }
  NextTable := True;
  while From <> '' do
  begin
    Token := SqlTokenEx(From, ';', dtUnknown);
    if NextTable then
    begin
      NextTable := False;
      Table := Token;

      { Define table alias }
      Token := SqlTokenEx(From, ';', dtUnknown);
      if Token = '.' then
      begin
        Token := SqlTokenEx(From, ';', dtUnknown);
        Table := Table + '.' + Token;
        Token := SqlTokenEx(From, ';', dtUnknown);
      end;

      if StrCaseCmp(Token, 'AS') or (Token = '=') then
        Alias := SqlTokenEx(From, ';', dtUnknown)
      else if ((Token <> '') and (Token[1] in ['a'..'z','A'..'Z','''','"','[']))
        and not StrCaseCmp(Token, 'LEFT')
        and not StrCaseCmp(Token, 'NATURAL') and not StrCaseCmp(Token, 'RIGHT')
        and not StrCaseCmp(Token, 'ON') and not StrCaseCmp(Token, 'USING')
      then
        Alias := Token
      else
        Alias := Table;

      Find := False;
      Table := DeleteSqlQuotes(Table);
      Alias := DeleteSqlQuotes(Alias);
      for I := 0 to Tables.Count-1 do
        if StrCaseCmp(Tables[I], Table) and StrCaseCmp(Aliases[I], Alias) then
        begin
          Find := True;
          Break;
        end;

      if not Find then
      begin
        Tables.Add(Table);
        Aliases.Add(Alias);
      end;
    end;
    if StrCaseCmp(Token, 'JOIN') or (Token = ',') then
      NextTable := True;
  end;
end;

end.