disqlite3dataset.pas

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

              l := Length(s);
              if l > Field.Size then
                l := Field.Size;
              Move(Pointer(s)^, Buffer^, l);
              PAnsiChar(Buffer)[l] := #0;
            end;

          ftWideString:
            begin
              {$IFDEF COMPILER_10_UP}
              w := sqlite3_cell16_as_widestring(Data);
              l := Length(w);
              if l > Field.Size then
                l := Field.Size;
              Move(Pointer(w)^, Buffer^, l * 2);
              PWideChar(Buffer)[l] := #0;
              {$ELSE COMPILER_10_UP}
              PWideString(Buffer)^ := sqlite3_cell16_as_widestring(Data);
              {$ENDIF COMPILER_10_UP}
            end;

          ftWord:
            begin
              PWord(Buffer)^ := sqlite3_cell16_as_integer(Data);
            end;

          else
            raise Exception.Create('Unsupported DataType');
        end;
    end;
end;

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean;
begin
  Result := GetFieldData(Field, Buffer);
end;
{$ENDIF COMPILER_5_UP}

function BindDataSet(
  const AStmt: TDISQLite3Statement;
  const ADataSet: TDataSet): Boolean;

  function IsOld(const s: WideString): Boolean;
  begin
    Result := (Length(s) > 4) and
      (s[1] = 'O') or (s[1] = 'o') and
      (s[2] = 'L') or (s[2] = 'l') and
      (s[3] = 'D') or (s[3] = 'd') and
      (s[4] = '_');
  end;

var
  BlobStr: AnsiString;
  i: Integer;
  f: TField;
  Old: Boolean;
  ParamName: WideString;
  Value: Variant;
begin
  for i := 1 to AStmt.bind_parameter_count do
    begin
      ParamName := AStmt.Bind_Parameter_Name16(i);
      System.Delete(ParamName, 1, 1);
      Old := IsOld(ParamName);
      if Old then System.Delete(ParamName, 1, 4);
      f := ADataSet.FindField(ParamName);

      Result := Assigned(f);
      if not Result then Exit;

      if Old then
        Value := f.OldValue
      else
        begin
          Value := f.NewValue;
          if VarIsEmpty(Value) then
            Value := f.OldValue;
        end;

      Result := not VarIsEmpty(Value);
      if not Result then Exit;

      if f.IsBlob then
        begin
          BlobStr := Value;
          AStmt.Bind_Blob(i, Pointer(BlobStr), Length(BlobStr), SQLITE_TRANSIENT);
        end
      else
        AStmt.bind_Variant(i, Value)
    end;

  Result := True;
end;

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.PSExecuteStatement(
  const ASQL: {$IFDEF COMPILER_10_UP}WideString{$ELSE}AnsiString{$ENDIF};
  AParams: TParams;
  AResultSet: Pointer = nil): Integer;
var
  BlobStr: AnsiString;
  i: Integer;
  Param: TParam;
  Stmt: TDISQLite3Statement;
  v: Variant;
begin
  Stmt := TDISQLite3Statement.Create;
  try
    Stmt.Database := Database;
    Stmt.SQL16 := ASQL;
    Stmt.Active := True;
    for i := 0 to AParams.Count - 1 do
      begin
        Param := AParams[i];
        v := Param.Value;
        if VarIsEmpty(v) then
          Stmt.Bind_Null(i + 1)
        else
          case Param.DataType of
            ftBlob, ftGraphic, ftOraBlob:
              begin
                BlobStr := Param.AsBlob;
                Stmt.Bind_Blob(i + 1, Pointer(BlobStr), Length(BlobStr), SQLITE_TRANSIENT);
              end;
            ftLargeInt:
              begin
                {$IFDEF COMPILER_6_UP}
                Stmt.Bind_Int64(i + 1, v);
                {$ELSE COMPILER_6_UP}
                Stmt.Bind_Int(i + 1, v);
                {$ENDIF COMPILER_6_UP}
              end;
            ftWideString:
              begin
                Stmt.Bind_Str16(i + 1, v);
              end;
            else
              Stmt.bind_Variant(i + 1, v);
          end;
      end;
    Stmt.Step;
    Result := Database.Changes;
  finally
    Stmt.Free;
  end;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.{$IFDEF COMPILER_10_UP}PSGetKeyFieldsW: WideString{$ELSE}PSGetKeyFields: AnsiString{$ENDIF};
var
  i: Integer;
begin
  Result := '';
  for i := 0 to FColumnCount - 1 do
    with FRowBuffer[i].Col do
      if ColumnIsKey then
        begin
          if Result <> '' then
            Result := Result + ';';
          Result := Result + ColumnName;
        end;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.{$IFDEF COMPILER_10_UP}PSGetQuoteCharW: WideString{$ELSE}PSGetQuoteChar: AnsiString{$ENDIF};
begin
  Result := SQLITE3_IDENTIFIER_QUOTE_CHAR;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.{$IFDEF COMPILER_10_UP}PSGetTableNameW: WideString{$ELSE}PSGetTableName: AnsiString{$ENDIF};
var
  OldActive: Boolean;
begin
  with FSelectStatement do
    begin
      OldActive := Active;
      Active := True;
      try
        Result := TableName16(SQLITE3_IDENTIFIER_QUOTE_CHAR);
      finally
        Active := OldActive;
      end;
    end;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
procedure TDISqlite3UniDirQuery.PSEndTransaction(Commit: Boolean);
begin
  if Commit then
    Database.Commit
  else
    Database.Rollback;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.PSInTransaction: Boolean;
