unit Unit1;

//{$mode objfpc}{$H+}

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
  //////////////////////////////////////////////////////
  {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
  //////////////////////////////////////////////////////
  Classes, SysUtils, math, SQLDB, SQLDBLib, oracleconnection, IBConnection,
  mysql80conn, mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn,
  mysql56conn, mysql57conn, odbcconn, PQConnection, MSSQLConn, DB, SQLite3Conn,
  Forms, Controls, Graphics, Dialogs, StdCtrls, DBCtrls, DBGrids, ExtCtrls,
  ComCtrls, Buttons, ZConnection, ZDataset, ZDbcIntfs, Types, strutils,
  _crw_alloc, _crw_str, _crw_fio, _crw_dbglog, _crw_regexp, _crw_base64,
  _crw_sesman, _crw_polling, _crw_ef, _crw_apputils, _crw_uri,
  _crw_dbapi, _crw_dbcon, _crw_dblaz, _crw_dbzeo;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button13: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button11: TButton;
    Button12: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    ButtonTestBlob: TButton;
    ButtonUri: TButton;
    DataSourceZ: TDataSource;
    DataSource1: TDataSource;
    MemoLog: TMemo;
    MemoStdOut: TMemo;
    PageControlLogs: TPageControl;
    PanelStdOut: TPanel;
    PanelLog: TPanel;
    PanelButtons: TPanel;
    PanelLogs: TPanel;
    SQLite3Connection1: TSQLite3Connection;
    SQLQuery1: TSQLQuery;
    SQLTransaction1: TSQLTransaction;
    TabSheetOut: TTabSheet;
    TabSheetLog: TTabSheet;
    TimerTick55: TTimer;
    ZConnection1: TZConnection;
    ZQuery1: TZQuery;
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure ButtonTestBlobClick(Sender: TObject);
    procedure ButtonUriClick(Sender: TObject);
    procedure DataSourceZDataChange(Sender: TObject; Field: TField);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure DataSource1StateChange(Sender: TObject);
    procedure DataSource1UpdateData(Sender: TObject);
    procedure TimerTick55Timer(Sender: TObject);
  private
   myDb:TSqlDbConnecter;
   myZs:TZeosConnecter;
  public
   procedure AddLog(When:Double; What:String);
  end;

var
  Form1: TForm1 = nil;

function StartSession(arg:LongString):Boolean;

implementation

{$R *.lfm}

const {$I _con_stdadodb.inc}
const {$I _con_stdsqldb.inc}

procedure TForm1.ButtonUriClick(Sender: TObject);
var con,engine:Integer; arg:LongString;
begin
 UriMan.TestParseDbUris;
 UriMan.Test_Pct_Encode_Decode;
 writeln(UriMan.ServicePortList);
 engine:=db_engine_sqldb; // engine:=db_engine_zeos;
 arg:='firebird://SYSDBA:masterkey@localhost:3050/employee.fdb?CharSet=utf8;#example';
 con:=db_connection(engine,arg);
 if (con<>0) then begin
 end;
 db_free(con);
end;

procedure CrwDaqSystemEcho(const Msg:LongString);
begin
 if (Msg<>'') then StdOutputFifo.PutText(Msg);
end;

procedure CrwDaqBlasterLogger(const Msg:LongString);
begin
 DebugOutText(stdfSound,Msg);
end;

procedure CrwDaqPollSession;
var line:LongString;
begin
 if SessionManager.HasIpcServer then
 try
  while SessionManager.ReadIpcMessage(line) do begin
   Echo(line);
  end;
 except
  on E:Exception do BugReport(E,nil,'CrwDaqPollSession');
 end;
end;

function IterStdOut(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
begin
 Result:=True;
 TStrings(Custom).Add(Line);
 FakeNop(n);
end;

procedure CrwDaqPollStdOut;
var buff:LongString;
begin
 try
  buff:=StdOutputFifo.GetText;
  if (buff='') or (Form1=nil) then Exit;
  Form1.MemoStdOut.Lines.BeginUpdate;
  try
   ForEachStringLine(Buff,IterStdOut,Form1.MemoStdOut.Lines);
  finally
   Form1.MemoStdOut.Lines.EndUpdate;
  end;
  Form1.MemoStdOut.SelStart:=MaxInt;
  //Form1.MemoStdOut.CaretPos:=Point(0,Form1.MemoStdOut.Lines.Count-1);
 except
  on E:Exception do BugReport(E,nil,'CrwDaqPollStdOut');
 end;
end;

 {
 Start session:
 if StartSession('1')   then ... - run single instance - session 1.
 if StartSession('$ 1') then ... - use option --session N or run session 1.
 if StartSession('? 9') then ... - run first found free session in range [1..9].
 }
function StartSession(arg:LongString):Boolean;
begin
 Result:=SessionManager.Start(arg);
 if Result then begin
  DefaultFormatSettings.DecimalSeparator:='.';
  //TheUACEchoProcedure:=StandardEchoProcedure;
  SessionManager.RedirectStdIo;
  SessionManager.OpenLeakageLog;
  SessionManager.OpenReadIniLog;
  SessionManager.OpenDebugLog;
  SessionManager.OpenErrorLog;
  SessionManager.OpenSoundLog;
  SessionManager.SetGuardIniPath;
  SessionManager.SetSystemEcho(CrwDaqSystemEcho);
  SessionManager.SetBlasterLogger(CrwDaqBlasterLogger);
  //SessionManager.SetSystemSendToMainConsole(SystemCalculatorFifoPutText);
  //DefaultCanShowModalLimit:=3;
  //SetEnv('CRW_DAQ_SYS_TMP_DIR',SessionManager.SystemTmpDir);
  //SetEnv('CRW_DAQ_VAR_TMP_DIR',SessionManager.VarTmpDir);
  //SetEnvironPrinter(0); SetEnvironLpPageIndents;
 end;
 if SessionManager.HasIpcServer then Tick55Actions.Add(CrwDaqPollSession);
 Tick55Actions.Add(CrwDaqPollStdOut);
end;

{ TForm1 }

procedure TForm1.AddLog(When:Double; What:String);
var Line:String;
begin
 Line:=What;
 MemoLog.Lines.Add(Line);
 MemoLog.SelStart:=MaxInt;
end;

procedure TForm1.DataSourceZDataChange(Sender: TObject; Field: TField);
begin
 Exit;
 ShowMessage('DataChange1');
end;

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
 Exit;
 if Assigned(Field)
 then AddLog(Now,Format('DataChange %s = %s',[Field.FieldName,Field.DisplayText]))
 else AddLog(Now,'DataChange');
end;

procedure TForm1.DataSource1StateChange(Sender: TObject);
begin
 AddLog(Now,Format('StateChange %d',[Ord(DataSource1.State)]));
end;

procedure TForm1.DataSource1UpdateData(Sender: TObject);
begin
 AddLog(Now,Format('UpdateData %d',[2]));
end;

procedure TForm1.TimerTick55Timer(Sender: TObject);
begin
 Tick55Actions.Execute;
 if InitSubSystems.Count>0 then begin
  InitSubSystems.Execute;
  InitSubSystems.Clear;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var rows,cols,i:Integer; fn,dv:String;
begin
 SQLite3Connection1.DatabaseName:=AdaptFileName('c:\opt\crwdaq\demo\demo_data\toc.db');
 SQLite3Connection1.Connected:=true;
 SQLQuery1.SQL.Text:='select * from country';
 SQLQuery1.SQL.Text:='select * from toc';
 SQLQuery1.Active:=true;
 rows:=0; fn:='';
 cols:=DataSource1.DataSet.FieldCount;
 for i:=0 to cols-1 do fn:=fn+' '+DataSource1.DataSet.Fields[i].FieldName;
 while not DataSource1.DataSet.EOF do begin
  dv:='';
  for i:=0 to cols-1 do dv:=dv+' '+DataSource1.DataSet.Fields[i].AsAnsiString;
  AddLog(Now,dv);
  DataSource1.DataSet.Next;
  Inc(rows);
 end;
 ShowMessage('DataChange2'+EOL
            +'Rec '+IntToStr(rows)+EOL
            +'Fld '+IntToStr(cols)+EOL
            +fn+EOL);
 SQLQuery1.Active:=false;
end;

procedure TForm1.Button2Click(Sender: TObject);
var rows,cols,i:Integer; fn,dv:String;
begin
 Kill(TObject(myDb));
 myDb:=NewSqlDbConnecter('Provider=SQLite3;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\toc.db')+';');
 myDb.Master:=@myDb;
 if myDb.Open then begin
  myDb.Api.Query.SQL.Text:='select * from toc';
  myDb.Api.Query.Active:=true;
  rows:=0; fn:='';
  cols:=myDb.Api.DataSource.DataSet.FieldCount;
  for i:=0 to cols-1 do fn:=fn+' '+myDb.Api.DataSource.DataSet.Fields[i].FieldName;
  while not myDb.Api.DataSource.DataSet.EOF do begin
   dv:='';
   for i:=0 to cols-1 do dv:=dv+' '+myDb.Api.DataSource.DataSet.Fields[i].AsAnsiString;
   AddLog(Now,dv);
   myDb.Api.DataSource.DataSet.Next;
   Inc(rows);
  end;
  ShowMessage('DataChange2'+EOL
             +'Rows '+IntToStr(rows)+EOL
             +'Cols '+IntToStr(cols)+EOL
             +'File '+fn+EOL
             +'Pars '+myDb.Api.Connection.Params.Text);
  myDb.Api.Query.Active:=false;
 end;
 myDb.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
var rows,cols,i:Integer; fn,dv:String; dbr:TSqlDbRecorder;
begin
 Echo('Start '+Button3.Caption);
 Kill(TObject(myDb));
 myDb:=NewSqlDbConnecter('Provider=IB;UID=SYSDBA;PWD=masterkey;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\employee.fdb')+';'
       +'DIALECT=3;PAGESIZE=8192;');
 myDb.Master:=@myDb;
 if myDb.Open then begin
  dbr:=myDb.Execute('select * from employee');
  rows:=0; fn:='';
  cols:=dbr.FieldsCount;
  for i:=0 to cols-1 do fn:=fn+' '+dbr.FieldsNames[i]+':'+IntToStr(dbr.FieldsTypes[i]);
  while not dbr.EOF do begin
   dv:='';
   for i:=0 to cols-1 do dv:=dv+' '+dbr.FieldsAsString[i];
   AddLog(Now,dv);
   dbr.MoveNext;
   Inc(rows);
  end;
  ShowMessage('Provider '+myDb.Provider+EOL
             +'Rows '+IntToStr(rows)+EOL
             +'Cols '+IntToStr(cols)+EOL
             +'File '+fn+EOL
             +'Pars '+myDb.Api.Connection.Params.Text);
  dbr.Close;
 end;
 Kill(myDb);
 Echo('Done '+Button3.Caption);
