halcu.pas

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

unit HalcU;

interface

uses
  ComObj, OleDbProv, OleDbRowsetData, xquery, HalcnQry;

type
  THalcyonxQueryData = class(TDatasetRowsetData)
  private
    FHalcnQuery : THalcyonxQuery;
    FDataList   : TDataList;
  protected
    procedure Open (Params : TOleDbExecParams); override;
  public
    destructor Destroy; override;
  end;

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

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

  THalcyonxQuerySession = 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;

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

const
  Class_HalcyonxQueryProvider: TGUID = '{887485C4-FD5D-11D3-964E-525405F27277}';

implementation

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

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;
  end;
end;

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

{ THalcyonxQueryData }
var
   OpenCount : Integer = 0;


destructor THalcyonxQueryData.Destroy;
begin
   if FHalcnQuery <> nil then FHalcnQuery.Free;
   if FDataList <> nil then FDataList.Free;
   OpenCount:= 0;
   inherited Destroy;
end;

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

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

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

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

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

   FDataList.OpenDataSets;

   FHalcnQuery.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 := FHalcnQuery;//.DataSets[0].DataSet;
   end else
   begin
      // It is not a SELECT statement (probably INSERT, DELETE, UPDATE, CREATETABLE, etc.)
      FHalcnQuery.ExecSQL;
   end;
end;

{ THalcyonxQueryRowset }

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

{ THalcyonxQueryCommand }

class function THalcyonxQueryCommand.GetRowsetClass: TComClass;
begin
  Result := THalcyonxQueryRowset;
end;

{ THalcyonxQuerySession }

procedure THalcyonxQuerySession.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 THalcyonxQuerySession.GetCommandClass: TComClass;
begin
  Result := THalcyonxQueryCommand;
end;

class function THalcyonxQuerySession.GetRowsetClass: TComClass;
begin
  Result := THalcyonxQueryRowset;
end;

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

{ THalcyonxQueryProvider }

class function THalcyonxQueryProvider.GetSessionClass: TComClass;
begin
  Result := THalcyonxQuerySession;
end;

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

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

initialization
  TOleDbProviderFactory.Create (ComServer, THalcyonxQueryProvider, Class_HalcyonxQueryProvider,
    'HalcyonxQuery', 'HalcyonxQuery Provider', tmApartment);
end.