unit SynDBExplorerMain;

{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER

interface

{.$define USEZEOS}

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Grids,
  ExtCtrls,
  StdCtrls,
  {$ifndef FPC}
  Consts,
  {$ifdef HASINLINE}  XPMan,
  Contnrs, {$endif}
  {$endif}
  {$ifdef ISDELPHIXE}
  SynSQLite3RegEx, // use direct PCRE library as available since Delphi XE
  {$endif}
  SynCommons,
  SynZip,
  mORMot,
  SynSQLite3,
  SynSQLite3Static,
  mORMotUI,
  mORMotUIEdit,
  mORMotUILogin,
  mORMotToolBar,
  SynTaskDialog, // also fix QC 37403 for Delphi 6/7/2006
  SynTable, // for TSynFilter and TSynValidate
  SynDB,
  SynDBOracle,
  SynOleDB,
  SynDBSQLite3,
  SynDBODBC,
  SynDBRemote,
  {$ifdef USEZEOS}
  SynDBZeos,
  {$endif}
  SynDBExplorerClasses,
  SynDBExplorerFrame,
  ComCtrls;

type
  TDbExplorerMain = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    MainCaption: string;
    Connection: TExpConnectionType;
    Page: TSynPager;
    PageNew: TSynPage;
    TempFileName: TFileName;
    procedure PageChange(Sender: TObject);
    procedure PageDblClick(Sender: TObject);
  public
    ConnectionName: string;
    Tables: TStringList;
    Props: TSQLDBConnectionProperties;
    function CreateFrame: TDBExplorerFrame;
  end;

var
  DbExplorerMain: TDbExplorerMain;

  
resourcestring
  sSelectAConnection = 'Select a connection';
  sNew = 'New Connection';
  sNewOne = 'New';
  sConnectionHints = 'Display name|Database type|Server name '+
    '(for "Generic OLEDB", use ADO-like connection string, and ignore other fields; '+
    'for SQLite3 or Jet, specify the full file name)|'+
    'Database name (unneeded for Oracle/SQLite3/Jet/ODBC)|User login|'+
    'User password (set ? for prompt)';
  sSelectOrCreateAConnection = 'Select a connection to be used, or\n'+
    'click on "New connection" to create one.';
  sPleaseWaitN = 'Connecting to %s...';
  sPleaseWaitSynLz = 'Decompressing %s...';
  sUpdateConnection = 'Update connection settings';
  sPassPromptN = 'Please enter password for %s@%s:';


implementation

uses
  SynDBExplorerServer;


{$ifndef HASINLINE}
  {$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
{$endif}

{$R *.dfm}

procedure TDbExplorerMain.FormDestroy(Sender: TObject);
begin
  Tables.Free;
  Props.Free;
  if TempFileName<>'' then
    DeleteFile(TempFileName);
end;

function Crypt(const s: RawUTF8): RawUTF8;
var i: integer;
begin // just not to be written in plain ascii in .config file
  SetLength(result,length(s));
  for i := 0 to length(s)-1 do
    PByteArray(result)[i] := PByteArray(s)[i] xor (i+137);
end;

procedure TDbExplorerMain.FormCreate(Sender: TObject);
var Conns: TSQLRestStorageInMemory;
function TryConnect(C: TSQLConnection; LoadTableNames: boolean): boolean;
const CONN_CLASSES: array[TExpConnectionType] of TSQLDBConnectionPropertiesClass =
  (TSQLDBOracleConnectionProperties,
   TOleDBOracleConnectionProperties,TOleDBMSOracleConnectionProperties,
   TOleDBMSSQLConnectionProperties,TOleDBConnectionProperties,
   TSQLDBSQLite3ConnectionProperties,
   {$ifdef WIN64}
   nil, // no JET/MSAccess available under Win64
   {$else}
   TOleDBJetConnectionProperties,
   {$endif}
   TODBCConnectionProperties,
   TSQLDBWinHTTPConnectionProperties,
   {$ifdef USEZEOS}TSQLDBZeosConnectionProperties{$else}nil{$endif}
  );
var i: integer;
    Pass: RawUTF8;
begin
  result := false;
  if CONN_CLASSES[C.Connection]=nil then begin
    {$ifndef USEZEOS}
    if C.Connection=ctZEOS then
      ShowMessage('USEZEOS conditional should be defined in SynDBExplorerMain.pas',
        'Zeos/ZDBC not available',true);
    {$endif} 
    exit;
  end;
  try
    Pass := Crypt(C.Password);
    if Pass='?' then 
      Pass := StringToUTF8(InputBox(Caption,format(sPassPromptN,
        [UTF8ToString(C.UserName),UTF8ToString(C.Server)]),'',true));
    if C.Connection=ctGenericOLEDB then begin
      Props := TOleDBConnectionProperties.Create('','','','');
      with TOleDBConnectionProperties(Props) do begin
        ConnectionString := UTF8ToWideString(C.Server);
        if LoadTableNames then begin
          ConnectionStringDialogExecute(Handle);
          C.Server := WideStringToUTF8(ConnectionString);
        end;
      end;
    end else 
      Props := CONN_CLASSES[C.Connection].Create(C.Server,C.Database,C.UserName,Pass);
    ConnectionName := UTF8ToString(C.Ident);
    with CreateTempForm(format(sPleaseWaitN,[ConnectionName]),nil,True) do
    try
      Connection := C.Connection;
      MainCaption := format('%s %s (compiled with %s) - %s',
        [MainCaption,SYNOPSE_FRAMEWORK_VERSION,GetDelphiCompilerVersion,ConnectionName]);
      if LoadTableNames or                      // retrieve all needed info from DB
         (C.Connection=ctRemoteHTTP) then begin
        Props.GetTableNames(C.fTableNames);     // retrieve and set table names
        C.ForeignKeys := CompressString(Props.ForeignKeysData); // foreign keys
        if Conns<>nil then
          Conns.Modified := true;
      end else begin
        Props.ThreadSafeConnection.Connect;
        Props.ForeignKeysData := UncompressString(C.ForeignKeys); 
      end;
      for i := 0 to High(C.TableNames) do
        Tables.Add(UTF8ToString(C.TableNames[i]));
{$ifdef ISDELPHIXE}
     with TSQLDBSQLite3Connection(Props.ThreadSafeConnection) do
     if InheritsFrom(TSQLDBSQLite3Connection) then
       CreateRegExpFunction(DB.DB);
{$endif}
      result := true;
    finally
      Screen.Cursor := crDefault;
      Free;
    end;
  except
    on E: Exception do begin
      ShowMessage(E.Message,true);
      FreeAndNil(Props);
    end;
  end;
end;
var Btns: TCommonButtons;
    Task: TTaskDialog;
    C: TSQLConnection;
    CmdLine: TExpConnectionType;
    FN, msg, FN2: string;
    i, res: Integer;
    tmp: array[0..MAX_PATH] of char;
begin
  Conns := nil;
  DefaultFont.Name := 'Tahoma';
  DefaultFont.Size := 9;
  Tables := TStringList.Create;
  C := nil;
  with TSQLConnection.RecordProps do begin
    AddFilterOrValidate('Ident',TSynFilterTrim.Create);
    AddFilterOrValidate('Ident',TSynValidateText.Create);
    //AddFilterOrValidate('Server',TSynValidateText.Create);
  end;
  MainCaption := Caption;
  if (ParamCount=1) and FileExists(paramstr(1)) then begin
    FN := paramstr(1);
    CmdLine := ctOracleDirectOCI;
    if IsJetFile(FN) then
      CmdLine := ctJet_mdbOLEDB else
    if IsSQLite3File(FN) then
      CmdLine := ctSqlite3 else
    if TSQLDataBase.IsBackupSynLZFile(FN) then begin
      FN2 := ExtractFileName(FN);
      SetString(TempFileName, tmp, GetTempPath(SizeOf(tmp), tmp));
      TempFileName := TempFileName+FN2+'.db';
      DeleteFile(TempFileName);
      with CreateTempForm(format(sPleaseWaitSynLz,[FN2]),nil,True) do
      try
        if TSQLDatabase.BackupUnSynLZ(FN, TempFileName) then begin
          CmdLine := ctSqlite3;
          FN := TempFileName;
        end;
      finally
        Screen.Cursor := crDefault;
        Free;
      end;
    end;
    if CmdLine=ctOracleDirectOCI then begin
      ShowMessage(FN+'?',True);
      exit;
    end;
    C := TSQLConnection.Create;
    try
      C.Connection := CmdLine;
      C.Ident := StringToUTF8(FN);
      C.Server := C.Ident;
      TryConnect(C,True);
    finally
      C.Free;
    end;
  end else begin
    Conns := TSQLRestStorageInMemory.Create(
      TSQLConnection,nil,ChangeFileExt(ExeVersion.ProgramFileName,'.config'),false);
    try
      Conns.ExpandedJSON := true; // for better human reading and modification
      Task.Title := MainCaption;
      Task.Inst := sSelectAConnection;
      Task.Content := sSelectOrCreateAConnection;
      if Conns.Count=0 then
        Btns := [cbCancel] else begin
        for i := 0 to Conns.Count-1 do
          Task.Selection := Task.Selection+UTF8ToString(TSQLConnection(Conns[i]).Ident)+#10;
        Btns := [cbOk,cbCancel];
        Task.Query := UTF8ToString(TSQLConnection(Conns[0]).Ident);
        Task.Verify := sUpdateConnection;
      end;
      Task.VerifyChecked := false;
      Task.Buttons := sNew;
      res := Task.Execute(Btns,0,[],tiQuestion);
      case res of
      mrOk:
        if Task.VerifyChecked then begin
          C := TSQLConnection(Conns[Task.SelectionRes]);
          msg := Task.Verify;
        end else
          TryConnect(TSQLConnection(Conns[Task.SelectionRes]),false);
      mrBtn1: begin
        C := TSQLConnection.Create;
        msg := sNew;
      end;
      end;
      if C<>nil then
        with TRecordEditForm.Create(self) do
        try
          C.Password := Crypt(C.Password);
          SetRecord(nil,C,nil,nil,sConnectionHints,0,msg);
          if ShowModal=mrOk then begin
            C.Password := Crypt(C.Password);
            if TryConnect(C,true) and (res=mrBtn1) then
              Conns.AddOne(C,false,'') else
              if res=mrBtn1 then
                FreeAndNil(C);
          end else
            if res=mrBtn1 then
              FreeAndNil(C);
        finally
          Free;
        end;
    finally
      Conns.Free;
    end;
  end;
  Page := TSynPager.Create(self);
  Page.ControlStyle := Page.ControlStyle+[csClickEvents]; // enable OnDblClick
  Page.Parent := self;
  Page.Align := alClient;
  PageNew := TSynPage.Create(self);
  PageNew.Caption := sNewOne;
  PageNew.PageControl := Page;
  Page.OnChange := PageChange;
  Page.OnDblClick := PageDblClick;
end;

procedure TDbExplorerMain.FormShow(Sender: TObject);
begin
  if Props=nil then begin
    Close;
    exit;
  end;
  Caption := MainCaption;
  SetStyle(self);
  CreateFrame;
end;

procedure TDbExplorerMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    ord('T'):
      if Shift=[ssCtrl] then
        CreateFrame;
    VK_F9:
      with Page.ActivePage do
        if TObject(Tag).InheritsFrom(TDBExplorerFrame) then
          with TDBExplorerFrame(Tag) do
          if Shift=[] then
            BtnExecClick(BtnExec) else
          if ssShift in Shift then
            BtnExecClick(BtnExecToTab);
  end;
end;

var
  FrameID: integer;
  
function TDbExplorerMain.CreateFrame: TDBExplorerFrame;
var P: TSynPage;
begin
  P := TSynPage.Create(self);
  P.PageControl := Page;
  P.PageIndex := Page.PageCount-2;
  result := TDBExplorerFrame.Create(P);
  result.Parent := P;
  result.Align := alClient;
  result.Tables := Tables;
  result.Props := Props;
  result.EditTableChange(nil);
  inc(FrameID);
  result.Name := 'P'+IntToStr(FrameID);
  P.Tag := PtrInt(result);
  Page.ActivePage := P;
  result.EditTable.SetFocus;
  SetStyle(P);
end;

procedure TDbExplorerMain.PageChange(Sender: TObject);
begin
  if Page.ActivePage=PageNew then
    CreateFrame;
end;

procedure TDbExplorerMain.PageDblClick(Sender: TObject);
var n, i: Integer;
begin
  i := Page.ActivePageIndex;
  n := Page.PageCount-2;
  if n>0 then begin
    Page.ActivePage.Free;
    if i=n then
      Page.ActivePageIndex := n-1;
  end;
end;

end.