Le compilateur FreePascal (FPC) permet de se connecter à une base de données PostgreSQL. Ici nous allons voir un exemple d'utilisation. On procédera successivement Ã
- l'installation de FPC sous Ubuntu Gutsy Gibbon;
- la mise en place de la base de données et de la table pour le test.
- l'élaboration d'un petit programme en Pascal qui se connectera à la base de données.
1. Installationde FPC
Il faut commencer par installer le paquet bourré de binaires près à l'emploi. Ce qu'il y a de bien c'est qu'il est livré avec ce qu'il faut pour utiliser PostgreSSQL. On le télécharge à ftp://ftp.no.freepascal.org/pub/fpc/dist/i386-linux-2.2.0/fpc-2.2.0.i386-linux.tar
Ensuite
mkdir freepascal
cd freepascal
mv ../fpc-2.2.0.i386-linux.tar .
tar xvf fpc-2.2.0.i386-linux.tar
sh install.sh
En guise d'installation, on aura l'affichage suivant
david@bremko:~/freepascal$ sh install.sh
This shell script will attempt to install the Free Pascal Compiler
version 2.2.0 with the items you select
Install prefix (/usr or /usr/local) [/home/david/fpc-2.2.0] :
Installing compiler and RTL for i386-linux...
Installing utilities...
Install Textmode IDE (Y/n) ? Y
Install FCL (Y/n) ? Y
Installing fcl-base
Installing fcl-db
Installing fcl-fpcunit
Installing fcl-image
Installing fcl-net
Installing fcl-passrc
Installing fcl-registry
Installing fcl-web
Installing fcl-xml
Install packages (Y/n) ? Y
Installing a52
Installing bfd
Installing cairo
Installing cdrom
Installing dbus
Installing dts
Installing fftw
Installing forms
Installing fpgtk
Installing fpmkunit
Installing fv
Installing gconf
Installing gdbint
Installing gdbm
Installing ggi
Installing gnome
Installing graph
Installing gtk2
Installing gtk
Installing hash
Installing httpd-1
Installing httpd-2
Installing httpd-2
Installing ibase
Installing imlib
Installing ldap
Installing libasync
Installing libc
Installing libcurl
Installing libgd
Installing libpng
Installing mad
Installing modplug
Installing mysql
Installing ncurses
Installing netdb
Installing newt
Installing odbc
Installing oggvorbis
Installing openal
Installing opengl
Installing openssl
Installing oracle
Installing pasjpeg
Installing paszlib
Installing pcap
Installing postgres
Installing pthreads
Installing regexpr
Installing sqlite
Installing svgalib
Installing syslog
Installing tcl
Installing unixutil
Installing unzip
Installing utmp
Installing uuid
Installing x11
Installing zlib
Installing zvt
Done.
Install documentation (Y/n) ? Y
Installing documentation in /home/david/fpc-2.2.0/share/doc/fpc-2.2.0 ...
Done.
Install demos (Y/n) ? Y
Install demos in [/home/david/fpc-2.2.0/share/doc/fpc-2.2.0/examples] :
Installing demos in /home/david/fpc-2.2.0/share/doc/fpc-2.2.0/examples ...
Done.
Running on linux
No write premission in /etc.
Found libgcc.a in .
/home/david/fpc-2.2.0/lib/fpc/2.2.0/samplecfg: 148: fpc: not found
Writing sample configuration file to /home/david/.fpc.cfg
End of installation.
Refer to the documentation for more information.
2. Mise en place de la base de données
Ici les tests ont lieu avec PostgreSQL 8.3. On se créed'abord une petit base pour nos tests. Connectons-nous donc en tant q'utilisateur postgres
su postgres
export PATH=/usr/local/pgsql/bin:$PATH
export PGDATA=/mnt/pgdata
pg_ctl start
createdb dbblob
Créons la table qui contiendra nos données
create table testblob(numero serial,nom text,source oid)with oids;
Le but ici est d'insérer des images en base
3. Tests
On élabore donc le programme
pgimg.pas dont le contenu est
Program testpg;
Uses postgres,strings,sysutils,strutils;
Procedure usage();
begin
writeln('- permet d''importer une image en base');
writeln('- pgimg dbname=<database> img=<path_to_image>');
writeln('Exemple: pgimg dbname=mabasededonnees img=/home/toto/tata.png');
halt(1);
end;
Procedure exit_nicely(Conn : PPGconn);
begin
PQfinish(conn);
halt(1);
end;
Var
pghost,pgport,pgoptions,pgtty,dbname,img : Pchar;
nFields,i : longint;
conn : PPGConn;
res,sel : PPGresult;
dummy,stdummy : string;
begin
pghost := 'localhost';
pgport := '5432';
pgoptions := NiL;
pgtty := NiL;
if (paramcount<>2) then
begin
usage;
end;
if (paramcount=2) then
begin
dbname := 'xxx';
img := 'xxx';
if AnsiContainsStr(paramstr(1),'dbname=') then
begin
dummy:=paramstr(1)+#0;
dbname:=@dummy[8];
end;
if AnsiContainsStr(paramstr(2),'img=') then
begin
stdummy:=paramstr(2)+#0;
img:=@stdummy[5];
end;
writeln('dbname => ',dbname,' img =>' ,img);
end
else
;
{ make a connection to the database }
conn := PQsetdb(pghost, pgport, pgoptions, pgtty, dbName);
if (PQstatus(conn) = CONNECTION_BAD) then
begin
Writeln (stderr, 'Connection to database ',dbname,' failed.');
Writeln (stderr, PQerrorMessage(conn));
exit_nicely(conn);
end;
res := PQexec(conn, Pchar('INSERT INTO testblob(nom,source) VALUES ('''+ExtractFileName(img)+''',lo_import('''+img+'''));'));
if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
begin
Writeln (stderr, 'Insertion n''a pas réussie!');
PQclear(res);
exit_nicely(conn);
end;
sel := PQexec(conn,Pchar('SELECT * FROM testblob WHERE nom='''+ExtractFileName(img)+''''));
nFields := PQnfields(sel);
Writeln('|',PQfname(sel, 0),'|',PQfname(sel, 1),'|',PQfname(sel, 2),'|');
{ writeln ('+----+------------------+');}
{ next, print out the instances }
for i := 0 to PQntuples(sel)-1 do
begin
write('|',PQgetvalue(sel, i, 0),' ');
write('|',PQgetvalue(sel, i, 1),' ');
write('|',PQgetvalue(sel, i, 2),' ');
writeln ('|');
end;
PQclear(sel);
PQclear(res);
{ close the connection to the database and cleanup }
PQfinish(conn);
end.
Pour la compilation
./fpc-2.2.0/bin/fpc -Fl/usr/local/pgsql/lib/ pgimg.pas
ou si on préfère
./fpc-2.2.0/bin/fpc -Fl$(pg_config --libdir) pgimg.pas
Pour l'utilisation
PGUSER=postgres ./pgimg dbname=dbblob img=/home/david/jana/jana-experimental02-set1/JANA-EXPERIMENTAL02-SET1.JPG
Si par exemple, on a tout un répertoire contenant des images
for file in $(ls /home/david/jana/jana-experimental02-set1/*.JPG);do PGUSER=postgres ./pgimg dbname=dbblob img=${file};done
On peut vérifier que tout a bien été importé
dbblob=# select * from testblob ;
numero | nom | source
--------+---------------------------------+--------
1 | JANA-EXPERIMENTAL02-SET1-01.JPG | 24685
2 | JANA-EXPERIMENTAL02-SET1-02.JPG | 24687
3 | JANA-EXPERIMENTAL02-SET1-03.JPG | 24689
4 | JANA-EXPERIMENTAL02-SET1-04.JPG | 24691
5 | JANA-EXPERIMENTAL02-SET1-05.JPG | 24693
6 | JANA-EXPERIMENTAL02-SET1-06.JPG | 24695
7 | JANA-EXPERIMENTAL02-SET1-07.JPG | 24697
8 | JANA-EXPERIMENTAL02-SET1-08.JPG | 24699
9 | JANA-EXPERIMENTAL02-SET1-09.JPG | 24701
10 | JANA-EXPERIMENTAL02-SET1-10.JPG | 24703
11 | JANA-EXPERIMENTAL02-SET1-11.JPG | 24705
12 | JANA-EXPERIMENTAL02-SET1-12.JPG | 24707
13 | JANA-EXPERIMENTAL02-SET1-13.JPG | 24709
14 | JANA-EXPERIMENTAL02-SET1-14.JPG | 24711
15 | JANA-EXPERIMENTAL02-SET1-15.JPG | 24713
16 | JANA-EXPERIMENTAL02-SET1-16.JPG | 24715
17 | JANA-EXPERIMENTAL02-SET1.JPG | 24717
18 | JANA-EXPERIMENTAL05-SET1-01.JPG | 24719
19 | JANA-EXPERIMENTAL05-SET1-03.JPG | 24721
20 | JANA-EXPERIMENTAL05-SET1-11.JPG | 24723
21 | JANA.JPG | 24725
sauf qu'ils ont la grippe - l'hivers est en train de rentrer en ce moment à la Réunion donc chute de température...
....Alors qu'ici c'est l'été. A ce titre l'emploi du terme "cagnard" ici me fait délirer quand je l'entends vu que chez moi, celà désigne autre chose -
. Je passerais lui faire un gros calin à mon gros bibou d'amour de siamois de la folie - que je kiffe - ce soir avant de rentrer sur Juan Les Pins.
....Les images sont assez belles et on voit que c'est un fan le mec 
, 
