unit mainform; {$mode objfpc}{$H+} interface uses SysUtils, Forms, Controls, Dialogs, Grids, dbconfiggui,dbconfig, {General db unit}sqldb, {For EDataBaseError}db, {Now we add all databases we want to support, otherwise their drivers won't be loaded} IBConnection,pqconnection,sqlite3conn; type { TForm1 } TForm1 = class(TForm) SalaryGrid: TStringGrid; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure SalaryGridValidateEntry(sender: TObject; aCol, aRow: Integer; const OldValue: string; var NewValue: String); private FConn: TSQLConnector; FQuery: TSQLQuery; FTran: TSQLTransaction; function ConnectionTest(ChosenConfig: TDBConnectionConfig): boolean; procedure LoadSalaryGrid; public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); var LoginForm: TDBConfigForm; begin FConn:=TSQLConnector.Create(nil); FQuery:=TSQLQuery.Create(nil); FTran:=TSQLTransaction.Create(nil); FConn.Transaction:=FTran; FQuery.DataBase:=FConn; LoginForm:=TDBConfigForm.Create(self); try // The test button on dbconfiggui will link to this procedure: LoginForm.ConnectionTestCallback:=@ConnectionTest; LoginForm.ConnectorType.Clear; //remove any default connectors // Now add the dbs that you support - use the name of the *ConnectionDef.TypeName property LoginForm.ConnectorType.AddItem('Firebird', nil); LoginForm.ConnectorType.AddItem('PostGreSQL', nil); LoginForm.ConnectorType.AddItem('SQLite3', nil); //No connectiondef object yet in FPC2.6.0 case LoginForm.ShowModal of mrOK: begin //user wants to connect, so copy over db info FConn.ConnectorType:=LoginForm.Config.DBType; FConn.HostName:=LoginForm.Config.DBHost; FConn.DatabaseName:=LoginForm.Config.DBPath; FConn.UserName:=LoginForm.Config.DBUser; FConn.Password:=LoginForm.Config.DBPassword; FConn.Transaction:=FTran; end; mrCancel: begin ShowMessage('You canceled the database login. Application will terminate.'); Close; end; end; finally LoginForm.Free; end; // Now load in our db details LoadSalaryGrid; end; procedure TForm1.FormDestroy(Sender: TObject); begin FQuery.Free; FTran.Free; FConn.Free; end; procedure TForm1.SalaryGridValidateEntry(sender: TObject; aCol, aRow: Integer; const OldValue: string; var NewValue: String); begin if (aCol=3) and ((aRow=1) or (aRow=2)) then begin // Allow updates to min and max salary if positive numerical data is entered if StrToFloatDef(NewValue,-1)>0 then begin // Storing the primary key in e.g. a hidden cell in the grid and using that in our // update query would be cleaner, but we can do it the hard way as well: FQuery.SQL.Text:='update employee set salary=:newsalary '+ ' where first_name=:firstname and last_name=:lastname and salary=:salary '; FQuery.Params.ParamByName('newsalary').AsFloat:=StrToFloatDef(NewValue,0); FQuery.Params.ParamByName('firstname').AsString:=SalaryGrid.Cells[1,aRow]; FQuery.Params.ParamByName('lastname').AsString:=SalaryGrid.Cells[2,aRow]; FQuery.Params.ParamByName('salary').AsFloat:=StrToFloatDef(OldValue,0); FTran.StartTransaction; FQuery.ExecSQL; FTran.Commit; LoadSalaryGrid; //reload standard deviation end else begin showmessage('Invalid salary entered.'); NewValue:=OldValue; end; end else begin // Discard edits to any other cells NewValue:=OldValue; end; end; function TForm1.ConnectionTest(ChosenConfig: TDBConnectionConfig): boolean; // Callback function that uses the info in dbconfiggui to test a connection // and return the result of the test to dbconfiggui var // Generic database connector... Conn: TSQLConnector; begin result:=false; Conn:=TSQLConnector.Create(nil); Screen.Cursor:=crHourglass; try // ...actual connector type is determined by this property. // Make sure the ChosenConfig.DBType string matches // the connectortype (e.g. see the string in the // T*ConnectionDef.TypeName for that connector . Conn.ConnectorType:=ChosenConfig.DBType; Conn.HostName:=ChosenConfig.DBHost; Conn.DatabaseName:=ChosenConfig.DBPath; Conn.UserName:=ChosenConfig.DBUser; Conn.Password:=ChosenConfig.DBPassword; try Conn.Open; result:=Conn.Connected; except // Result is already false end; Conn.Close; finally Screen.Cursor:=crDefault; Conn.Free; end; end; procedure TForm1.LoadSalaryGrid; var Average: double; DifferencesSquared: double=0; Count: integer=0; begin // Clean out SalaryGrid.BeginUpdate; try SalaryGrid.ColCount:=4; SalaryGrid.RowCount:=4; //Header+3 detail rows SalaryGrid.Clean; SalaryGrid.Cells[1,0]:='First name'; SalaryGrid.Cells[2,0]:='Surname'; SalaryGrid.Cells[3,0]:='Salary'; SalaryGrid.Cells[0,1]:='Min'; SalaryGrid.Cells[0,2]:='Max'; SalaryGrid.Cells[0,3]:='StdDev'; // Load from DB try if not(FConn.Connected) then FConn.Open; { // This possible query works but is slow: // a nasty query if there are lots of rows in employee // because the subqueries in the where condition are run for each employee // in the table. // We use order by to make sure the lowest salary is presented first, then // the highest. SalaryQuery.SQL.Text:='select ' + ' first_name, ' + ' last_name, ' + ' salary ' + ' from employee ' + ' where ' + ' salary=(select min(salary) from employee) or ' + ' salary=(select max(salary) from employee) ' + ' order by salary ' ; } if FConn.Connected=false then begin ShowMessage('Error connecting to the database. Aborting data loading.'); exit; end; // Lowest salary // Note: we would like to only retrieve 1 row, but unfortunately the SQL // used differs for various dbs. As we'll deal with db dependent SQL later // in the tutorial, we leave this for now. // MS SQL: 'select top 1 '... FQuery.SQL.Text:='select ' + ' e.first_name, ' + ' e.last_name, ' + ' e.salary ' + 'from employee e ' + 'order by e.salary asc '; // ISO SQL+Firebird SQL: add //'rows 1 '; here and below... won't work on e.g. PostgreSQL though FTran.StartTransaction; FQuery.Open; SalaryGrid.Cells[1,1]:=FQuery.Fields[0].AsString; SalaryGrid.Cells[2,1]:=FQuery.Fields[1].AsString; SalaryGrid.Cells[3,1]:=FQuery.Fields[2].AsString; FQuery.Close; // Always commit(retain) an opened transaction, even if only reading // this will allow updates by others to be seen when reading again FTran.Commit; // Highest salary FQuery.SQL.Text:='select ' + ' e.first_name, ' + ' e.last_name, ' + ' e.salary ' + 'from employee e ' + 'order by e.salary desc '; FTran.StartTransaction; FQuery.Open; SalaryGrid.Cells[1,2]:=FQuery.Fields[0].AsString; SalaryGrid.Cells[2,2]:=FQuery.Fields[1].AsString; SalaryGrid.Cells[3,2]:=FQuery.Fields[2].AsString; FQuery.Close; // Always commit(retain) an opened transaction, even if only reading FTran.Commit; FTran.StartTransaction; if FConn.ConnectorType='PostGreSQL' then begin // For PostgreSQL, use a native SQL solution: FQuery.SQL.Text:='select stddev_pop(salary) from employee '; FTran.StartTransaction; FQuery.Open; if not(FQuery.EOF) then SalaryGrid.Cells[3,3]:=FQuery.Fields[0].AsString; FQuery.Close; // Always commit(retain) an opened transaction, even if only reading end else begin // For other databases, use the code approach: // 1. Get average of values FQuery.SQL.Text:='select avg(salary) from employee '; FQuery.Open; if (FQuery.EOF) then SalaryGrid.Cells[3,3]:='No data' else begin Average:=FQuery.Fields[0].AsFloat; FQuery.Close; // 2. For each value, calculate the square of (value-average), and add it up FQuery.SQL.Text:='select salary from employee where salary is not null '; FQuery.Open; while not(FQuery.EOF) do begin DifferencesSquared:=DifferencesSquared+Sqr(FQuery.Fields[0].AsFloat-Average); Count:=Count+1; FQuery.Next; end; // 3. Now calculate the average "squared difference" and take the square root SalaryGrid.Cells[3,3]:=FloatToStr(Sqrt(DifferencesSquared/Count)); end; FQuery.Close; end; FTran.Commit; except on D: EDatabaseError do begin MessageDlg('Error', 'A database error has occurred. Technical error message: ' + D.Message, mtError, [mbOK], 0); end; end; finally SalaryGrid.EndUpdate; end; end; end.