begin
  Result := Database.Intransaction;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.PSIsSQLBased: Boolean;
begin
  Result := True;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.PSIsSQLSupported: Boolean;
begin
  Result := True;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
procedure TDISqlite3UniDirQuery.PSReset;
begin
  if Active then
    FSelectStatement.Reset;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
procedure TDISqlite3UniDirQuery.PSStartTransaction;
begin
  Database.StartTransaction;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISqlite3UniDirQuery.PSUpdateRecord(AUpdateKind: TUpdateKind; aDelta: TDataSet): Boolean;
var
  Stmt: TDISQLite3Statement;
begin
  Stmt := FUpdateStatements[AUpdateKind];
  Result := Assigned(Stmt);
  if Result then
    try
      Stmt.Active := True;
      try
        Result :=
          BindDataSet(Stmt, aDelta) and
          (Stmt.Step = SQLITE_DONE) and
          (Stmt.Database.Changes = 1);
      finally
        Stmt.Reset;
      end;
    except
      Result := False;
    end;
end;
{$ENDIF COMPILER_5_UP}

procedure TDISqlite3UniDirQuery.SelectStatementAfterClose(ASender: TObject);
begin
  Active := False;
end;

procedure TDISqlite3UniDirQuery.SetDatabase(const AValue: TDISQLite3Database);
var
  uk: TUpdateKind;
  Stmt: TDISQLite3Statement;
begin
  CheckInactive;
  FSelectStatement.Database := AValue;
  for uk := Low(TUpdateKind) to High(TUpdateKind) do
    begin
      Stmt := FUpdateStatements[uk];
      if Assigned(Stmt) then
        Stmt.Database := AValue;
    end;
end;

{$IFNDEF COMPILER_6_UP}

function TDISqlite3UniDirQuery.AllocRecordBuffer: PChar;
begin
  Result := nil;
end;

procedure TDISqlite3UniDirQuery.FreeRecordBuffer(var Buffer: PChar);
begin
end;

procedure TDISqlite3UniDirQuery.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
end;

function TDISqlite3UniDirQuery.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := bfCurrent;
end;

function TDISqlite3UniDirQuery.GetRecordSize: Word;
begin

  Result := 1024;
end;

procedure TDISqlite3UniDirQuery.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
end;

procedure TDISqlite3UniDirQuery.InternalDelete;
begin
end;

procedure TDISqlite3UniDirQuery.InternalFirst;
begin
  FSelectStatement.Reset;
end;

procedure TDISqlite3UniDirQuery.InternalGotoBookmark(Bookmark: Pointer);
begin
end;

procedure TDISqlite3UniDirQuery.InternalInitRecord(Buffer: PChar);
begin
end;

procedure TDISqlite3UniDirQuery.InternalLast;
begin
end;

procedure TDISqlite3UniDirQuery.InternalPost;
begin
end;

procedure TDISqlite3UniDirQuery.InternalSetToRecord(Buffer: PChar);
begin
end;

procedure TDISqlite3UniDirQuery.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
end;

procedure TDISqlite3UniDirQuery.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
end;

procedure TDISqlite3UniDirQuery.SetFieldData(Field: TField; Buffer: Pointer);
begin
end;

{$ENDIF !COMPILER_6_UP}

constructor TDISQLite3BlobStream.Create(const Data: Pointer; const Size: Integer);
begin
  inherited Create;
  SetPointer(Data, Size);
end;

function TDISQLite3BlobStream.Write(const Buffer; Count: LongInt): LongInt;
begin
  raise EStreamError.Create(SWriteError);
end;

{$IFNDEF COMPILER_10_UP}
function TDISQLite3BlobField.GetAsWideString: WideString;
var
  l: Integer;
begin
  with DataSet.CreateBlobStream(Self, bmRead) do
    try
      l := Size div 2;
      SetString(Result, nil, l);
      ReadBuffer(Pointer(Result)^, l * 2);
    finally
      Free;
    end;
end;
{$ENDIF COMPILER_10_UP}

{$IFNDEF COMPILER_10_UP}
procedure TDISQLite3BlobField.SetAsWideString(const AValue: WideString);
begin
  with DataSet.CreateBlobStream(Self, bmWrite) do
    try
      WriteBuffer(Pointer(AValue)^, Length(AValue) * 2);
    finally
      Free;
    end;
end;
{$ENDIF COMPILER_10_UP}

constructor TDISQLite3MemoField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetDataType(ftMemo);
end;

function TDISQLite3MemoField.GetAsString: AnsiString;
begin
  Result := GetAsWideString;
end;

procedure TDISQLite3MemoField.SetAsString(const AValue: AnsiString);
begin
  SetAsWideString(AValue);
end;

function TDISQLite3MemoStream.Write(const Buffer; Count: Integer): Integer;
begin
  raise EStreamError.Create(SWriteError);
end;

{$IFNDEF COMPILER_5_UP}
constructor TDISQLite3WideStringField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetDataType(ftWideString);
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_5_UP}
class procedure TDISQLite3WideStringField.CheckTypeSize(Value: Integer);
begin
  if (Value < 0) then
    DatabaseError(PResStringRec(@SInvalidFieldSize));
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_5_UP}
function TDISQLite3WideStringField.GetAsString: string;
begin
  Result := GetAsWideString;
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_5_UP}
function TDISQLite3WideStringField.GetAsVariant: Variant;
var
  s: PWideChar;
begin
  s := nil;
  if GetData(@s) then
    begin
      TVarData(Result).VOleStr := PWideChar(s);
      TVarData(Result).vType := varOleStr;