end;

procedure TForm1.Button4Click(Sender: TObject);
var dbc,dbr,rows,cols,i,bal,tp:Integer; fn,dv,id,sq:LongString;
begin
 bal:=ObjectRegistry.Count;
 Echo('Start '+Button4.Caption);
 dbc:=db_connection(2,'Provider=IB;UID=SYSDBA;PWD=masterkey;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\employee.fdb')+';'
       +'DIALECT=3;PAGESIZE=8192;Charset=utf8;');
 if db_open(dbc,0) then begin
  dbr:=db_execute(dbc,'select * from employee',0).ref;
  rows:=0; cols:=db_fieldscount(dbr); fn:='';
  for i:=0 to cols-1 do begin
   id:=db_fieldsnames(dbr,i);
   tp:=db_fieldstypes(dbr,id);
   fn:=fn+' '+id+':'+IntToStr(db_fieldstypes(dbr,id))
      +':'+db_ctrl(dbr,'FieldTypeToString='+IntToStr(tp));
  end;
  writeln('GetString:'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
  if (db_state(dbr)>0) then
  while not db_eof(dbr) do begin
   dv:='';
   for i:=0 to cols-1 do begin
    id:=db_fieldsnames(dbr,i);
    dv:=dv+' '+db_fieldsasstring(dbr,id,'r','');
   end;
   AddLog(Now,dv);
   db_movenext(dbr);
   Inc(rows);
  end;
  db_ctrl(dbc,'Properties=Connection.SaveNullSubs=(NULL)');
  writeln('SaveNullSubs: '+db_ctrl(dbc,'Properties=Connection.SaveNullSubs'));
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest4.xml'),dfXml) then writeln('saved xml');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest4.csv'),dfAny) then writeln('saved csv');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest4.txt'),dfAny) then writeln('saved txt');
  ShowMessage('Provider '+db_ctrl(dbc,'Provider')+EOL
             +'Rows '+IntToStr(rows)+EOL
             +'Cols '+IntToStr(cols)+EOL
             +'File '+fn+EOL
             +'Pars '+db_ctrl(dbc,'Properties'));
  db_close(dbr);
  writeln('EngineId=',db_engineid(dbc));
  writeln('EngineId='+db_ctrl(dbc,'EngineId'));
  writeln('EngineName='+db_ctrl(dbc,'EngineName'));
  writeln('Properties='+EOL+db_ctrl(dbc,'Properties'));
  writeln('TableNames='+Trim(db_ctrl(dbc,'Properties=Connection.TableNames')));
  writeln('PAGESIZE='+Trim(db_ctrl(dbc,'Properties=Connection.Params.PageSize=1024')));
  writeln('Role='+Trim(db_ctrl(dbc,'Properties=Connection.Role=Server')));
 end;
 db_free(dbc); dbc:=0;
 if IsUnix then begin
  ReadUnixOdbcDriverList; ReadUnixOdbcConfigParams;
  writeln('ODBC Drivers:'+EOL+ReadUnixOdbcDriverList);
  writeln('ODBC Config:'+EOL+ReadUnixOdbcConfigParams);
 end;
 writeln('adInteger=',DbCon.StringToFieldTypeCode('adInteger'));
 writeln('ftInteger=',DbCon.StringToFieldTypeCode('ftInteger'));
 writeln('adDouble=',DbCon.StringToFieldTypeCode('adDouble'));
 writeln('ftFloat=',DbCon.StringToFieldTypeCode('ftFloat'));
 writeln('adArray=',DbCon.StringToFieldTypeCode('adArray'));
 writeln('adIntegerArray=',DbCon.StringToFieldTypeCode('adIntegerArray'));
 writeln('adAray=',DbCon.StringToFieldTypeCode('adAray'));
 writeln('GetConnectiionListAsText:'+EOL+SqlDbAssistant.GetConnectionListAsText);
 writeln('OdbcDriverNames:'+EOL+Trim(OdbcDriverNames.Text));
 writeln('KnownProviders='+StringReplace(Trim(SqlDbAssistant.KnownProviders),EOL,',',[rfReplaceAll]));
 writeln('KnownConnTypes='+StringReplace(Trim(SqlDbAssistant.KnownConnTypes),EOL,',',[rfReplaceAll]));
 dv:='interbase;mysql 8.0;fb';
 for i:=1 to WordCount(dv,ScanSpaces-JustBlanks) do begin
  id:=Trim(ExtractWord(i,dv,ScanSpaces-JustBlanks));
  writeln('Provider '+id+' = '+SqlDbAssistant.FindProvider(id));
  writeln('ConnType '+id+' = '+SqlDbAssistant.FindConntype(id));
 end;
 sq:='select * from toc;';
 writeln(DbCon.StatementTypeToString(SqlDbAssistant.GetStatementType(sq)),' - ',
         SqlDbAssistant.GetStatementInfo(sq).TableName,' - ',sq);
 sq:='select "x" from "toc";';
 writeln(DbCon.StatementTypeToString(SqlDbAssistant.GetStatementType(sq)),' - ',
         SqlDbAssistant.GetStatementInfo(sq).TableName,' - ',sq);
 sq:='select "x" from "toc;';
 writeln(DbCon.StatementTypeToString(SqlDbAssistant.GetStatementType(sq)),' - ',
         SqlDbAssistant.GetStatementInfo(sq).TableName,' - ',sq);
 bal:=ObjectRegistry.Count-bal;
 Echo('Done '+Button4.Caption+' '+IntToStr(bal));
