← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/odbc/tests/testodbc.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/odbc/tests/testodbc.pp
 
1
Program TestODBC;
 
2
 
 
3
uses odbcsql;
 
4
 
 
5
 
 
6
Const
 
7
  DBDSn : Pchar = 'FPC';
 
8
  Empty : pchar = '';
 
9
  Query : pchar = 'SELECT Id,Username,InstEmail from FPdev Order by UserName';
 
10
// Adapt to needs...
 
11
{$ifdef linux}
 
12
  UserName : pchar = 'michael';  // for mysql test.
 
13
  Password : pchar = 'geen';
 
14
{$else}
 
15
    UserName : pchar = ''; // for MS-Acces test.
 
16
    Password : pchar = '';
 
17
{$endif}
 
18
 
 
19
Function ODBCSuccess (Res : Integer) : Boolean;
 
20
 
 
21
begin
 
22
  ODBCSuccess:= (res=SQL_SUCCESS) or (res=SQL_SUCCESS_WITH_INFO);
 
23
end;
 
24
 
 
25
Var
 
26
  EnvHandle  : SQLHandle;
 
27
  DBHandle   : SQLHandle;
 
28
  StmtHandle : SQLHSTMT;
 
29
  ResID      : Longint;
 
30
  ResName    : Array[0..255] of char; // Matches length of field+1
 
31
  ResEmail   : Array[0..255] of char;
 
32
 
 
33
Procedure FreeHandles;
 
34
 
 
35
begin
 
36
  If assigned(StmtHAndle) then
 
37
    SQLFreeHandle(SQL_HANDLE_STMT,StmtHandle);
 
38
  If assigned(dbhandle) then
 
39
    SQLFreeHandle(SQL_HANDLE_DBC,DBHandle);
 
40
  If assigned(EnvHandle) then
 
41
    SQLFreeHandle(SQL_HANDLE_ENV,EnvHandle);
 
42
end;
 
43
 
 
44
Procedure DoError (Msg : String;ErrCode : Integer);
 
45
 
 
46
begin
 
47
  FreeHandles;
 
48
  Writeln(Msg,' Code : ',ErrCode);
 
49
  Halt(1);
 
50
end;
 
51
 
 
52
Procedure StartSession;
 
53
 
 
54
Var
 
55
  Res : Integer;
 
56
 
 
57
begin
 
58
  EnvHandle:=nil;
 
59
  DBHandle:=nil;
 
60
  StmtHandle:=nil;
 
61
  Res:=SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, EnvHandle);
 
62
  if Res <> SQL_SUCCESS then
 
63
    DoError('Could allocate ODBC handle',Res);
 
64
  Res:=SQLSetEnvAttr(EnvHandle,SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), 0);
 
65
  If Not ODBCSuccess(res) then
 
66
    DoError('Could not set environment',Res);
 
67
  Res:=SQLAllocHandle(SQL_HANDLE_DBC, envHandle, DBHandle);
 
68
  If res<>SQL_SUCCESS then
 
69
    DoError('Could not create database handle',res);
 
70
  Res:=SQLConnect(DBHandle,PSQLCHAR(DBDSN),SQL_NTS,
 
71
                        PSQLChar(UserName),SQL_NTS,
 
72
                        PSQLCHAR(Password),SQL_NTS);
 
73
  If Not OdbcSuccess(res) then
 
74
    DoError('Could not connect to datasource.',Res);
 
75
end;
 
76
 
 
77
Procedure ExecuteStatement;
 
78
 
 
79
Var
 
80
  Res,ErrCode : LongInt;
 
81
 
 
82
begin
 
83
  Res:=SQLAllocHandle(SQL_HANDLE_STMT,DBHandle,stmtHandle);
 
84
  If not ODBCSuccess(res) then
 
85
    DoError('Could not allocate statement handle.',Res);
 
86
  { Bind result buffers.
 
87
    Note that for many queries, the result is not known on beforehand,
 
88
    And must be queried with SQLPrepare, SQLNumResulCols and SQLDescribeCol
 
89
    before the statement is executed.}
 
90
  SQLBindCol(stmtHandle,1,SQL_INTEGER,SQLPointer(@ResID),4,@ErrCode);
 
91
  SQLBindCol(stmtHandle,2,SQL_CHAR,SQLPointer(@ResName),256,@ErrCode);
 
92
  SQLBindCol(stmtHandle,3,SQL_CHAR,SQLPointer(@ResEmail),256,@ErrCode);
 
93
  // Now actually do it.
 
94
  Res:=SQLExecDirect(StmtHandle,Query,SQL_NTS);
 
95
  if not ODBCSuccess(res) then
 
96
    DoError('Execute of statement failed.',Res);
 
97
end;
 
98
 
 
99
Procedure ShowResult;
 
100
 
 
101
Var
 
102
  Count,Res : Longint;
 
103
 
 
104
begin
 
105
  Res:=SQLFetch(StmtHandle);
 
106
  Count:=0;
 
107
  While Res<>SQL_NO_DATA do
 
108
    begin
 
109
    Inc(Count);
 
110
    Write('Record: ',Count,' : ');
 
111
    Writeln(ResId,' ',PChar(@ResName[0]),' ',Pchar(@ResEmail[0]));
 
112
    Res:=SQLFetch(StmtHandle);
 
113
    end;
 
114
end;
 
115
 
 
116
begin
 
117
  StartSession;
 
118
  ExecuteStatement;
 
119
  ShowResult;
 
120
  FreeHandles;
 
121
end.