{ dbapi_dialect.pas — Core interfaces and spec types for the DBAPI framework. Defines: - TDBAColumnSpec / TDBATableSpec / TDBAIndexSpec — declarative schema - TDBACriterion hierarchy — WHERE clause builder (Compare + Compound) - TDBASelectSpec — structured SELECT spec - IDBADialect — interface every backend dialect implements - TDBADialectBase — abstract base class with shared helpers; concrete dialects inherit from this to get lifecycle, hooks, param handling A concrete dialect (SQLite/MariaDB/Postgres) lives in its own unit and overrides the emitter and execution methods. Consumers never touch a concrete class after construction — they hold an IDBADialect and the refcount handles cleanup. No Fastway-specific dependencies: only FPC RTL + fpjson + sqldb. } unit dbapi_dialect; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpjson, sqldb, db, dbapi_consts, dbapi_hooks; type { What happens to child rows when the parent is deleted. } TDBAOnDeleteAction = ( doaNoAction, { Default per-backend; typically rejects } doaCascade, { Delete child rows too } doaSetNull, { Null out the FK column } doaRestrict, { Explicit reject; fail the delete } doaSetDefault { Set FK column back to its default } ); { Foreign key descriptor embedded in a column spec. RefTable empty means no FK on this column. } TDBAForeignKey = record RefTable: string; RefColumn: string; OnDelete: TDBAOnDeleteAction; end; { Single column definition. Use MakeColumn for common cases, or construct the record directly to set ForeignKey / CaseInsensitive. } TDBAColumnSpec = record Name: string; ColType: TDBAColumnType; Length: Integer; { For dctVarchar; 0 = dialect default } Nullable: Boolean; DefaultExpr: string; { Literal SQL fragment; empty = no default } PrimaryKey: Boolean; { Single-column PK shortcut } Unique: Boolean; AutoIncrement: Boolean; { Only honored when PrimaryKey and Integer/BigInt } CaseInsensitive: Boolean; { Emits backend-appropriate collation } ForeignKey: TDBAForeignKey; { Zero-value = no FK } end; { Multi-column index. Unique flag marks it as a UNIQUE index. Indexes created separately from the table via CREATE INDEX. } TDBAIndexSpec = record Name: string; Columns: array of string; Unique: Boolean; end; { Composite UNIQUE constraint inside the CREATE TABLE statement. Unlike TDBAIndexSpec, this is part of the table schema (not a separate index), which is how SQLite requires it for INSERT OR IGNORE / ON CONFLICT semantics to work. } TDBAUniqueConstraint = record Name: string; { Optional; dialect may synthesize } Columns: array of string; end; { Full table definition. PrimaryKeyColumns is used when the PK spans multiple columns; if empty, any column with PrimaryKey=True becomes the PK. } TDBATableSpec = record Name: string; Columns: array of TDBAColumnSpec; Indexes: array of TDBAIndexSpec; UniqueConstraints: array of TDBAUniqueConstraint; PrimaryKeyColumns: array of string; end; { --- Criteria (WHERE clause tree) --- Abstract base + two concrete subclasses. Classes (not records) because the tree is polymorphic: a Compound node holds children that can be Compare or more Compound. Ownership: the criterion tree is consumer-owned. A compound node takes ownership of its children when Add is called — freeing the root frees the whole tree. } TDBACriterion = class public { Dialect-agnostic. Concrete dialects translate via WhereToSQL. } end; TDBACompareCriterion = class(TDBACriterion) private FColumn: string; FOp: TDBACompareOp; FValue: TJSONData; { Owned if FOwnsValue; may be nil for IsNull/IsNotNull } FOwnsValue: Boolean; public constructor Create(const AColumn: string; AOp: TDBACompareOp); constructor CreateCmp(const AColumn: string; AOp: TDBACompareOp; AValue: TJSONData; AOwnsValue: Boolean = True); destructor Destroy; override; property Column: string read FColumn; property Op: TDBACompareOp read FOp; property Value: TJSONData read FValue; end; TDBACompoundCriterion = class(TDBACriterion) private FOp: TDBABoolOp; FChildren: TList; { Owned TDBACriterion references } public constructor Create(AOp: TDBABoolOp); destructor Destroy; override; procedure Add(AChild: TDBACriterion); { Takes ownership } function ChildCount: Integer; function Child(AIndex: Integer): TDBACriterion; property BoolOp: TDBABoolOp read FOp; end; { One ORDER BY element. } TDBAOrderSpec = record Column: string; Direction: TDBAOrderDir; end; { Full SELECT spec. Columns empty = SELECT *. Where nil = no WHERE. Limit 0 = no limit. Offset 0 = no offset. } TDBASelectSpec = record Table: string; Columns: array of string; Where: TDBACriterion; { Consumer-owned, not freed by dialect } OrderBy: array of TDBAOrderSpec; Limit: Integer; Offset: Integer; end; { Public interface. Consumer code holds IDBADialect, refcount manages instance lifetime. } IDBADialect = interface ['{3F1E4A20-5B7C-4D18-9B2A-7E3A6C8D1F01}'] function Backend: TDBABackend; function ServerFlavor: string; function Hooks: TDBAHookRegistry; function Connection: TSQLConnection; function Owned: Boolean; function IsConnected: Boolean; procedure Connect; procedure Disconnect; function QuoteIdent(const AName: string): string; function NowExpr: string; function DateAddExpr(AAmount: Integer; AUnit: TDBADateUnit): string; function AutoIncPrimaryKey(AType: TDBAColumnType): string; function SqlType(AType: TDBAColumnType; ALength: Integer): string; function BooleanLiteral(AValue: Boolean): string; function UpsertStmt(const ATable: string; const AAllCols, AKeyCols: array of string): string; function InsertReturningIdClause: string; function WhereToSQL(ACriterion: TDBACriterion; AParams: TJSONArray): string; { Collation clause fragment for a case-sensitive vs case-insensitive column. Returns an empty string for sensitive, or a backend- appropriate clause like ' COLLATE NOCASE'. The leading space is included so callers can concatenate directly. } function CollationClause(ACaseInsensitive: Boolean): string; { Text rendering of an ON DELETE clause for an FK (e.g. 'CASCADE', 'SET NULL'). Returns empty string for doaNoAction. } function OnDeleteAction(AAction: TDBAOnDeleteAction): string; { Emit a statement that inserts a row, silently ignoring uniqueness conflicts. Backend-specific: INSERT OR IGNORE (SQLite), INSERT IGNORE (MariaDB), INSERT ... ON CONFLICT DO NOTHING (PG). } function InsertOrIgnoreStmt(const ATable: string; const ACols: array of string): string; procedure ExecSQL(const ASQL: string; AParams: TJSONArray); function QuerySQL(const ASQL: string; AParams: TJSONArray): TJSONArray; function GetLastInsertID: Int64; function TableExists(const AName: string): Boolean; function GetColumns(const ATable: string): TJSONArray; end; { Abstract base class. Concrete dialects inherit. Implements IDBADialect via the class, so descendants only override what they need. } TDBADialectBase = class(TInterfacedObject, IDBADialect) protected FConnection: TSQLConnection; FTransaction: TSQLTransaction; FOwnsConnection: Boolean; FHooks: TDBAHookRegistry; FServerFlavor: string; FConnected: Boolean; procedure AttachConnection(AConn: TSQLConnection; AOwns: Boolean); procedure FireQueryLog(const ASQL: string; ADurationMS: Int64; AParams: TJSONArray; ARowsAffected: Integer); public constructor Create; destructor Destroy; override; function Backend: TDBABackend; virtual; abstract; function ServerFlavor: string; function Hooks: TDBAHookRegistry; function Connection: TSQLConnection; function Owned: Boolean; function IsConnected: Boolean; procedure Connect; virtual; procedure Disconnect; virtual; function QuoteIdent(const AName: string): string; virtual; abstract; function NowExpr: string; virtual; abstract; function DateAddExpr(AAmount: Integer; AUnit: TDBADateUnit): string; virtual; abstract; function AutoIncPrimaryKey(AType: TDBAColumnType): string; virtual; abstract; function SqlType(AType: TDBAColumnType; ALength: Integer): string; virtual; abstract; function BooleanLiteral(AValue: Boolean): string; virtual; abstract; function UpsertStmt(const ATable: string; const AAllCols, AKeyCols: array of string): string; virtual; abstract; function InsertReturningIdClause: string; virtual; function WhereToSQL(ACriterion: TDBACriterion; AParams: TJSONArray): string; virtual; function CollationClause(ACaseInsensitive: Boolean): string; virtual; function OnDeleteAction(AAction: TDBAOnDeleteAction): string; virtual; function InsertOrIgnoreStmt(const ATable: string; const ACols: array of string): string; virtual; procedure ExecSQL(const ASQL: string; AParams: TJSONArray); virtual; function QuerySQL(const ASQL: string; AParams: TJSONArray): TJSONArray; virtual; function GetLastInsertID: Int64; virtual; abstract; function TableExists(const AName: string): Boolean; virtual; abstract; function GetColumns(const ATable: string): TJSONArray; virtual; abstract; end; { --- Spec builder helpers. Records can't have constructors in mode objfpc, so we provide free functions for ergonomic construction. Consumer code reads naturally: Spec.Columns := [ MakeColumn('id', dctBigInt, 0, False, '', True, True, True), MakeColumn('name', dctVarchar, 255, False), MakeColumn('created_at', dctDateTime, 0, False) ]; } function MakeColumn(const AName: string; AType: TDBAColumnType; ALength: Integer = 0; ANullable: Boolean = True; const ADefault: string = ''; APrimaryKey: Boolean = False; AUnique: Boolean = False; AAutoIncrement: Boolean = False): TDBAColumnSpec; function MakeIndex(const AName: string; const AColumns: array of string; AUnique: Boolean = False): TDBAIndexSpec; function MakeOrder(const AColumn: string; ADir: TDBAOrderDir = dodAsc): TDBAOrderSpec; { Build a foreign key descriptor. Attach it to a column's ForeignKey field. Example: Col := MakeColumn('user_id', dctInteger, 0, True); Col.ForeignKey := MakeFK('users', 'id', doaSetNull); } function MakeFK(const ARefTable, ARefColumn: string; AOnDelete: TDBAOnDeleteAction = doaNoAction): TDBAForeignKey; { Build a composite UNIQUE constraint. } function MakeUnique(const AName: string; const AColumns: array of string): TDBAUniqueConstraint; { --- Criteria builder helpers. } function Cmp(const AColumn: string; AOp: TDBACompareOp; AValue: TJSONData): TDBACompareCriterion; function CmpStr(const AColumn: string; AOp: TDBACompareOp; const AValue: string): TDBACompareCriterion; function CmpInt(const AColumn: string; AOp: TDBACompareOp; AValue: Int64): TDBACompareCriterion; function CmpBool(const AColumn: string; AOp: TDBACompareOp; AValue: Boolean): TDBACompareCriterion; function IsNull(const AColumn: string): TDBACompareCriterion; function IsNotNull(const AColumn: string): TDBACompareCriterion; { Build a compound. Pass children; builder takes ownership. } function AndOf(const AChildren: array of TDBACriterion): TDBACompoundCriterion; function OrOf(const AChildren: array of TDBACriterion): TDBACompoundCriterion; implementation uses DateUtils; { --- Spec builders --- } function MakeColumn(const AName: string; AType: TDBAColumnType; ALength: Integer; ANullable: Boolean; const ADefault: string; APrimaryKey: Boolean; AUnique: Boolean; AAutoIncrement: Boolean): TDBAColumnSpec; begin Result.Name := AName; Result.ColType := AType; Result.Length := ALength; Result.Nullable := ANullable; Result.DefaultExpr := ADefault; Result.PrimaryKey := APrimaryKey; Result.Unique := AUnique; Result.AutoIncrement := AAutoIncrement; Result.CaseInsensitive := False; Result.ForeignKey.RefTable := ''; Result.ForeignKey.RefColumn := ''; Result.ForeignKey.OnDelete := doaNoAction; end; function MakeIndex(const AName: string; const AColumns: array of string; AUnique: Boolean): TDBAIndexSpec; var I: Integer; begin Result.Name := AName; SetLength(Result.Columns, Length(AColumns)); for I := 0 to High(AColumns) do Result.Columns[I] := AColumns[I]; Result.Unique := AUnique; end; function MakeOrder(const AColumn: string; ADir: TDBAOrderDir): TDBAOrderSpec; begin Result.Column := AColumn; Result.Direction := ADir; end; function MakeFK(const ARefTable, ARefColumn: string; AOnDelete: TDBAOnDeleteAction): TDBAForeignKey; begin Result.RefTable := ARefTable; Result.RefColumn := ARefColumn; Result.OnDelete := AOnDelete; end; function MakeUnique(const AName: string; const AColumns: array of string): TDBAUniqueConstraint; var I: Integer; begin Result.Name := AName; SetLength(Result.Columns, Length(AColumns)); for I := 0 to High(AColumns) do Result.Columns[I] := AColumns[I]; end; { --- Criteria builders --- } function Cmp(const AColumn: string; AOp: TDBACompareOp; AValue: TJSONData): TDBACompareCriterion; begin Result := TDBACompareCriterion.CreateCmp(AColumn, AOp, AValue, True); end; function CmpStr(const AColumn: string; AOp: TDBACompareOp; const AValue: string): TDBACompareCriterion; begin Result := TDBACompareCriterion.CreateCmp(AColumn, AOp, TJSONString.Create(AValue), True); end; function CmpInt(const AColumn: string; AOp: TDBACompareOp; AValue: Int64): TDBACompareCriterion; begin Result := TDBACompareCriterion.CreateCmp(AColumn, AOp, TJSONInt64Number.Create(AValue), True); end; function CmpBool(const AColumn: string; AOp: TDBACompareOp; AValue: Boolean): TDBACompareCriterion; begin Result := TDBACompareCriterion.CreateCmp(AColumn, AOp, TJSONBoolean.Create(AValue), True); end; function IsNull(const AColumn: string): TDBACompareCriterion; begin Result := TDBACompareCriterion.Create(AColumn, dcoIsNull); end; function IsNotNull(const AColumn: string): TDBACompareCriterion; begin Result := TDBACompareCriterion.Create(AColumn, dcoIsNotNull); end; function AndOf(const AChildren: array of TDBACriterion): TDBACompoundCriterion; var I: Integer; begin Result := TDBACompoundCriterion.Create(dboAnd); for I := 0 to High(AChildren) do Result.Add(AChildren[I]); end; function OrOf(const AChildren: array of TDBACriterion): TDBACompoundCriterion; var I: Integer; begin Result := TDBACompoundCriterion.Create(dboOr); for I := 0 to High(AChildren) do Result.Add(AChildren[I]); end; { --- TDBACompareCriterion --- } constructor TDBACompareCriterion.Create(const AColumn: string; AOp: TDBACompareOp); begin inherited Create; FColumn := AColumn; FOp := AOp; FValue := nil; FOwnsValue := False; end; constructor TDBACompareCriterion.CreateCmp(const AColumn: string; AOp: TDBACompareOp; AValue: TJSONData; AOwnsValue: Boolean); begin inherited Create; FColumn := AColumn; FOp := AOp; FValue := AValue; FOwnsValue := AOwnsValue; end; destructor TDBACompareCriterion.Destroy; begin if FOwnsValue and Assigned(FValue) then FValue.Free; inherited Destroy; end; { --- TDBACompoundCriterion --- } constructor TDBACompoundCriterion.Create(AOp: TDBABoolOp); begin inherited Create; FOp := AOp; FChildren := TList.Create; end; destructor TDBACompoundCriterion.Destroy; var I: Integer; begin for I := 0 to FChildren.Count - 1 do TDBACriterion(FChildren[I]).Free; FChildren.Free; inherited Destroy; end; procedure TDBACompoundCriterion.Add(AChild: TDBACriterion); begin if Assigned(AChild) then FChildren.Add(AChild); end; function TDBACompoundCriterion.ChildCount: Integer; begin Result := FChildren.Count; end; function TDBACompoundCriterion.Child(AIndex: Integer): TDBACriterion; begin Result := TDBACriterion(FChildren[AIndex]); end; { --- TDBADialectBase --- } constructor TDBADialectBase.Create; begin inherited Create; FHooks := TDBAHookRegistry.Create; FConnection := nil; FTransaction := nil; FOwnsConnection := False; FConnected := False; end; destructor TDBADialectBase.Destroy; begin if FConnected then begin try Disconnect; except { Swallow — destructor must not raise. } end; end; if FOwnsConnection then begin if Assigned(FTransaction) then FTransaction.Free; if Assigned(FConnection) then FConnection.Free; end; FHooks.Free; inherited Destroy; end; procedure TDBADialectBase.AttachConnection(AConn: TSQLConnection; AOwns: Boolean); begin FConnection := AConn; FOwnsConnection := AOwns; if AOwns then begin FTransaction := TSQLTransaction.Create(nil); FTransaction.Database := FConnection; FConnection.Transaction := FTransaction; end else begin { Adopt mode: consumer manages transactions. Use whatever transaction is attached to the connection, if any. If none, share a transaction but don't own it. } FTransaction := FConnection.Transaction as TSQLTransaction; end; end; function TDBADialectBase.ServerFlavor: string; begin Result := FServerFlavor; end; function TDBADialectBase.Hooks: TDBAHookRegistry; begin Result := FHooks; end; function TDBADialectBase.Connection: TSQLConnection; begin Result := FConnection; end; function TDBADialectBase.Owned: Boolean; begin Result := FOwnsConnection; end; function TDBADialectBase.IsConnected: Boolean; begin Result := FConnected and Assigned(FConnection) and FConnection.Connected; end; procedure TDBADialectBase.Connect; var Q: TSQLQuery; begin if FConnected then Exit; if not Assigned(FConnection) then raise EDatabaseError.Create('dbapi: dialect has no connection attached'); if FOwnsConnection then FConnection.Open; FConnected := True; { Detect server flavor. Each backend has its own way to get a version string; the generic approach works for all three (SELECT VERSION() on MariaDB/PG; SELECT sqlite_version() on SQLite handled by override). } Q := TSQLQuery.Create(nil); try Q.Database := FConnection; Q.Transaction := FTransaction; try Q.SQL.Text := 'SELECT VERSION()'; Q.Open; if not Q.EOF then FServerFlavor := Q.Fields[0].AsString; Q.Close; except { SQLite doesn't implement VERSION() — descendants override Connect for backend-specific version detection. Silence this attempt. } FServerFlavor := ''; end; finally Q.Free; end; FHooks.FireConnect(FServerFlavor); end; procedure TDBADialectBase.Disconnect; begin if not FConnected then Exit; FConnected := False; if FOwnsConnection and Assigned(FConnection) and FConnection.Connected then FConnection.Close; FHooks.FireDisconnect('requested'); end; function TDBADialectBase.InsertReturningIdClause: string; begin { Default: no RETURNING. Postgres overrides. } Result := ''; end; function TDBADialectBase.CollationClause(ACaseInsensitive: Boolean): string; begin { Default: no collation. Concrete dialects override. } Result := ''; end; function TDBADialectBase.OnDeleteAction(AAction: TDBAOnDeleteAction): string; begin { Default: ANSI-compliant keywords. All three backends accept these. } case AAction of doaCascade: Result := 'CASCADE'; doaSetNull: Result := 'SET NULL'; doaRestrict: Result := 'RESTRICT'; doaSetDefault: Result := 'SET DEFAULT'; else Result := ''; { doaNoAction — emit nothing } end; end; function TDBADialectBase.InsertOrIgnoreStmt(const ATable: string; const ACols: array of string): string; var ColList, ValList: string; I: Integer; begin { Default uses the PG-style ON CONFLICT DO NOTHING which requires a unique constraint match. Concrete dialects override for SQLite/MariaDB which have shorter syntax (INSERT OR IGNORE / INSERT IGNORE). } ColList := ''; ValList := ''; for I := 0 to High(ACols) do begin if ColList <> '' then begin ColList := ColList + ', '; ValList := ValList + ', '; end; ColList := ColList + QuoteIdent(ACols[I]); ValList := ValList + ':p' + IntToStr(I + 1); end; Result := 'INSERT INTO ' + QuoteIdent(ATable) + ' (' + ColList + ') VALUES (' + ValList + ') ON CONFLICT DO NOTHING'; end; procedure TDBADialectBase.FireQueryLog(const ASQL: string; ADurationMS: Int64; AParams: TJSONArray; ARowsAffected: Integer); begin FHooks.FireAfterQuery(ASQL, AParams, ADurationMS, ARowsAffected); end; { Bind TJSONArray positional parameters to a TSQLQuery using ?1, ?2, etc. Caller is responsible for param count matching SQL placeholders. } procedure BindJsonParams(AQuery: TSQLQuery; AParams: TJSONArray); var I: Integer; PName: string; V: TJSONData; begin if not Assigned(AParams) then Exit; for I := 0 to AParams.Count - 1 do begin PName := 'p' + IntToStr(I + 1); if AQuery.Params.FindParam(PName) = nil then Continue; V := AParams.Items[I]; if (V = nil) or (V.JSONType = jtNull) then AQuery.Params.ParamByName(PName).Clear else case V.JSONType of jtString: AQuery.Params.ParamByName(PName).AsString := V.AsString; jtNumber: if V is TJSONFloatNumber then AQuery.Params.ParamByName(PName).AsFloat := V.AsFloat else AQuery.Params.ParamByName(PName).AsLargeInt := V.AsInt64; jtBoolean: AQuery.Params.ParamByName(PName).AsBoolean := V.AsBoolean; else AQuery.Params.ParamByName(PName).AsString := V.AsJSON; end; end; end; procedure TDBADialectBase.ExecSQL(const ASQL: string; AParams: TJSONArray); var Q: TSQLQuery; StartTick: QWord; Cancel, Handled: Boolean; RowsAffected: Integer; begin Cancel := False; FHooks.FireBeforeQuery(ASQL, AParams, Cancel); if Cancel then Exit; StartTick := GetTickCount64; Q := TSQLQuery.Create(nil); try Q.Database := FConnection; Q.Transaction := FTransaction; Q.SQL.Text := ASQL; BindJsonParams(Q, AParams); try Q.ExecSQL; RowsAffected := Q.RowsAffected; if FOwnsConnection then FTransaction.CommitRetaining; except on E: Exception do begin Handled := False; FHooks.FireError(ASQL, E.Message, Handled); if not Handled then raise; RowsAffected := -1; end; end; FireQueryLog(ASQL, Int64(GetTickCount64 - StartTick), AParams, RowsAffected); finally Q.Free; end; end; function TDBADialectBase.QuerySQL(const ASQL: string; AParams: TJSONArray): TJSONArray; var Q: TSQLQuery; Row: TJSONObject; StartTick: QWord; Cancel, Handled: Boolean; I: Integer; F: TField; begin Result := TJSONArray.Create; Cancel := False; FHooks.FireBeforeQuery(ASQL, AParams, Cancel); if Cancel then Exit; StartTick := GetTickCount64; Q := TSQLQuery.Create(nil); try Q.Database := FConnection; Q.Transaction := FTransaction; Q.SQL.Text := ASQL; BindJsonParams(Q, AParams); try Q.Open; while not Q.EOF do begin Row := TJSONObject.Create; for I := 0 to Q.FieldCount - 1 do begin F := Q.Fields[I]; if F.IsNull then Row.Add(F.FieldName, TJSONNull.Create) else case F.DataType of ftSmallint, ftInteger, ftAutoInc, ftWord: Row.Add(F.FieldName, F.AsInteger); ftLargeint: Row.Add(F.FieldName, F.AsLargeInt); ftFloat, ftCurrency, ftBCD: Row.Add(F.FieldName, F.AsFloat); ftBoolean: Row.Add(F.FieldName, F.AsBoolean); ftDate, ftTime, ftDateTime, ftTimeStamp: Row.Add(F.FieldName, F.AsString); else Row.Add(F.FieldName, F.AsString); end; end; Result.Add(Row); Q.Next; end; Q.Close; except on E: Exception do begin Handled := False; FHooks.FireError(ASQL, E.Message, Handled); if not Handled then begin Result.Free; Result := nil; raise; end; end; end; FireQueryLog(ASQL, Int64(GetTickCount64 - StartTick), AParams, -1); finally Q.Free; end; end; function TDBADialectBase.WhereToSQL(ACriterion: TDBACriterion; AParams: TJSONArray): string; function EmitCompare(C: TDBACompareCriterion): string; var PIdx: Integer; VStr: string; InArr: TJSONArray; I: Integer; FirstCol: string; begin FirstCol := QuoteIdent(C.Column); case C.Op of dcoIsNull: Result := FirstCol + ' IS NULL'; dcoIsNotNull: Result := FirstCol + ' IS NOT NULL'; dcoIn, dcoNotIn: begin if not (C.Value is TJSONArray) then begin Result := '1=0'; Exit; end; InArr := TJSONArray(C.Value); if InArr.Count = 0 then begin if C.Op = dcoIn then Result := '1=0' else Result := '1=1'; Exit; end; VStr := ''; for I := 0 to InArr.Count - 1 do begin if VStr <> '' then VStr := VStr + ', '; AParams.Add(InArr.Items[I].Clone); PIdx := AParams.Count; VStr := VStr + ':p' + IntToStr(PIdx); end; if C.Op = dcoIn then Result := FirstCol + ' IN (' + VStr + ')' else Result := FirstCol + ' NOT IN (' + VStr + ')'; end; dcoILike: begin { Default: case-insensitive via LOWER(). PG overrides with ILIKE. } AParams.Add(C.Value.Clone); PIdx := AParams.Count; Result := 'LOWER(' + FirstCol + ') LIKE LOWER(:p' + IntToStr(PIdx) + ')'; end; else AParams.Add(C.Value.Clone); PIdx := AParams.Count; VStr := ':p' + IntToStr(PIdx); case C.Op of dcoEq: Result := FirstCol + ' = ' + VStr; dcoNeq: Result := FirstCol + ' <> ' + VStr; dcoLt: Result := FirstCol + ' < ' + VStr; dcoLe: Result := FirstCol + ' <= ' + VStr; dcoGt: Result := FirstCol + ' > ' + VStr; dcoGe: Result := FirstCol + ' >= ' + VStr; dcoLike: Result := FirstCol + ' LIKE ' + VStr; else Result := '1=0'; end; end; end; function EmitCompound(C: TDBACompoundCriterion): string; var I: Integer; Sep, Part: string; begin if C.ChildCount = 0 then begin Result := '1=1'; Exit; end; if C.BoolOp = dboAnd then Sep := ' AND ' else Sep := ' OR '; Result := ''; for I := 0 to C.ChildCount - 1 do begin Part := WhereToSQL(C.Child(I), AParams); if Part = '' then Continue; if Result <> '' then Result := Result + Sep; Result := Result + '(' + Part + ')'; end; if Result = '' then Result := '1=1'; end; begin if ACriterion = nil then begin Result := ''; Exit; end; if ACriterion is TDBACompareCriterion then Result := EmitCompare(TDBACompareCriterion(ACriterion)) else if ACriterion is TDBACompoundCriterion then Result := EmitCompound(TDBACompoundCriterion(ACriterion)) else Result := ''; end; end.