end;

procedure TForm1.Button5Click(Sender: TObject);
var dbc,dbr,dbe,rows,cols,i,bal,tp:Integer; fn,dv,id,cs:LongString;
begin
 bal:=ObjectRegistry.Count;
 Echo('Start '+Button5.Caption);
 cs:='Provider=IB;UID=SYSDBA;PWD=masterkey;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\sample.fdb')+';'
       +'DIALECT=3;PAGESIZE=8192;Verbose=1;';
 dbc:=db_connection(db_engine_sqldb,cs);
 if db_open(dbc,0) then begin
  dbr:=db_execute(dbc,'select * from country;',0).ref;
  writeln('GetString:'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
  db_free(dbr);
  if db_begintrans(dbc)>0 then writeln('begin trans');
  //dbr:=db_execute(dbc,'delete from country where id >= 2 and id <= 3;',0).ref;
  dbe:=db_command(dbc,'EXECUTE BLOCK AS BEGIN delete from country where id >= 2 and id <= 3; END');
  dbr:=db_execute(dbe,'',0).ref;
  if db_committrans(dbc) then writeln('commit trans');
  db_free(dbr); writeln('Errors=',db_errorsclear(dbc));
  db_close(dbc);
 end;
 db_free(dbc);
 dbc:=db_connection(db_engine_sqldb,cs);
 if db_open(dbc,0) then begin
  dbr:=db_recordset(dbc,'select * from country;');
  if db_open(dbr,0) then begin
   writeln('GetString:'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
   rows:=0; cols:=db_fieldscount(dbr); fn:='';
   for i:=0 to cols-1 do begin
    id:=db_fieldsnames(dbr,i);
    tp:=db_fieldstypes(dbr,id);
    fn:=fn+' '+id+':'+IntToStr(db_fieldstypes(dbr,id))
       +':'+db_ctrl(dbr,'FieldTypeToString='+IntToStr(tp));
   end;
   writeln('Fields: ',fn);
   writeln('Properties:',db_ctrl(dbc,'Properties'));
   if db_active(dbr) then
   while not db_eof(dbr) do begin
    dv:='';
    for i:=0 to cols-1 do begin
     id:=db_fieldsnames(dbr,i);
     dv:=dv+' '+db_fieldsasstring(dbr,id,'r','');
    end;
    AddLog(Now,dv);
    db_movenext(dbr);
    Inc(rows);
   end;
   writeln(db_ctrl(dbc,'Properties=Properties.Wanted=Defaults,Database,Details,Reset'));
   if db_begintrans(dbc)>0 then begin
    writeln(CookieScan(db_ctrl(dbc,'Properties'),'DataSource.State'));
    if db_addnew(dbr,'id=2'+EOL+'name=Belarus') then writeln('add record');
    if db_addnew(dbr,'id=3'+EOL+'name=Serbiya') then writeln('add record');
    writeln(CookieScan(db_ctrl(dbc,'Properties'),'DataSource.State'));
    if db_update(dbr) then writeln('update record');
    writeln(CookieScan(db_ctrl(dbc,'Properties'),'DataSource.State'));
    if db_committrans(dbc) then writeln('commit record ');
    writeln('state ',db_state(dbr));
   end else writeln('Fail begin transaction');
  end else writeln('Fail open recordset');
  db_free(dbr);
  dbr:=db_recordset(dbc,'select * from country;');
  if db_open(dbr,0) then begin
   writeln(CookieScan(db_ctrl(dbc,'Properties'),'DataSource.State'));
   if db_movefirst(dbr) then writeln('GetString:'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
  end else writeln('Fail open recordset');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest5.xml'),dfXml) then writeln('saved xml');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest5.csv'),dfAny) then writeln('saved csv');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest5.txt'),dfAny) then writeln('saved txt');
  db_close(dbr);
  db_close(dbc);
 end else writeln('Fail open connection');
 db_free(dbc); dbc:=0;
 bal:=ObjectRegistry.Count-bal;
 Echo('Done '+Button5.Caption+' '+IntToStr(bal));
end;

var
 TestPoll:TPolling=nil;
 RunCount:Integer=0;

procedure TestPollAct(aPolling:TPolling; var Terminate:Boolean);
var dbc,dbr:Integer; cs:LongString;
begin
 inc(RunCount);
 cs:='Provider=IB;UID=SYSDBA;PWD=masterkey;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\sample.fdb')+';'
       +'DIALECT=3;PAGESIZE=8192;Verbose=1;';
 dbc:=db_connection(db_engine_sqldb,cs);
 if db_open(dbc,0) then begin
  dbr:=db_execute(dbc,'select * from country;',0).ref;
  writeln('GetString(',RunCount,'):'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
  db_free(dbr);
  db_close(dbc);
 end;
 db_free(dbc);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
 if Assigned(TestPoll) then begin
  Kill(TestPoll);
  Echo('Done '+Button6.Caption);
 end else begin
  RunCount:=0;
  Echo('Start '+Button6.Caption);
  TestPoll:=NewPolling(TestPollAct,1000);
  TestPoll.Master:=@TestPoll;
  TestPoll.Enable(True);
 end;
end;

procedure TForm1.Button7Click(Sender: TObject);
var arg,dsn:LongString; nt:Integer;
begin
 nt:=1;
 Echo('Start '+Button7.Caption);
 // test1
 dsn:=SessionManager.VarTmpFile(Format('test%d.fdb',[nt])); inc(nt);
 arg:='Provider=LCPI.IBProvider.5.Free;User Id=SYSDBA;Password=masterkey;ctype=win1251;location=localhost:'+dsn;
 if FileErase(dsn) then writeln('Erased ',dsn);
 if db_create(arg) then writeln('Create ',arg);
 if FileExists(dsn) then writeln('Exists ',dsn);
 // test2
 dsn:=SessionManager.VarTmpFile(Format('test%d.fdb',[nt])); inc(nt);
 arg:='Engine=ADO;Provider=LCPI.IBProvider.5.Free;User Id=SYSDBA;Password=masterkey;ctype=win1251;location=localhost:'+dsn;
 if FileErase(dsn) then writeln('Erased ',dsn);
 if db_create(arg) then writeln('Create ',arg);
 if FileExists(dsn) then writeln('Exists ',dsn);
 // test3
 dsn:=SessionManager.VarTmpFile(Format('test%d.fdb',[nt])); inc(nt);
 arg:='Engine=ADO;Provider=MSDASQL;DRIVER=Firebird/InterBase(r) driver;User Id=SYSDBA;Password=masterkey;ctype=win1251;location=localhost:'+dsn;
 if FileErase(dsn) then writeln('Erased ',dsn);
 if db_create(arg) then writeln('Create ',arg);
 if FileExists(dsn) then writeln('Exists ',dsn);
 // test4
 dsn:=SessionManager.VarTmpFile(Format('test%d.db',[nt])); inc(nt);
 arg:='Engine=ADO;Provider=MSDASQL;DRIVER=SQLite3;DBNAME='+dsn;
 if FileErase(dsn) then writeln('Erased ',dsn);
 if db_create(arg) then writeln('Create ',arg);
 if FileExists(dsn) then writeln('Exists ',dsn);
 // test5
 dsn:=SessionManager.VarTmpFile(Format('test%d.fdb',[nt])); inc(nt);
 arg:='Engine=SQLDB;Provider=IB;User Id=SYSDBA;Password=masterkey;ctype=utf8;location='+dsn;
 if FileErase(dsn) then writeln('Erased ',dsn);
 if db_create(arg) then writeln('Create ',arg);
 if FileExists(dsn) then writeln('Exists ',dsn);
 // test5
 dsn:=SessionManager.VarTmpFile(Format('test%d.db',[nt])); inc(nt);
 arg:='Engine=SQLDB;Provider=SQLite3;DBNAME='+dsn;
 if FileErase(dsn) then writeln('Erased ',dsn);
 if db_create(arg) then writeln('Create ',arg);
 if FileExists(dsn) then writeln('Exists ',dsn);

 Echo('Done '+Button7.Caption);
end;

procedure TForm1.Button11Click(Sender: TObject);
var rows,cols,i:Integer; fn,dv:String;
begin
 ZConnection1.Database:=AdaptFileName('c:\opt\crwdaq\demo\demo_data\toc.db');
 ZConnection1.Protocol:='sqlite';
 ZConnection1.Connected:=true;
 ZQuery1.SQL.Text:='select * from country';
 ZQuery1.SQL.Text:='select * from toc';
 ZQuery1.Active:=true;
 rows:=0; fn:='';
 cols:=DataSourceZ.DataSet.FieldCount;
 for i:=0 to cols-1 do fn:=fn+' '+DataSourceZ.DataSet.Fields[i].FieldName;
 while not DataSourceZ.DataSet.EOF do begin
  dv:='';
  for i:=0 to cols-1 do dv:=dv+' '+DataSourceZ.DataSet.Fields[i].AsAnsiString;
  AddLog(Now,dv);
  DataSourceZ.DataSet.Next;
  Inc(rows);
 end;
 ShowMessage('DataChangeZ'+EOL
            +'Rec '+IntToStr(rows)+EOL
            +'Fld '+IntToStr(cols)+EOL
            +fn+EOL);
 ZQuery1.Active:=false;
end;

procedure TForm1.Button12Click(Sender: TObject);
var rows,cols,i:Integer; fn,dv:String;
begin
 Kill(TObject(myZs));
 myZs:=NewZeosConnecter('Provider=SQLite3;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\toc.db')+';');
 myZs.Master:=@myZs;
 if myZs.Open then begin
  myZs.Api.Query.SQL.Text:='select * from toc';
  myZs.Api.Query.Active:=true;
  rows:=0; fn:='';
  cols:=myZs.Api.DataSource.DataSet.FieldCount;
  for i:=0 to cols-1 do fn:=fn+' '+myZs.Api.DataSource.DataSet.Fields[i].FieldName;
  while not myZs.Api.DataSource.DataSet.EOF do begin
   dv:='';
   for i:=0 to cols-1 do dv:=dv+' '+myZs.Api.DataSource.DataSet.Fields[i].AsAnsiString;
   AddLog(Now,dv);
   myZs.Api.DataSource.DataSet.Next;
   Inc(rows);
  end;
  ShowMessage('DataChange2'+EOL
             +'Rows '+IntToStr(rows)+EOL
             +'Cols '+IntToStr(cols)+EOL
             +'File '+fn+EOL
             {+'Pars '+myZs.Api.Connection.Params.Text});
  myZs.Api.Query.Active:=false;
 end;
 myZs.Free;
