disqlite3dataset.pas

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

    end
  else
    Result := NULL;
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_10_UP}
function TDISQLite3WideStringField.GetAsWideString: WideString;
begin

  if not GetData(@Result) then
    Result := '';
end;
{$ENDIF !COMPILER_10_UP}

{$IFNDEF COMPILER_5_UP}
function TDISQLite3WideStringField.GetDataSize: {$IFDEF COMPILER_6_UP}Integer{$ELSE}Word{$ENDIF};
begin
  Result := SizeOf(WideString);
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_5_UP}
procedure TDISQLite3WideStringField.SetAsString(const Value: string);
begin
  SetAsWideString(Value);
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_5_UP}
procedure TDISQLite3WideStringField.SetAsWideString(const AValue: WideString);
var
  TruncValue: WideString;
begin
  if (Size > 0) and (Length(Value) > Size) then
    begin
      TruncValue := Copy(Value, 1, Size);
      SetData(@TruncValue)
    end
  else
    SetData(@AValue);
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_5_UP}
procedure TDISQLite3WideStringField.SetVarValue(const Value: Variant);
begin
  SetAsWideString(Value);
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_10_UP}
constructor TDISQLite3WideMemoField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetDataType(ftMemo);
end;
{$ENDIF !COMPILER_10_UP}

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

{$IFNDEF COMPILER_10_UP}
procedure TDISQLite3WideMemoField.SetAsString(const Value: string);
begin
  SetAsWideString(Value);
end;
{$ENDIF !COMPILER_10_UP}

procedure SQLite3_FreeMem_Destructor(p: Pointer);
begin
  FreeMem(p);
end;

procedure TDISQLite3DataSetImporter.Execute;
label
  AddCreate;
type

  TGraphicHeader = record
    Count: Word;
    HType: Word;
    Size: Integer;
  end;

var
  addSep: Boolean;
  BlobStream: TStream;
  BlobMem: Pointer;
  BlobSize: Integer;
  BM: TBookmark;
  DataBaseConnected, DataSetActive, DataSetControlsDisabled: Boolean;
  f: TField;
  GraphicHeader: TGraphicHeader;
  i: Integer;
  Stmt: TDISQLite3Statement;
  s, SQL: WideString;
