disqlite3dataset.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 1,786 行 · 第 1/4 页

{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2007 Ralf Junker, The Delphi Inspiration
 Internet: http://www.yunqa.de/delphi/
 E-Mail:   [e-mail]

-------------------------------------------------------------------------------}

unit DISQLite3DataSet;

{$I DI.inc}
{$I DISQLite3.inc}

interface

uses
  Classes, DB,
  DISQLite3Database;

type

  TDISQLite3Column = packed record
    ColumnName: WideString;
    ColumnType: Integer;
    ColumnDeclaration: WideString;
    ColumnOriginName: WideString;
    ColumnTableName: WideString;
    ColumnDatabaseName: WideString;
    ColumnIsKey: Boolean;
  end;

  TDISQLite3Data = packed record
    Col: TDISQLite3Column;
    Data: TDISQLite3Cell16;
  end;

  TDISQLite3Row = array[0..(MaxInt - SizeOf(TDISQLite3Data)) div SizeOf(TDISQLite3Data) - 1] of TDISQLite3Data;

  PDISQLite3Row = ^TDISQLite3Row;

  TDISQLite3InitFieldDefEvent = procedure(
    const AColumn: TDISQLite3Column;
    const AFieldDef: TFieldDef) of object;

  TDISqlite3UniDirQuery = class({$IFDEF COMPILER_10_UP}TWideDataSet{$ELSE}TDataSet{$ENDIF})
  private

    FColumnCount: Integer;

    FRowBuffer: PDISQLite3Row;

    FSelectStatement: TDISQLite3Statement;

    FUpdateStatements: array[TUpdateKind] of TDISQLite3Statement;

    FOnInitFieldDef: TDISQLite3InitFieldDefEvent;

    function GetDatabase: TDISQLite3Database;

    function GetSelectSQL: WideString;

    function GetUpdateSql(const AUpdateKind: TUpdateKind): WideString;

    procedure SetDatabase(const AValue: TDISQLite3Database);

    procedure SelectStatementAfterClose(ASender: TObject);

    procedure SetSelectSQL(const AValue: WideString);

    procedure SetUpdateSql(const AUpdateKind: TUpdateKind; const AValue: WideString);

  protected

    {$IFNDEF COMPILER_6_UP}

    function AllocRecordBuffer: PChar; override;

    procedure FreeRecordBuffer(var Buffer: PChar); override;

    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;

    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;

    function GetRecordSize: Word; override;

    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;

    procedure InternalDelete; override;

    procedure InternalFirst; override;

    procedure InternalGotoBookmark(Bookmark: Pointer); override;

    procedure InternalInitRecord(Buffer: PChar); override;

    procedure InternalLast; override;

    procedure InternalPost; override;

    procedure InternalSetToRecord(Buffer: PChar); override;

    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;

    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;

    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
    {$ENDIF !COMPILER_6_UP}

    procedure AllocRowBuffer(
      const AColumnCount: Integer);

    procedure DoInitFieldDef(
      const AColumn: TDISQLite3Column;
      const AFieldDef: TFieldDef); virtual;

    procedure FreeRowBuffer;

    function GetCanModify: Boolean; override;

    {$IFNDEF COMPILER_5_UP}

    function GetFieldClass(
      AFieldType: TFieldType): TFieldClass; override;
    {$ENDIF !COMPILER_5_UP}

    function GetRecord(Buffer: PAnsiChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;

    procedure InternalClose; override;

    procedure InternalHandleException; override;

    procedure InternalInitFieldDefs; override;

    procedure InternalOpen; override;

    function IsCursorOpen: Boolean; override;

    {$IFDEF COMPILER_5_UP}

    procedure PSEndTransaction(
      Commit: Boolean); override;

    function PSExecuteStatement(
      const ASQL: {$IFDEF COMPILER_10_UP}WideString{$ELSE}AnsiString{$ENDIF};
      AParams: TParams;
      AResultSet: Pointer = nil): Integer; override;

    {$IFDEF COMPILER_10_UP}

    function PSGetKeyFieldsW: WideString; override;
    {$ELSE COMPILER_10_UP}

    function PSGetKeyFields: AnsiString; override;
    {$ENDIF COMPILER_10_UP}

    {$IFDEF COMPILER_10_UP}

    function PSGetQuoteCharW: WideString; override;
    {$ELSE COMPILER_10_UP}

    function PSGetQuoteChar: AnsiString; override;
    {$ENDIF COMPILER_10_UP}

    {$IFDEF COMPILER_10_UP}

    function PSGetTableNameW: WideString; override;
    {$ELSE COMPILER_10_UP}

    function PSGetTableName: AnsiString; override;
    {$ENDIF COMPILER_10_UP}

    function PSInTransaction: Boolean; override;

    function PSIsSQLBased: Boolean; override;

    function PSIsSQLSupported: Boolean; override;

    procedure PSReset; override;

    procedure PSStartTransaction; override;

    function PSUpdateRecord(
      AUpdateKind: TUpdateKind;
      aDelta: TDataSet): Boolean; override;

    {$ENDIF COMPILER_5_UP}

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    function CreateBlobStream(
      Field: TField;
      Mode: TBlobStreamMode): TStream; override;

    function GetFieldData(
      Field: TField;
      Buffer: Pointer): Boolean; overload; override;

    {$IFDEF COMPILER_5_UP}

    function GetFieldData(
      Field: TField;
      Buffer: Pointer;
      NativeFormat: Boolean): Boolean; overload; override;
    {$ENDIF COMPILER_5_UP}

    {$IFDEF COMPILER_6_UP}

    function IsSequenced: Boolean; override;
    {$ENDIF COMPILER_6_UP}

  published

    property Database: TDISQLite3Database read GetDatabase write SetDatabase;

    property DeleteSQL: WideString index ukDelete read GetUpdateSql write SetUpdateSql;

    property InsertSQL: WideString index ukInsert read GetUpdateSql write SetUpdateSql;

    property ModifySQL: WideString index ukModify read GetUpdateSql write SetUpdateSql;

    property SelectSQL: WideString read GetSelectSQL write SetSelectSQL;

    property OnInitFieldDef: TDISQLite3InitFieldDefEvent read FOnInitFieldDef write FOnInitFieldDef;

    property Active;

    property BeforeOpen;

    property AfterOpen;

    property BeforeClose;

    property AfterClose;

    property BeforeScroll;

    property AfterScroll;
    {$IFDEF COMPILER_5_UP}

    property BeforeRefresh;

    property AfterRefresh;
    {$ENDIF COMPILER_5_UP}
  end;

  TDISQLite3BlobStream = class(TCustomMemoryStream)
  public

    constructor Create(const Data: Pointer; const Size: Integer);

    function Write(const Buffer; Count: Integer): Integer; override;
  end;

  TDISQLite3MemoStream = class(TStringStream)
  public

    function Write(const Buffer; Count: Integer): Integer; override;
  end;

  TDISQLite3WideMemoStream = class(TDISQLite3BlobStream)
  end;

  {$IFNDEF COMPILER_10_UP}

  TDISQLite3BlobField = class(TBlobField)
  protected

    function GetAsWideString: WideString;

    procedure SetAsWideString(const AValue: WideString);
  end;
  {$ENDIF !COMPILER_10_UP}

  TDISQLite3MemoField = class({$IFDEF COMPILER_10_UP}TBlobField{$ELSE}TDISQLite3BlobField{$ENDIF})
  protected

    function GetAsString: AnsiString; override;

    procedure SetAsString(const AValue: AnsiString); override;
  public

    constructor Create(AOwner: TComponent); override;
  end;

  TDISQLite3WideMemoField = class({$IFDEF COMPILER_10_UP}TWideMemoField{$ELSE}TDISQLite3BlobField{$ENDIF})
    {$IFNDEF COMPILER_10_UP}
  protected

    function GetAsString: string; override;

    procedure SetAsString(const Value: string); override;
  public

    constructor Create(AOwner: TComponent); override;

    property Value: WideString read GetAsWideString write SetAsWideString;
    {$ENDIF !COMPILER_10_UP}
  end;

  TDISQLite3WideStringField = class({$IFDEF COMPILER_5_UP}TWideStringField{$ELSE}TStringField{$ENDIF})
  protected
    {$IFNDEF COMPILER_10_UP}

    function GetAsWideString: WideString;
    {$ENDIF !COMPILER_10_UP}
    {$IFNDEF COMPILER_5_UP}

    class procedure CheckTypeSize(Value: Integer); override;

    function GetAsString: string; override;

    function GetAsVariant: Variant; override;

    function GetDataSize: {$IFDEF COMPILER_6_UP}Integer{$ELSE}Word{$ENDIF}; override;

    procedure SetAsString(const Value: string); override;

    procedure SetVarValue(const Value: Variant); override;

    procedure SetAsWideString(const AValue: WideString); {$IFDEF COMPILER_10_UP} override; {$ENDIF}
  public

    constructor Create(AOwner: TComponent); override;

    property Value: WideString read GetAsWideString write SetAsWideString;
    {$ENDIF !COMPILER_5_UP}
  end;

  TDISQLite3DataSetImporter = class(TComponent)
  private
    FDatabase: TDISQLite3Database;
    FDataSet: TDataSet;
    FTableName: WideString;
    procedure SetDatabase(const AValue: TDISQLite3Database);
    procedure SetDataSet(const AValue: TDataSet);
  protected

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public

    procedure Execute;
  published

    property Database: TDISQLite3Database read FDatabase write SetDatabase;

    property DataSet: TDataSet read FDataSet write SetDataSet;

    property TableName: WideString read FTableName write FTableName;
  end;

resourcestring

  SUpdateFailed = 'Update failed';
  {$IFNDEF COMPILER_6_UP}

  SDataSetUnidirectional = 'Operation not allowed on a unidirectional dataset';
  {$ENDIF !COMPILER_6_UP}

implementation

uses
  Windows, {$IFDEF COMPILER_6_UP}RTLConsts, Variants{$ELSE}Consts, Forms{$ENDIF},
  DBConsts, SysUtils,
  DISQLite3Api;

constructor TDISqlite3UniDirQuery.Create;
begin
  inherited;
  {$IFDEF COMPILER_6_UP}
  SetUniDirectional(True);
  {$ENDIF COMPILER_6_UP}
  FSelectStatement := TDISQLite3Statement.Create;
  FSelectStatement.AfterClose := SelectStatementAfterClose;
end;

destructor TDISqlite3UniDirQuery.Destroy;
begin
  FSelectStatement.Free;
  inherited;
end;

procedure TDISqlite3UniDirQuery.AllocRowBuffer(const AColumnCount: Integer);
begin
  FRowBuffer := AllocMem(AColumnCount * SizeOf(FRowBuffer[0]));
  FColumnCount := AColumnCount;
end;

function TDISqlite3UniDirQuery.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
var
  l: Integer;
  s: AnsiString;
begin
  if Assigned(FRowBuffer) then
    with FRowBuffer^[Field.FieldNo - 1] do
      case Field.DataType of
        ftMemo:

          if Data.CellType = SQLITE_TEXT then
            begin

              l := WideCharToMultiByte(CP_ACP, 0, Data.CellText.p, Data.CellText.l, nil, 0, nil, nil);
              SetLength(s, l);
              WideCharToMultiByte(CP_ACP, 0, Data.CellText.p, Data.CellText.l, PAnsiChar(s), l, nil, nil);
              Result := TDISQLite3MemoStream.Create(s);
              Exit;
            end;

        {$IFDEF COMPILER_10_UP}
        ftWideMemo:
          if Data.CellType = SQLITE_TEXT then
            begin
              Result := TDISQLite3WideMemoStream.Create(Data.CellBlob.p, Data.CellBlob.l * 2);
              Exit;
            end;
        {$ENDIF COMPILER_10_UP}

        else
          if Data.CellType = SQLITE_BLOB then
            begin
              Result := TDISQLite3BlobStream.Create(Data.CellBlob.p, Data.CellBlob.l);
              Exit;
            end;
      end;

  Result := TDISQLite3BlobStream.Create(nil, 0);
end;

procedure TDISqlite3UniDirQuery.DoInitFieldDef(
  const AColumn: TDISQLite3Column;
  const AFieldDef: TFieldDef);
begin
  if Assigned(FOnInitFieldDef) then
    FOnInitFieldDef(AColumn, AFieldDef);
end;

procedure TDISqlite3UniDirQuery.FreeRowBuffer;
var
  i: Integer;
begin
  for i := 0 to FColumnCount - 1 do
    with FRowBuffer^[i] do
      begin
        Col.ColumnName := '';