end;

procedure TForm1.Button13Click(Sender: TObject);
var rows,cols,i:Integer; fn,dv:String; dbr:TZeosRecorder;
begin
 Echo('Start '+Button13.Caption);
 Kill(TObject(myZs));
 myZs:=NewZeosConnecter('Provider=IB;UID=SYSDBA;PWD=masterkey;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\employee.fdb')+';'
       +'DIALECT=3;PAGESIZE=8192;');
 myZs.Master:=@myZs;
 if myZs.Open then begin
  //dbr:=myZs.Execute('select * from job');
  dbr:=myZs.Execute('select * from employee');
  rows:=0; fn:='';
  cols:=dbr.FieldsCount;
  for i:=0 to cols-1 do fn:=fn+' '+dbr.FieldsNames[i]+':'+IntToStr(dbr.FieldsTypes[i]);
  if cols>0 then
  while not dbr.EOF do begin
   dv:='';
   for i:=0 to cols-1 do dv:=dv+' '+dbr.FieldsAsString[i];
   AddLog(Now,dv);
   dbr.MoveNext;
   Inc(rows);
  end;
  ShowMessage('Provider '+myZs.Provider+EOL
             +'Rows '+IntToStr(rows)+EOL
             +'Cols '+IntToStr(cols)+EOL
             +'File '+fn+EOL
             {+'Pars '+myZs.Api.Connection.Params.Text});
  dbr.Close;
 end;
 Kill(myZs);
 Echo('Done '+Button13.Caption);
