xtool/contrib/mORMot/SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerExportTables.pas

unit SynDBExplorerExportTables;

interface

uses
  Windows, Messages, SysUtils, CheckLst, Controls, StdCtrls, Classes, Graphics,
  Forms, ExtCtrls, mORMotUILogin,
  SynZip, SynCommons, SynDB, SynTable, SynDBSQLite3;

type
  TDBExportTablesForm = class(TForm)
    BtnExport: TButton;
    BtnCancel: TButton;
    GroupWhere: TGroupBox;
    ChkUseStandardCollations: TCheckBox;
    ChkNoBlobExport: TCheckBox;
    ChkZipDBFile: TCheckBox;
  protected
    fProps: TSQLDBConnectionProperties;
    fEdits: array of TLabeledEdit;
    procedure SetTableNames(const Value: TStrings);
  public
    class function ExportTables(aTableNames: TStrings; aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer; overload;
    class function ExportTables(aListBox: TListBox; aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer; overload;
    property Props: TSQLDBConnectionProperties read fProps write fProps;
  end;

var
  DBExportTablesForm: TDBExportTablesForm;

implementation

{$R *.dfm}

resourcestring
  sTableExportWhereHint = 'e.g. "ID>1000" or "RowNum<=500"';

  
{ TDBExportTablesForm }

class function TDBExportTablesForm.ExportTables(aTableNames: TStrings;
  aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer;
var DB: TSQLDBSQLite3ConnectionProperties;
    Conn: TSQLDBSQLite3Connection;
    Rows: TSQLDBStatement;
    Table,SQL: RawUTF8;
    Fields: TSQLDBColumnDefineDynArray;
    ExcludeTypes: TSQLDBFieldTypes;
    ZipFileName: TFileName;
    Tmp: TForm;
    TmpPanel: TPanel;
    i: integer;
begin
  result := 0;
  if aDestFileName<>'' then
  with TDBExportTablesForm.Create(Application) do
  try
    SetTableNames(aTableNames);
    ActiveControl := BtnExport;
    if ShowModal<>mrOk then
      exit;
    if ChkNoBlobExport.Checked then
      ExcludeTypes := [ftBlob] else
      ExcludeTypes := [];
    DeleteFile(aDestFileName);
    Tmp := CreateTempForm(BtnExport.Caption,@TmpPanel,true);
    try
      DB := TSQLDBSQLite3ConnectionProperties.Create(StringToUTF8(aDestFileName),'','','');
      try
        DB.UseMormotCollations := not ChkUseStandardCollations.Checked;
        Conn := DB.MainConnection as TSQLDBSQLite3Connection;
        Conn.Connect;
        try
          Conn.DB.ExecuteAll('PRAGMA journal_mode=MEMORY;PRAGMA journal_size_limit=16777216;'+
            'PRAGMA synchronous=OFF;');
          // Conn.DB.SetWALMode(true); // slower in WAL mode for huge data :(
          assert(aTableNames.Count=length(fEdits));
          for i := 0 to aTableNames.Count-1 do begin
            TmpPanel.Caption := aTableNames[i];
            Application.ProcessMessages;
            Table := StringToUTF8(aTableNames[i]);
            aProps.GetFields(Table,Fields);
            SQL := Trim(StringToUTF8(fEdits[i].Text));
            if SQL<>'' then
              SQL := ' where '+SQL;
            SQL := aProps.SQLSelectAll(Table,Fields,ExcludeTypes)+SQL;
            Rows := aProps.NewThreadSafeStatement;
            try
              Rows.Execute(SQL,true);
              Table := StringReplaceAll(Table,[' ','' ,'-','']);
              inc(result,Conn.NewTableFromRows(Table,Rows,true));
            finally
              Rows.Free;
            end;
          end;
        except
          on E: Exception do
            ShowMessage(E.Message,true);
        end;
      finally
        DB.Free;
      end;
      if ChkZipDBFile.Checked then begin
        ZipFileName := ChangeFileExt(aDestFileName,'.zip');
        TmpPanel.Caption := ExtractFileName(ZipFileName);
        Application.ProcessMessages;
        with TZipWrite.Create(ZipFileName) do
        try
          AddDeflated(aDestFileName,true);
        finally
          Free;
        end;
        DeleteFile(aDestFileName);
      end;
    finally
      Screen.Cursor := crDefault;
      Tmp.Free;
    end;
  finally
    Free;
  end;
end;

class function TDBExportTablesForm.ExportTables(aListBox: TListBox;
  aProps: TSQLDBConnectionProperties; const aDestFileName: TFileName): integer;
var T: TStringList;
    i: integer;
begin
  result := 0;
  if (aListBox=nil) or (aListBox.SelCount=0) then
    exit;
  T := TStringList.Create;
  try
    for i := 0 to aListBox.Count-1 do
      if aListBox.Selected[i] then
        T.Add(aListBox.Items[i]);
    result := ExportTables(T,aProps,aDestFileName);
  finally
    T.Free;
  end;
end;

procedure TDBExportTablesForm.SetTableNames(const Value: TStrings);
var E: TLabeledEdit;
    max,x,y,n,i,h: integer;
begin
  if Value=nil then
    n := 0 else
    n := Value.Count;
  SetLength(fEdits,n);
  max := Screen.Height;
  if n*32+132>max then
    h := 24 else
    h := 32;
  x := 160;
  n := n*h+24;
  if n+148>max then
    n := max-164;
  GroupWhere.Height := n;
  ClientHeight := n+132;
  y := 24;
  for i := 0 to high(fEdits) do begin
    E := TLabeledEdit.Create(self);
    E.Parent := GroupWhere;
    E.LabelPosition := lpLeft;
    E.SetBounds(x,y,180,22);
    E.EditLabel.Caption := Value[i];
    E.ShowHint := true;
    E.Hint := sTableExportWhereHint;
    inc(y,h);
    if (h=24) and (y>=n-24) and (i<>high(fEdits)) then
    if x<>160 then break else begin
      y := 24;
      inc(x,340);
      Width := 740;
    end;
  end;
end;

end.