summaryrefslogtreecommitdiff
path: root/packages/postgres/examples/testpg1.pp
blob: 4e85fb253fd366f5aeb010c2214f6207102c8191 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
Program testpg;

{ Demo program to test pascal connection with postgres database }
{ Translated from the testlibpq example program of PostGreSQL   }

Uses postgres,strings;


Procedure exit_nicely(Conn : PPGconn);

begin
  PQfinish(conn);
  halt(1);
end;


Var
  pghost,pgport,pgoptions,pgtty,dbname : Pchar;
  nFields,i,j : longint;
  conn : PPGConn;
  res : PPGresult;

begin
  pghost := NiL;        { host name of the backend server }
  pgport := NiL;        { port of the backend server }
  pgoptions := NiL;     { special options to start up the backend server }
  pgtty := NiL;         { debugging tty for the backend server }
  dbName := 'template1';

  { make a connection to the database }
  conn := PQsetdb(pghost, pgport, pgoptions, pgtty, dbName);

  { check to see that the backend connection was successfully made }
  if (PQstatus(conn) = CONNECTION_BAD) then
    begin
    Writeln (stderr, 'Connection to database ',dbname,' failed.');
    Writeln (stderr, PQerrorMessage(conn));
    exit_nicely(conn);
    end;


  { start a transaction block }
  res := PQexec(conn, 'BEGIN');
  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
    begin
    Writeln (stderr, 'BEGIN command failed');
    PQclear(res);
    exit_nicely(conn);
    end;

  {
   * should PQclear PGresult whenever it is no longer needed to avoid
   * memory leaks
   }
  PQclear(res);

  {
   * fetch instances from the pg_database, the system catalog of
   * databases
   }
  res := PQexec(conn, 'DECLARE myportal CURSOR FOR select * from pg_database');
  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
    begin
    Writeln (stderr, 'DECLARE CURSOR command failed');
    PQclear(res);
    exit_nicely(conn);
    end;
  PQclear(res);

  res := PQexec(conn, 'FETCH ALL in myportal');
  if (PQresultStatus(res) <> PGRES_TUPLES_OK) then
    begin
    Writeln (stderr, 'FETCH ALL command didn''t return tuples properly');
    PQclear(res);
    exit_nicely(conn);
    end;

  { first, print out the attribute names }
  nFields := PQnfields(res);
  for i := 0 to nFields-1 do
    Write (PQfname(res, i),space (15-strlen(PQfname(res, i))) );
  writeln;
  writeln;

  { next, print out the instances }
  for i := 0 to PQntuples(res)-1 do
    begin
    for j := 0 to nFields-1 do
      write(PQgetvalue(res, i, j),space (15-strlen(PQgetvalue(res, i,j))));
    writeln;
    end;

  PQclear(res);

  { close the portal }
  res := PQexec(conn, 'CLOSE myportal');
  PQclear(res);

  { end the transaction }
  res := PQexec(conn, 'END');
  PQclear(res);

  { close the connection to the database and cleanup }
  PQfinish(conn);
end.