disqlite3vtstringlist.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 583 行

{ A DISQLite3 virtual table implementation using a TStringList for data storage. }
unit DISQLite3VtStringList;

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

{$IFDEF DISQLite3_Personal}
!!! This unit requires functionality unavailable in DISQLite3 Personal. !!!
!!! To compile, download DISQLite3 Pro from www.yunqa.de/delphi/        !!!
{$ENDIF DISQLite3_Personal}

{.$DEFINE Debug}

interface

uses
  Classes, DISQLite3Api;

type
  TStringList_vtab = record
    Base: TSQLite3_vtab;
    SL: TStrings;
    OwnsStringList: Boolean;
  end;
  PStringList_vtab = ^TStringList_vtab;

  TStringList_Cursor = record
    Base: PStringList_vtab;
    Idx: Integer;
  end;
  PStringList_Cursor = ^TStringList_Cursor;

  //------------------------------------------------------------------------------

  { }
function TStringList_Module_create(
  DB: TDISQLite3DatabaseHandle;
  paux: Pointer;
  argc: Integer;
  const argv: PPAnsiCharArray;
  pvtab: PPSQLite3_vtab;
  pzErr: PPAnsiChar): Integer;

function TStringList_Module_Connect(
  DB: TDISQLite3DatabaseHandle;
  paux: Pointer;
  argc: Integer;
  const argv: PPAnsiCharArray;
  pvtab: PPSQLite3_vtab;
  pzErr: PPAnsiChar): Integer;

function TStringList_Module_BestIndex(
  pvtab: PSQLite3_vtab;
  Info: psqlite3_index_info): Integer;

function TStringList_Module_Destructor(
  pvtab: PSQLite3_vtab): Integer;

function TStringList_Module_Disconnect(
  pvtab: PSQLite3_vtab): Integer;

function TStringList_Module_Destroy(
  pvtab: PSQLite3_vtab): Integer;

function TStringList_Module_Open(
  pvtab: PSQLite3_vtab;
  ppCursor: PPsqlite3_vtab_cursor): Integer;

function TStringList_Module_Close(
  pCursor: Psqlite3_vtab_cursor): Integer;

function TStringList_Module_Filter(
  pCursor: Psqlite3_vtab_cursor;
  idxNum: Integer;
  idxStr: PAnsiChar;
  argc: Integer;
  argv: PPointerArray): Integer;

function TStringList_Module_Next(
  pCursor: Psqlite3_vtab_cursor): Integer;

function TStringList_Module_EOF(
  pCursor: Psqlite3_vtab_cursor): Integer;

function TStringList_Module_Column(
  pCursor: Psqlite3_vtab_cursor;
  Context: Pointer;
  i: Integer): Integer;

function TStringList_Module_RowID(
  pCursor: Psqlite3_vtab_cursor;
  pRowID: PInt64): Integer;

function TStringList_Module_Update(
  pvtab: PSQLite3_vtab;
  argc: Integer;
  argv: PPointerArray;
  pRowID: PInt64): Integer;

function TStringList_Module_Begin(
  pvtab: PSQLite3_vtab): Integer;

function TStringList_Module_Sync(
  pvtab: PSQLite3_vtab): Integer;

function TStringList_Module_Commit(
  pvtab: PSQLite3_vtab): Integer;

function TStringList_Module_Rollback(
  pvtab: PSQLite3_vtab): Integer;

const
  TStringList_Module: TSQLite3_Module = (
    iVersion: 1;
    xcreate: TStringList_Module_create;
    xConnect: TStringList_Module_Connect;
    xBestIndex: TStringList_Module_BestIndex;
    xDisconnect: TStringList_Module_Disconnect;
    xDestroy: TStringList_Module_Destroy;
    xOpen: TStringList_Module_Open;
    xClose: TStringList_Module_Close;
    xFilter: TStringList_Module_Filter;
    xNext: TStringList_Module_Next;
    xEof: TStringList_Module_EOF;
    xColumn: TStringList_Module_Column;
    xRowID: TStringList_Module_RowID;
    xUpdate: TStringList_Module_Update;
    xBegin: TStringList_Module_Begin;
    xSync: nil; // TStringList_Module_Sync;
    xCommit: TStringList_Module_Commit;
    xRollback: TStringList_Module_Rollback;
    xFindFunction: nil // TStringList_Module_FindFunction
    );

implementation

uses
  SysUtils;

function TStringList_Module_Constructor(
  DB: TDISQLite3DatabaseHandle;
  paux: Pointer;
  argc: Integer;
  argv: PPAnsiCharArray;
  ppvtab: PPSQLite3_vtab;
  pzErr: PPAnsiChar): Integer;
var
  i: Integer;
  OwnsStringList: Boolean;
  s: AnsiString;
  SL: TStringList;
  v: PStringList_vtab;