end;

procedure ztest;
begin
 writeln('KnownDbApiProviderNames=',KnownDbApiProviderNames(db_engine_zeos));
 writeln('Provider ib - ',ZeosAssistant.FindProtocol('ib'));
 writeln('Provider pq - ',ZeosAssistant.FindProtocol('pq'));
 writeln('KnownZeosCodePages=',ZeosAssistant.KnownCodePages);
 writeln('KnownZeosCodePages[ib]=',ZeosAssistant.KnownCodePages('ib'));
end;

procedure TForm1.Button14Click(Sender: TObject);
var dbc,dbr,rows,cols,i,bal,tp:Integer; fn,dv,id:LongString;
begin
 bal:=ObjectRegistry.Count;
 Echo('Start '+Button14.Caption);
 dbc:=db_connection(db_engine_zeos,'Provider=IB;UID=SYSDBA;PWD=masterkey;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\employee.fdb')+';'
       +'DIALECT=3;PAGESIZE=8192;Charset=utf8;');
 if db_open(dbc,0) then begin
  dbr:=db_execute(dbc,'select * from employee',0).ref;
  rows:=0; cols:=db_fieldscount(dbr); fn:='';
  for i:=0 to cols-1 do begin
   id:=db_fieldsnames(dbr,i);
   tp:=db_fieldstypes(dbr,id);
   fn:=fn+' '+id+':'+IntToStr(db_fieldstypes(dbr,id))
      +':'+db_ctrl(dbr,'FieldTypeToString='+IntToStr(tp));
  end;
  writeln('GetString:'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
  if (db_state(dbr)>0) then
  while not db_eof(dbr) do begin
   dv:='';
   for i:=0 to cols-1 do begin
    id:=db_fieldsnames(dbr,i);
    dv:=dv+' '+db_fieldsasstring(dbr,id,'r','');
   end;
   AddLog(Now,dv);
   db_movenext(dbr);
   Inc(rows);
  end;
  db_ctrl(dbc,'Properties=Connection.SaveNullSubs=(NULL)');
  writeln('SaveNullSubs: '+db_ctrl(dbc,'Properties=Connection.SaveNullSubs'));
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest14.xml'),dfXml) then writeln('saved xml');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest14.csv'),dfAny) then writeln('saved csv');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest14.txt'),dfAny) then writeln('saved txt');
  ShowMessage('Provider '+db_ctrl(dbc,'Provider')+EOL
             +'Rows '+IntToStr(rows)+EOL
             +'Cols '+IntToStr(cols)+EOL
             +'File '+fn+EOL
             +'Pars '+db_ctrl(dbc,'Properties'));
  db_close(dbr);
  writeln('EngineId=',db_engineid(dbc));
  writeln('EngineId='+db_ctrl(dbc,'EngineId'));
  writeln('EngineName='+db_ctrl(dbc,'EngineName'));
  writeln('Properties='+db_ctrl(dbc,'Properties'));
  writeln('Properties=Connection.Database;Connection.Connected'+EOL+db_ctrl(dbc,'Properties=Connection.Database;Connection.Connected'));
 end;
 db_free(dbc); dbc:=0;
 if IsUnix then begin
  ReadUnixOdbcDriverList; ReadUnixOdbcConfigParams;
  writeln('ODBC Drivers:'+EOL+ReadUnixOdbcDriverList);
  writeln('ODBC Config:'+EOL+ReadUnixOdbcConfigParams);
 end;
 writeln('adInteger=',DbCon.StringToFieldTypeCode('adInteger'));
 writeln('ftInteger=',DbCon.StringToFieldTypeCode('ftInteger'));
 writeln('adDouble=',DbCon.StringToFieldTypeCode('adDouble'));
 writeln('ftFloat=',DbCon.StringToFieldTypeCode('ftFloat'));
 writeln('adArray=',DbCon.StringToFieldTypeCode('adArray'));
 writeln('adIntegerArray=',DbCon.StringToFieldTypeCode('adIntegerArray'));
 writeln('adAray=',DbCon.StringToFieldTypeCode('adAray'));
 writeln('PreloadedLibraries:'+EOL+Trim(SqlDbAssistant.GetConnectionListAsText));
 ZTest;
 bal:=ObjectRegistry.Count-bal;
 Echo('Done '+Button14.Caption+' '+IntToStr(bal));