begin
  if not Assigned(FDatabase) then
    DISQLite3Database.DatabaseError(PResStringRec(@SMissingDatabase));
  if not Assigned(FDataSet) then
    DISQLite3Database.DatabaseError(PResStringRec(@SMissingDataset));

  DataBaseConnected := FDatabase.Connected;
  DataSetActive := FDataSet.Active;
  DataSetControlsDisabled := FDataSet.ControlsDisabled;
  try
    if not DataSetControlsDisabled then
      FDataSet.DisableControls;
    if not DataSetActive then
      FDataSet.Active := True;

    try BM := FDataSet.GetBookmark; except BM := nil; end;
    try
      FDataSet.CheckBrowseMode;

      try FDataSet.UpdateCursorPos; except end;

      FDatabase.StartTransaction;
      try

        addSep := False;

        FDatabase.Execute16('DROP TABLE IF EXISTS ' + QuotedStr16(FTableName) + ';');

        SQL := 'CREATE TABLE IF NOT EXISTS ' + DISQLite3Api.QuotedStr16(FTableName) + '(';
        for i := 0 to FDataSet.FieldCount - 1 do
          begin
            f := FDataSet.Fields[i];
            case f.DataType of

              ftUnknown:
                begin
                end;

              ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString
                {$IFDEF COMPILER_5_UP}, ftVariant, ftGuid{$ENDIF}
              {$IFDEF COMPILER_10_UP}, ftFixedWideChar, ftWideMemo,
              ftOraInterval{$ENDIF}:
                begin
                  s := 'TEXT';
                  goto AddCreate;
                end;

              ftSmallint, ftInteger, ftWord, ftBoolean, ftLargeInt:
                begin
                  s := 'INTEGER';
                  goto AddCreate;
                end;

              ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime
                {$IFDEF COMPILER_6_UP}, ftTimestamp{$ENDIF}
              {$IFDEF COMPILER_10_UP}, ftOraTimeStamp{$ENDIF}:
                begin
                  s := 'REAL';
                  goto AddCreate;
                end;

              ftBytes, ftVarBytes, ftBlob, ftGraphic, ftParadoxOle, ftDBaseOle,
                ftTypedBinary, ftCursor, ftADT, ftArray, ftReference, ftDataSet
                {$IFDEF COMPILER_5_UP}, ftOraBlob, ftOraClob, ftInterface,
              ftIDispatch{$ENDIF}
              {$IFDEF COMPILER_6_UP}, ftFMTBcd{$ENDIF}:
                begin
                  s := 'BLOB';
                  goto AddCreate;
                end;

              ftAutoInc:
                begin
                  s := 'INTEGER PRIMARY KEY';
                  AddCreate:
                  if addSep then SQL := SQL + ', ' else addSep := True;
                  SQL := SQL + QuotedStr16(f.FieldName) + ' ' + s;
                end;

              else
                Assert(False, 'Error');
            end;

            if f.Required then
              SQL := SQL + ' NOT NULL';
            if f.ImportedConstraint <> '' then
              SQL := SQL + ' CHECK(' + f.ImportedConstraint + ')';

          end;
        SQL := SQL + ');';

        FDatabase.Execute16(SQL);

        addSep := False;
        SQL := 'INSERT INTO ' + QuotedStr16(FTableName) + ' VALUES (';
        for i := 0 to FDataSet.FieldCount - 1 do
          begin
            f := FDataSet.Fields[i];

            case f.DataType of

              ftUnknown, ftAutoInc:
                begin

                end;

              ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
                ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, ftBytes,
                ftVarBytes, ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
                ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
                ftLargeInt, ftADT, ftArray, ftReference, ftDataSet
                {$IFDEF COMPILER_5_UP}, ftOraBlob, ftOraClob, ftVariant,
              ftInterface, ftIDispatch, ftGuid{$ENDIF}
              {$IFDEF COMPILER_6_UP}, ftTimestamp, ftFMTBcd{$ENDIF}
              {$IFDEF COMPILER_10_UP}, ftFixedWideChar, ftWideMemo,
              ftOraTimeStamp, ftOraInterval{$ENDIF}:
                begin
                  if addSep then
                    SQL := SQL + ','
                  else
                    addSep := True;
                  SQL := SQL + '?';
                end;
              else
                Assert(False, 'Error');
            end;

          end;
        SQL := SQL + ');';

        Stmt := FDatabase.Prepare16(SQL);
        try

          FDataSet.First;
          while not FDataSet.EOF do
            begin

              for i := 0 to FDataSet.FieldCount - 1 do
                begin
                  f := FDataSet.Fields[i];

                  if f.IsNull then
                    Stmt.Bind_Null(i + 1)
                  else
                    case f.DataType of

                      ftUnknown, ftAutoInc:
                        begin

                        end;

                      ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString
                        {$IFDEF COMPILER_5_UP}, ftVariant, ftGuid{$ENDIF}
                      {$IFDEF COMPILER_10_UP}, ftFixedWideChar, ftWideMemo, ftOraInterval{$ENDIF}:
                        begin
                          {$IFDEF COMPILER_10_UP}
                          s := f.AsWideString;
                          {$ELSE COMPILER_10_UP}
                          if f.IsNull then

                            s := ''
                          else
                            if f is TMemoField then
                              s := f.AsVariant
                            else
                              s := f.AsString;
                          {$ENDIF COMPILER_10_UP}

                          if f.IsBlob then
                            s := WideAdjustLineBreaks(s);

                          Stmt.Bind_Str16(i + 1, s);
                        end;

                      ftBoolean:
                        begin
                          if f.Value then
                            Stmt.Bind_Int(i + 1, 1)
                          else
                            Stmt.Bind_Int(i + 1, 0);
                        end;

                      ftSmallint, ftInteger, ftWord:
                        begin
                          Stmt.Bind_Int(i + 1, f.Value);
                        end;

                      ftLargeInt:
                        begin
                          {$IFDEF COMPILER_6_UP}
                          Stmt.Bind_Int64(i + 1, f.Value);
                          {$ELSE}

                          if f is TLargeIntField then
                            Stmt.Bind_Int64(i + 1, (f as TLargeIntField).Value)
                          else
                            Stmt.Bind_Int(i + 1, f.Value);
                          {$ENDIF}

                        end;

                      ftFloat, ftCurrency, ftBCD:
                        begin
                          Stmt.Bind_Double(i + 1, f.Value);
                        end;

                      ftDateTime
                        {$IFDEF COMPILER_6_UP}, ftTimestamp{$ENDIF}
                      {$IFDEF COMPILER_10_UP}, ftOraTimeStamp{$ENDIF}:
                        begin
                          Stmt.Bind_Double(i + 1, DISQLite3Api.DateTimeToJulianDate(f.Value));
                        end;

                      ftDate:
                        begin
                          Stmt.Bind_Double(i + 1, DISQLite3Api.DateToJulianDate(f.Value));
                        end;

                      ftTime:
                        begin
                          Stmt.Bind_Double(i + 1, DISQLite3Api.TimeToJulianDate(f.Value));
                        end;

                      ftBytes, ftVarBytes, ftBlob, ftParadoxOle, ftDBaseOle,
                        ftCursor, ftADT, ftArray, ftReference, ftDataSet
                        {$IFDEF COMPILER_5_UP}, ftOraBlob, ftOraClob, ftInterface, ftIDispatch{$ENDIF}
                      {$IFDEF COMPILER_6_UP}, ftFMTBcd{$ENDIF}:
                        begin
                          BlobStream := FDataSet.CreateBlobStream(f, bmRead);
                          try
                            BlobSize := BlobStream.Size;
                            GetMem(BlobMem, BlobSize);
                            BlobStream.Read(BlobMem^, BlobSize);
                            Stmt.Bind_Blob(i + 1, BlobMem, BlobSize, SQLite3_FreeMem_Destructor);
                          finally
                            BlobStream.Free;
                          end;
                        end;

                      ftGraphic, ftTypedBinary:
                        begin
                          BlobStream := FDataSet.CreateBlobStream(f, bmRead);
                          try
                            BlobSize := BlobStream.Size;

                            BlobStream.Read(GraphicHeader, SizeOf(GraphicHeader));
                            if (GraphicHeader.Count <> 1) or
                              (GraphicHeader.HType <> $0100) or
                              (GraphicHeader.Size <> BlobSize - SizeOf(GraphicHeader)) then
                              BlobStream.Position := 0
                            else
                              Dec(BlobSize, SizeOf(GraphicHeader));

                            GetMem(BlobMem, BlobSize);
                            BlobStream.Read(BlobMem^, BlobSize);
                            Stmt.Bind_Blob(i + 1, BlobMem, BlobSize, SQLite3_FreeMem_Destructor);
                          finally
                            BlobStream.Free;
                          end;
                        end;

                      else
                        Assert(False, 'Error');
                    end;

                end;

              Stmt.Step;
              Stmt.Reset;

              FDataSet.Next;
            end;

        finally
          Stmt.Free;
        end;

        FDatabase.Commit;
      except
        FDatabase.Rollback;
        raise;
      end;

    finally
      if Assigned(BM) then
        begin

          try FDataSet.GotoBookmark(BM); except end;
          try FDataSet.FreeBookmark(BM); except end;
        end;
    end;
  finally
    if not DataSetActive then
      FDataSet.Active := DataSetActive;
    if not DataSetControlsDisabled then
      FDataSet.EnableControls;
    if not DataBaseConnected then
      FDatabase.Connected := DataBaseConnected;
  end;
end;

procedure TDISQLite3DataSetImporter.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) then
    begin
      if AComponent = FDatabase then
        FDatabase := nil;
      if AComponent = FDataSet then
        FDataSet := nil;
    end;
  inherited;
end;

procedure TDISQLite3DataSetImporter.SetDatabase(const AValue: TDISQLite3Database);
begin
  if FDatabase <> AValue then
    begin
      {$IFDEF COMPILER_5_UP}
      if Assigned(FDatabase) then
        FDatabase.RemoveFreeNotification(Self);
      {$ENDIF COMPILER_5_UP}
      FDatabase := AValue;
      if Assigned(FDatabase) then
        FDatabase.FreeNotification(Self);
    end;
end;

procedure TDISQLite3DataSetImporter.SetDataSet(const AValue: TDataSet);
begin
  if FDataSet <> AValue then
    begin
      {$IFDEF COMPILER_5_UP}
      if Assigned(FDataSet) then
        FDataSet.RemoveFreeNotification(Self);
      {$ENDIF COMPILER_5_UP}
      FDataSet := AValue;
      if Assigned(FDataSet) then
        FDataSet.FreeNotification(Self);
    end;
end;

end.