ffxu.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

unit FFxU;

{$I xq_flag.inc}
interface

uses
  ComObj, OleDbProv, OleDbRowsetData, FFxQuery;

type
  TFFxQueryData = class(TDatasetRowsetData)
  private
    FFFxQuery  : TFFxQuery;
    FDataList  : TDataList;
    FOpenCount : Integer;
  protected
    procedure Open (Params : TOleDbExecParams); override;
  public
    //pcconstructor Create;
    destructor Destroy; override;
  end;

  TFFxQueryRowset = class (TOleDbRowset)
  protected
    procedure InitializeData (Params: TOleDbExecParams); override;
  end;

  TFFxQueryCommand = class (TOleDbCommand)
  protected
    class function GetRowsetClass: TComClass; override;
  end;

  TFFxQuerySession = class (TOleDbSession)
  protected
    class function GetRowsetClass: TComClass; override;
    class function GetCommandClass: TComClass; override;
    procedure BuildSchema (Schema: TOleDbSchema; const Restrictions :
      array of olevariant; var Data: IOleDbRowsetData); override;
  public
    procedure Initialize; override;
  end;

  TFFxQueryProvider = class (TOleDbDatasource)
  protected
    class function GetSessionClass: TComClass; override;
    procedure InitializeDatasource; override;
    procedure UninitializeDatasource; override;
  end;

const
  Class_FFxQueryProvider: TGUID = '{535B71E0-FE35-11D3-964E-525405F27277}';

implementation

uses
  ComServ, Windows, SysUtils, xqmiscel, OleDb, Db;

function CreateSimpleSchemaData (const Schema: TGUID): TSimpleRowsetData;
begin
  Result := OleDbProv.CreateSimpleSchemaData (Schema) as TSimpleRowsetData;
end;

{ TFFxQueryData }

function DataTypeToFieldType (dt: DBType): TFieldType;
begin
  case dt of
    dtEmpty:     Result := ftUnknown;
    dtString:    Result := ftString;
    dtSmallint:  Result := ftSmallInt;
    dtInteger:   Result := ftInteger;
    dtWord:      Result := ftWord;
    dtWordBool:  Result := ftBoolean;
    dtDouble:    Result := ftFloat;
    dtDate:      Result := ftDate;
    dtDBTime:    Result := ftTime;
    dtDBTimestamp:Result := ftDateTime;
    dtBytes:     Result := ftBytes;
    dtOleStr:    Result := ftWideString;
    dtInt64:     Result := ftLargeInt;
    dtVariant:   Result := ftVariant;
    dtIUnknown:  Result := ftInterface;
    dtIDispatch: Result := ftIDispatch;
    dtGUID:      Result := ftGUID;
  else
    Result := ftUnknown;
  end;
end;

{ TFFxQueryData }
//var
//   OpenCount : Integer = 0;

destructor TFFxQueryData.Destroy;
begin
   if FFFxQuery <> nil then FFFxQuery.Free;
   if FDataList <> nil then FDataList.Free;
   FOpenCount := 0;
   inherited Destroy;
end;

procedure TFFxQueryData.Open(Params: TOleDbExecParams);
var
   WDir: String;
   I: Integer;
begin
   If FOpenCount > 0 then Exit;
   Inc(FOpenCount);
   SetLength(WDir, 144);
   if GetWindowsDirectory(PChar(WDir), 144) <> 0 then
      SetLength(WDir, StrLen(PChar(WDir)))
   else
      Exit;

   FFFxQuery := TFFxQuery.Create(nil);
   with FFFxQuery do
   begin
      AutoDisableControls := False;
      { Link the Halcyon query dataset with the data list }
      DataList := FDataList;
   end;
   FDataList := TDataList.Create;
   FDataList.LoadFromFile( AddSlash(WDir) + 'FFxOLEDB.Ini' );

   { configure THalcyonxQuery }
   FFFxQuery.InMemResultSet  := FDataList.InMemResultSet;
   FFFxQuery.MapFileSize     := FDataList.MapFileSize;
   FFFxQuery.DateFormat      := FDataList.DateFormat;
   FFFxQuery.UseDisplayLabel := FDataList.UseDisplayLabel;

   { now set the params }
   FFFxQuery.Params.Clear;
   if Assigned(Params.Parameters) then
   begin
      for I := 0 to Params.Parameters.Count - 1 do
         FFFxQuery.Params.CreateParam(DataTypeToFieldType(Params.Parameters[I].DataType),
            Params.Parameters[I].Name, ptUnknown);
      for I := 0 to Params.Parameters.Count - 1 do
         FFFxQuery.Params.ParamValues[Params.Parameters[I].Name]:= Params.Parameters[I].Value;
   end;

   { link the DataList with the Halcyon Query dataset }
   FFFxQuery.DataList := FDataList;

   FDataList.OpenDataSets;

   FFFxQuery.ParamCheck := False;
   FFFxQuery.SQL.Text := Params.CommandText;
   if AnsiPos('SELECT', AnsiUpperCase(Params.CommandText)) > 0 then
   begin
      // It is a SELECT statement
      //then set the Dataset property of TDatasetRowset to prepare connection
      Dataset := FFFxQuery;
   end else
   begin
      // It is not a SELECT statement (probably INSERT, DELETE, UPDATE, CREATETABLE, etc.)
      FFFxQuery.ExecSQL;
   end;
end;

{ TFFxQueryRowset }

procedure TFFxQueryRowset.InitializeData(Params: TOleDbExecParams);
begin
  Data := TFFxQueryData.Create;
  Features := Features + [dbrfBookmarks, dbrfScroll, dbrfEvents];
end;

{ TFFxQueryCommand }

class function TFFxQueryCommand.GetRowsetClass: TComClass;
begin
  Result := TFFxQueryRowset;
end;

{ TFFxQuerySession }

procedure TFFxQuerySession.BuildSchema(Schema: TOleDbSchema;
  const Restrictions: array of olevariant; var Data: IOleDbRowsetData);
var
  SchemaData: TSimpleRowsetData;
begin
  SchemaData := NIL;
  case Schema.SchemaType of
    dbstTables :
    begin
      SchemaData := CreateSimpleSchemaData (Schema.ID);
      //fill SchemaData here
    end;

    dbstColumns :
    begin
      SchemaData := CreateSimpleSchemaData (Schema.ID);
      //fill SchemaData here
    end;

    dbstProviderTypes :
    begin
      SchemaData := CreateSimpleSchemaData (Schema.ID);
      //fill SchemaData here
    end;

    //add other schemas here
  end;
  //return SchemaData
  if (SchemaData <> NIL) then Data := SchemaData;
end;

class function TFFxQuerySession.GetCommandClass: TComClass;
begin
  Result := TFFxQueryCommand;
end;

class function TFFxQuerySession.GetRowsetClass: TComClass;
begin
  Result := TFFxQueryRowset;
end;

procedure TFFxQuerySession.Initialize;
begin
  inherited;
  Features := Features + [dbsfCommand, dbsfSchema];
end;

{ TFFxQueryProvider }

class function TFFxQueryProvider.GetSessionClass: TComClass;
begin
  Result := TFFxQuerySession;
end;

procedure TFFxQueryProvider.InitializeDatasource;
begin
  //called to initialize your provider
end;

procedure TFFxQueryProvider.UninitializeDatasource;
begin
  //called to uninitialize your provider
end;

initialization
  TOleDbProviderFactory.Create (ComServer, TFFxQueryProvider, Class_FFxQueryProvider,
    'FFxQuery', 'FFxQuery Provider', tmApartment);
end.