end;

procedure TForm1.Button15Click(Sender: TObject);
var dbc,dbr,dbe,rows,cols,i,bal,tp:Integer; fn,dv,id,cs:LongString;
begin
 bal:=ObjectRegistry.Count;
 Echo('Start '+Button15.Caption);
 cs:='Provider=IB;UID=SYSDBA;PWD=masterkey;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\sample.fdb')+';'
       +'DIALECT=3;PAGESIZE=8192;Verbose=1;';
 dbc:=db_connection(db_engine_zeos,cs);
 if db_open(dbc,0) then begin
  dbr:=db_execute(dbc,'select * from country;',0).ref;
  writeln('GetString:'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
  db_free(dbr);
  if db_begintrans(dbc)>0 then writeln('begin trans');
  //dbr:=db_execute(dbc,'delete from country where id >= 2 and id <= 3;',0).ref;
  dbe:=db_command(dbc,'EXECUTE BLOCK AS BEGIN delete from country where id >= 2 and id <= 3; END');
  dbr:=db_execute(dbe,'',0).ref;
  if db_committrans(dbc) then writeln('commit trans');
  db_free(dbr); writeln('Errors=',db_errorsclear(dbc));
  db_close(dbc);
 end;
 db_free(dbc);
 dbc:=db_connection(db_engine_zeos,cs);
 if db_open(dbc,0) then begin
  dbr:=db_recordset(dbc,'select * from country;');
  if db_open(dbr,0) then begin
   writeln('GetString:'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
   rows:=0; cols:=db_fieldscount(dbr); fn:='';
   for i:=0 to cols-1 do begin
    id:=db_fieldsnames(dbr,i);
    tp:=db_fieldstypes(dbr,id);
    fn:=fn+' '+id+':'+IntToStr(db_fieldstypes(dbr,id))
       +':'+db_ctrl(dbr,'FieldTypeToString='+IntToStr(tp));
   end;
   writeln('Fields: ',fn);
   writeln('Properties:',db_ctrl(dbc,'Properties'));
   if db_active(dbr) then
   while not db_eof(dbr) do begin
    dv:='';
    for i:=0 to cols-1 do begin
     id:=db_fieldsnames(dbr,i);
     dv:=dv+' '+db_fieldsasstring(dbr,id,'r','');
    end;
    AddLog(Now,dv);
    db_movenext(dbr);
    Inc(rows);
   end;
   writeln(db_ctrl(dbc,'Properties=Properties.Wanted=Defaults,Database,Details,Reset'));
   if db_begintrans(dbc)>0 then begin
    writeln(CookieScan(db_ctrl(dbc,'Properties'),'DataSource.State'));
    if db_addnew(dbr,'id=2'+EOL+'name=Belarus') then writeln('add record');
    if db_addnew(dbr,'id=3'+EOL+'name=Serbiya') then writeln('add record');
    writeln(CookieScan(db_ctrl(dbc,'Properties'),'DataSource.State'));
    if db_update(dbr) then writeln('update record');
    writeln(CookieScan(db_ctrl(dbc,'Properties'),'DataSource.State'));
    if db_committrans(dbc) then writeln('commit record ');
    writeln('state ',db_state(dbr));
   end else writeln('Fail begin transaction');
  end else writeln('Fail open recordset');
  db_free(dbr);
  dbr:=db_recordset(dbc,'select * from country;');
  if db_open(dbr,0) then begin
   writeln(CookieScan(db_ctrl(dbc,'Properties'),'DataSource.State'));
   if db_movefirst(dbr) then writeln('GetString:'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
  end else writeln('Fail open recordset');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest15.xml'),dfXml) then writeln('saved xml');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest15.csv'),dfAny) then writeln('saved csv');
  if db_save(dbr,SessionManager.VarTmpFile('dbsavetest15.txt'),dfAny) then writeln('saved txt');
  db_close(dbr);
  db_close(dbc);
 end else writeln('Fail open connection');
 db_free(dbc); dbc:=0;
 bal:=ObjectRegistry.Count-bal;
 Echo('Done '+Button15.Caption+' '+IntToStr(bal));
end;

var
 TestPollz:TPolling=nil;
 RunCountz:Integer=0;

procedure TestPollActZ(aPolling:TPolling; var Terminate:Boolean);
var dbc,dbr:Integer; cs:LongString;
begin
 inc(RunCountz);
 cs:='Provider=IB;UID=SYSDBA;PWD=masterkey;'
       +'DataBase='+AdaptFileName('c:\opt\crwdaq\demo\demo_data\sample.fdb')+';'
       +'DIALECT=3;PAGESIZE=8192;Verbose=1;';
 dbc:=db_connection(db_engine_zeos,cs);
 if db_open(dbc,0) then begin
  dbr:=db_execute(dbc,'select * from country;',0).ref;
  writeln('GetString(',RunCount,'):'+EOL+db_ctrl(dbr,'GetString=8192,\t,\n,NULL'));
  db_free(dbr);
  db_close(dbc);
 end;
 db_free(dbc);
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
 if Assigned(TestPollz) then begin
  Kill(TestPollz);
  Echo('Done '+Button16.Caption);
 end else begin
  RunCount:=0;
  Echo('Start '+Button16.Caption);
  TestPollz:=NewPolling(TestPollActZ,1000);
  TestPollz.Master:=@TestPollz;
  TestPollz.Enable(True);
 end;
end;

procedure TForm1.Button17Click(Sender: TObject);
var arg,dsn:LongString; nt:Integer;
begin
 nt:=1;
 Echo('Start '+Button17.Caption);
 // test1
 dsn:=SessionManager.VarTmpFile(Format('test%d.fdb',[nt])); inc(nt);
 arg:='Engine=ZEOS;Provider=Firebird;User Id=SYSDBA;Password=masterkey;ctype=utf8;location='+dsn;
 if FileErase(dsn) then writeln('Erased ',dsn);
 if db_create(arg) then writeln('Create ',arg);
 if FileExists(dsn) then writeln('Exists ',dsn);
 // test5
 dsn:=SessionManager.VarTmpFile(Format('test%d.db',[nt])); inc(nt);
 arg:='Engine=ZEOS;Provider=SQLite3;DBNAME='+dsn;
 if FileErase(dsn) then writeln('Erased ',dsn);
 if db_create(arg) then writeln('Create ',arg);
 if FileExists(dsn) then writeln('Exists ',dsn);
 //
 Echo('Done '+Button17.Caption);
end;

procedure TForm1.ButtonTestBlobClick(Sender: TObject);
var eng,con,rst,snum,i,typ:Integer; fdb,uri,blob,fn,ex:LongString;
begin
 eng:=db_engine_sqldb; eng:=db_engine_zeos;
 fdb:=AdaptFileName('c:\opt\daqgroup\share\dbsamples\sakila.db');
 uri:='sqlite3://SYSDBA:masterkey@localhost/'+fdb+'?Charset=utf8';
 fdb:=AdaptFileName('c:\opt\daqgroup\share\dbsamples\sakila.fdb');
 uri:='firebird://SYSDBA:masterkey@localhost/'+fdb+'?Charset=utf8';
 con:=db_connection(eng,uri);
 if (con<>0) then
 try
  snum:=0;
  if db_open(con,adOpenUnspecified) then begin
   rst:=db_execute(con,'select * from staff;',0).ref;
   if db_active(rst) then
   while not db_eof(rst) do begin
    fn:=AdaptFileName(HomeDir+'/blob'+d2s(snum));
    fn:=fn+StringReplace(ExtractFileExt(fdb),'.','_',[]);
    fn:=fn+'.png';
    blob:=db_fieldsasstring(rst,'picture','r','');
    typ:=db_fieldstypes(rst,'picture');
    writeln('blob ',Length(blob),' ',DbCon.IsBlobFieldTypeCode(typ,eng),' ',
            DbCon.FieldTypeCodeToString(typ,eng),' ',fn); inc(snum);
    writeln('blob is ',DbCon.DetectBlobImageType(blob));
    if WriteBufferToFile(fn,blob)>0
    then writeln('blob',snum,' save luck '+fn)
    else writeln('blob',snum,' save fail '+fn);
    db_movenext(rst);
   end;
  end;
 finally
  db_free(con);
 end;
 ex:='bmp gif jpg pcx pgm png ppm tif xpm';
 for i:=1 to WordCount(ex,ScanSpaces) do begin
  fn:=AdaptFileName(HomeDir+'/pictures/sample.'+ExtractWord(i,ex,ScanSpaces));
  blob:=StringFromFile(fn,0);
  writeln(ExtractWord(i,ex,ScanSpaces),': detect '+DbCon.DetectBlobImageType(blob));
 end;
end;

initialization

 SetDebugLogMode(dlc_SqlDbBug,dlm_Echo);
 SetDebugLogMode(dlc_SqlDbLog,dlm_Echo);
 SetDebugLogMode(dlc_ZeosBug,dlm_Echo);
 SetDebugLogMode(dlc_ZeosLog,dlm_Echo);

end.