begin
  {$IFDEF DEBUG}
  WriteLn('Argument Count: ', argc);
  for i := 0 to argc - 1 do
    WriteLn(argv[i]);
  {$ENDIF}

  { Try to prepare the stringlist. We catch all errors and report problems
    in the except block below. }
  SL := TStringList(paux);
  OwnsStringList := not Assigned(SL);
  try
    if OwnsStringList then
      SL := TStringList.Create;

    { Check for optional filename parameter to read into the stringlist. }
    if argc > 3 then
      begin
        s := argv^[3];
        s := AnsiDequotedStr(s, '''');
        SL.LoadFromFile(s);
        { Assign our type of "RowIDs" to all strings in the list.
          We need them further down for inserts and deletes. }
        for i := 0 to SL.Count - 1 do
          SL.Objects[i] := TObject(i);
      end;
  except
    on e: Exception do
      begin
        if OwnsStringList then
          SL.Free;
        s := sqlite3_encode_utf8(e.Message);
        GetMem(pzErr^, Length(s) + 1);
        StrPCopy(pzErr^, s);
        Result := SQLITE_ERROR;
        Exit;
      end;
  end;

  { If everything worked fine, allocate and declare the virtual table module. }
  v := AllocMem(SizeOf(v^));
  v.SL := SL;
  v.OwnsStringList := OwnsStringList;
  sqlite3_declare_vtab(DB, 'CREATE TABLE x (Value TEXT);');
  ppvtab^ := PSQLite3_vtab(v);

  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_create(
  DB: TDISQLite3DatabaseHandle;
  paux: Pointer;
  argc: Integer;
  const argv: PPAnsiCharArray;
  pvtab: PPSQLite3_vtab;
  pzErr: PPAnsiChar): Integer;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Create');
  {$ENDIF}

  Result := TStringList_Module_Constructor(DB, paux, argc, argv, pvtab, pzErr);
end;

//------------------------------------------------------------------------------

function TStringList_Module_Connect(
  DB: TDISQLite3DatabaseHandle;
  paux: Pointer;
  argc: Integer;
  const argv: PPAnsiCharArray;
  pvtab: PPSQLite3_vtab;
  pzErr: PPAnsiChar): Integer;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Connect');
  {$ENDIF}

  Result := TStringList_Module_Constructor(DB, paux, argc, argv, pvtab, pzErr);
end;

//------------------------------------------------------------------------------

function TStringList_Module_BestIndex(
  pvtab: PSQLite3_vtab;
  Info: psqlite3_index_info): Integer;
var
  v: PStringList_vtab;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_BestIndex');
  {$ENDIF}

  v := PStringList_vtab(pvtab);
  Info^.estimatedCost := v^.SL.Count;
  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Destructor(
  pvtab: PSQLite3_vtab): Integer;
var
  v: PStringList_vtab;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Destructor');
  {$ENDIF}

  v := PStringList_vtab(pvtab);
  if v^.OwnsStringList then
    v.SL.Free;

  FreeMem(pvtab);
  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Disconnect(
  pvtab: PSQLite3_vtab): Integer;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Disconnect');
  {$ENDIF}

  Result := TStringList_Module_Destructor(pvtab);
end;

//------------------------------------------------------------------------------

function TStringList_Module_Destroy(
  pvtab: PSQLite3_vtab): Integer;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Destroy');
  {$ENDIF}

  Result := TStringList_Module_Destructor(pvtab);
end;

//------------------------------------------------------------------------------

function TStringList_Module_Open(
  pvtab: PSQLite3_vtab;
  ppCursor: PPsqlite3_vtab_cursor): Integer;
var
  c: PStringList_Cursor;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Open');
  {$ENDIF}

  c := AllocMem(SizeOf(c^));
  ppCursor^ := Psqlite3_vtab_cursor(c);

  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Close(
  pCursor: Psqlite3_vtab_cursor): Integer;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Close');
  {$ENDIF}

  FreeMem(pCursor);
  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Filter(
  pCursor: Psqlite3_vtab_cursor;
  idxNum: Integer;
  idxStr: PAnsiChar;
  argc: Integer;
  argv: PPointerArray): Integer;
var
  c: PStringList_Cursor;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Filter');
  {$ENDIF}

  c := PStringList_Cursor(pCursor);
  c^.Idx := 0;
  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Next(
  pCursor: Psqlite3_vtab_cursor): Integer;
var
  c: PStringList_Cursor;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Next');
  {$ENDIF}

  c := PStringList_Cursor(pCursor);
  Inc(c^.Idx);
  // This function was successfull. Eof will be called for further checks.
  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_EOF(
  pCursor: Psqlite3_vtab_cursor): Integer;
var
  c: PStringList_Cursor;
  v: PStringList_vtab;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_EOF');
  {$ENDIF}

  c := PStringList_Cursor(pCursor);

  v := c^.Base;
  if c^.Idx < v.SL.Count then
    Result := 0
  else
    Result := 1;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Column(
  pCursor: Psqlite3_vtab_cursor;
  Context: Pointer;
  i: Integer): Integer;
var
  c: PStringList_Cursor;
  v: PStringList_vtab;
  s: AnsiString;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Column');
  {$ENDIF}

  c := PStringList_Cursor(pCursor);
  v := c^.Base;
  s := v^.SL.Strings[c^.Idx];
  s := sqlite3_encode_utf8(s);

  sqlite3_result_text(
    Context,
    PAnsiChar(s), Length(s),
    SQLITE_TRANSIENT);

  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_RowID(
  pCursor: Psqlite3_vtab_cursor;
  pRowID: PInt64): Integer;
var
  c: PStringList_Cursor;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_RowID');
  {$ENDIF}

  c := PStringList_Cursor(pCursor);
  if c^.Idx < c^.Base^.SL.Count then
    begin
      pRowID^ := Integer(c^.Base^.SL.Objects[c^.Idx]);
      Result := SQLITE_OK;
    end
  else
    Result := SQLITE_ERROR;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Update(
  pvtab: PSQLite3_vtab;
  argc: Integer;
  argv: PPointerArray;
  pRowID: PInt64): Integer;
var
  v: PStringList_vtab;
  i, RowID_0, RowID_1: Integer;
  s: AnsiString;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Update');
  {$ENDIF}

  v := PStringList_vtab(pvtab);

  if argc = 1 then
    begin
      // Delete single row with RowID argv[0].
      RowID_0 := sqlite3_value_int(argv[0]);
      i := v^.SL.IndexOfObject(TObject(RowID_0));
      if i >= 0 then
        v^.SL.Delete(i);
    end
  else
    if argc > 1 then
      if sqlite3_value_type(argv[1]) = SQLITE_NULL then
        begin
          // Insert new row, choose new RowID ourselves.
          RowID_1 := 0;
          while v^.SL.IndexOfObject(TObject(RowID_1)) >= 0 do
            Inc(RowID_1);
          s := sqlite3_value_str(argv[2]);
          s := sqlite3_decode_utf8(s);
          v^.SL.AddObject(s, TObject(RowID_1));
          pRowID^ := RowID_1;
        end
      else
        begin
          RowID_1 := sqlite3_value_int(argv[1]);
          if sqlite3_value_type(argv[0]) = SQLITE_NULL then
            begin
              // Insert new row with RowID argv[1].
              s := sqlite3_value_str(argv[2]);
              s := sqlite3_decode_utf8(s);
              v^.SL.AddObject(s, TObject(RowID_1));
              pRowID^ := RowID_1;
            end
          else
            begin
              RowID_0 := sqlite3_value_int(argv[0]);

              if RowID_0 = RowID_1 then
                begin
                  // Update existing row RowID with new values.
                  i := v^.SL.IndexOfObject(TObject(RowID_0));
                  if i >= 0 then
                    begin
                      s := sqlite3_value_str(argv[2]);
                      s := sqlite3_decode_utf8(s);
                      v^.SL.Strings[i] := s;
                    end;
                end
              else
                begin
                  // Update existing row RowID with new RowID and new values.
                  i := v^.SL.IndexOfObject(TObject(RowID_0));
                  if i >= 0 then
                    begin
                      s := sqlite3_value_str(argv[2]);
                      s := sqlite3_decode_utf8(s);
                      v^.SL.Strings[i] := s;
                      v^.SL.Objects[i] := TObject(RowID_1);
                    end;
                end;
            end;
        end;
  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

{ TStrings does not have transactions, but we can call BeginUpdate to
  speed up operations on some slow string lists. }
function TStringList_Module_Begin(
  pvtab: PSQLite3_vtab): Integer;
var
  v: PStringList_vtab;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Begin');
  {$ENDIF}

  v := PStringList_vtab(pvtab);
  v^.SL.BeginUpdate;
  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Sync(
  pvtab: PSQLite3_vtab): Integer;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Sync');
  {$ENDIF}

  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Commit(
  pvtab: PSQLite3_vtab): Integer;
var
  v: PStringList_vtab;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Commit');
  {$ENDIF}

  v := PStringList_vtab(pvtab);
  v^.SL.EndUpdate;
  Result := SQLITE_OK;
end;

//------------------------------------------------------------------------------

function TStringList_Module_Rollback(
  pvtab: PSQLite3_vtab): Integer;
var
  v: PStringList_vtab;
begin
  {$IFDEF DEBUG}
  WriteLn('--- TStringList_Module_Rollback');
  {$ENDIF}

  v := PStringList_vtab(pvtab);
  v^.SL.EndUpdate;
  Result := SQLITE_ERROR;
end;

//------------------------------------------------------------------------------

end.