PageRenderTime 11ms CodeModel.GetById 1ms app.highlight 8ms RepoModel.GetById 0ms app.codeStats 0ms

/packages/fcl-db/src/sqldb/examples/sqldbexampleunit.pp

https://github.com/slibre/freepascal
Puppet | 131 lines | 103 code | 28 blank | 0 comment | 9 complexity | b9246c85f8f6cd05eaceb6d6fb5ded8e MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1(******************************************************************************
  2 *                                                                            *
  3 *  (c) 2005 CNOC v.o.f.                                                      *
  4 *                                                                            *
  5 *  File:        SqldbExampleUnit.pp                                          *
  6 *  Author:      Joost van der Sluis (joost@cnoc.nl)                          *
  7 *  Description: This unit is used by the SQLdb examples                      *
  8 *  License:     GPL                                                          *
  9 *                                                                            *
 10 ******************************************************************************)
 11unit SqldbExampleUnit;
 12
 13{$mode objfpc}{$H+}
 14
 15interface
 16
 17uses
 18  Classes, sysutils,
 19  sqldb, pqconnection, IBConnection, ODBCConn,
 20  mysql40conn, mysql41conn, mysql50conn, oracleconnection;
 21
 22var dbtype,
 23    dbname,
 24    dbuser,
 25    dbhost,
 26    dbpassword   : string;
 27
 28    Fconnection  : tSQLConnection;
 29    Ftransaction : tSQLTransaction;
 30    Fquery       : tSQLQuery;
 31
 32const
 33 FPdevNames : Array[1..8] of string = ('Florian Klämpfl', 'Carl Eric Codère',
 34                  'Daniël Mantione', 'Jonas Maebe', 'Michael Van Canneyt',
 35                  'Peter Vreman', 'Pierre Muller', 'Marco van de Voort'
 36                 );
 37 FPdevEmails : Array[1..8] of string = ('florian@freepascal.org', 'ccodere@spamidontlike.ieee.org',
 38                  'd.s.p.mantione@twi.tudelft.nl', 'jonas@SPAM.freepascal.ME.org.NOT', 'michael@freepascal.org',
 39                  'peter@freepascal.org', 'muller@cerbere.u-strasbg.fr', 'marcov@stack.nl'
 40                 );
 41
 42var
 43 FPdevBirthDates : Array[1..8] of TDateTime;
 44
 45
 46procedure ExitWithError(s : string);
 47procedure ReadIniFile;
 48
 49procedure CreateFConnection;
 50procedure CreateFTransaction;
 51procedure CreateFQuery;
 52
 53implementation
 54
 55uses
 56  inifiles;
 57
 58procedure ExitWithError(s : string);
 59
 60begin
 61  writeln(s);
 62  writeln('Execution aborted');
 63  halt;
 64end;
 65
 66procedure ReadIniFile;
 67
 68var IniFile : TIniFile;
 69    I : integer;
 70begin
 71  IniFile := TIniFile.Create('database.ini');
 72  dbtype := IniFile.ReadString('Database','Type','');
 73  dbhost := IniFile.ReadString('Database','Host','');
 74  dbname := IniFile.ReadString('Database','Name','');
 75  dbuser := IniFile.ReadString('Database','User','');
 76  dbpassword := IniFile.ReadString('Database','Password','');
 77  IniFile.Free;
 78  
 79  For I:=1 to 8 do
 80    FPdevBirthDates[i] := EncodeDate(1990+i,i,i);
 81end;
 82
 83procedure CreateFConnection;
 84
 85begin
 86  if dbtype = 'mysql40' then Fconnection := tMySQL40Connection.Create(nil);
 87  if dbtype = 'mysql41' then Fconnection := tMySQL41Connection.Create(nil);
 88  if dbtype = 'mysql50' then Fconnection := tMySQL50Connection.Create(nil);
 89  if dbtype = 'postgresql' then Fconnection := tpqConnection.Create(nil);
 90  if dbtype = 'interbase' then Fconnection := tIBConnection.Create(nil);
 91  if dbtype = 'odbc' then Fconnection := tODBCConnection.Create(nil);
 92  if dbtype = 'oracle' then Fconnection := TOracleConnection.Create(nil);
 93
 94  if not assigned(Fconnection) then ExitWithError('Invalid database-type, check if a valid database-type was provided in the file ''database.ini''');
 95
 96  with Fconnection do
 97    begin
 98    if dbhost<>'' then
 99      Hostname:=dbhost;
100    DatabaseName := dbname;
101    UserName := dbuser;
102    Password := dbpassword;
103    open;
104    end;
105end;
106
107procedure CreateFTransaction;
108
109begin
110  Ftransaction := tsqltransaction.create(nil);
111  with Ftransaction do
112    begin
113    database := Fconnection;
114    StartTransaction;
115    end;
116end;
117
118procedure CreateFQuery;
119
120begin
121  Fquery := TSQLQuery.create(nil);
122  with Fquery do
123    begin
124    database := Fconnection;
125    transaction := Ftransaction;
126    end;
127end;
128
129
130end.
131