← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fcl/db/odbc/fpodbc.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/odbc/fpodbc.pp
1
 
unit fpodbc;
2
 
 
3
 
{$mode objfpc}
4
 
{$h+}
5
 
 
6
 
interface
7
 
 
8
 
uses odbcsql,SysUtils,Classes;
9
 
 
10
 
Type
11
 
  TDSNTypes = (dtUser,dtSystem,dtBoth);
12
 
  TODBCParamType  = (ptUnknown,ptInput,ptInputOutput,ptResult,ptOutput,ptRetVal);
13
 
  TODBCParamTypes = Set of TODBCParamType;
14
 
 
15
 
  TODBCObject = Class(TComponent)
16
 
  Private
17
 
    FHandle : SQLHandle;
18
 
    FHandleType : SQLSmallint;
19
 
    Function GetHandle : SQLHandle;
20
 
    function GetHandleAllocated: Boolean;
21
 
    function GetExtendedErrorInfo: String;
22
 
  Protected
23
 
    Function CreateHandle : SQLHandle; Virtual;
24
 
    Function ParentHandle : SQLHandle; Virtual;
25
 
    Procedure FreeHandle;
26
 
    Function CheckODBC(Res : Integer;Msg : String) : Integer;
27
 
  Public
28
 
    Destructor Destroy; override;
29
 
    Property Handle : SQLHandle Read GetHandle;
30
 
    Property HandleAllocated : Boolean Read GetHandleAllocated;
31
 
  end;
32
 
 
33
 
  TODBCEnvironment = Class(TODBCObject)
34
 
  Private
35
 
    FODBCBehaviour : Integer;
36
 
    procedure SetODBCbehaviour(const Value: Integer);
37
 
    function GetNullTerminate: Boolean;
38
 
    procedure SetNullTerminate(const Value: Boolean);
39
 
  protected
40
 
    function CreateHandle: SQLHandle; override;
41
 
    Procedure SetIntAttribute(Const Attr,Value : Integer);
42
 
    Procedure SetStringAttribute(Const Attr: Integer; Value : String);
43
 
    Function GetIntAttribute(Const Attr : Integer) : Integer;
44
 
    Function GetStringAttribute(Const Attr : Integer) : String;
45
 
  Public
46
 
    Constructor Create(Aowner : TComponent);override;
47
 
    Function GetDriverNames(List : Tstrings) : Integer;
48
 
    Function GetDataSourceNames(List : Tstrings; Types : TDSNTypes;Descriptions : Boolean) : Integer;
49
 
    function GetDriverOptions(Driver: String; Options: TStrings): Integer;
50
 
    Property ODBCBehaviour : Integer Read FODBCBehaviour Write SetODBCbehaviour;
51
 
    Property NullTerminateStrings : Boolean Read GetNullTerminate Write SetNullTerminate;
52
 
  end;
53
 
 
54
 
  TConnectionBrowseEvent = Procedure (Sender : TObject;InParams,OutParams : Tstrings) of Object;
55
 
 
56
 
  TODBCConnection = Class(TODBCObject)
57
 
  Private
58
 
    FActive : Boolean;
59
 
    FDriverParams : TStrings;
60
 
    FDSN,
61
 
    FDriverName,
62
 
    FUserName,
63
 
    FPassword : String;
64
 
    FEnvironMent : TODBCEnvironment;
65
 
    FOnBrowseConnection : TConnectionBrowseEvent;
66
 
    FWindowHandle : integer;
67
 
    FDriverCOmpletion: SQLUSmallInt;
68
 
    function GetDriverName: String;
69
 
    function GetDriverParams: TStrings;
70
 
    procedure SetActive(const Value: Boolean);
71
 
    procedure SetDriverName(const Value: String);
72
 
    procedure SetDriverParams(const Value: TStrings);
73
 
    procedure SetDSN(const Value: String);
74
 
    function GetEnvironment: TODBCEnvironMent;
75
 
    procedure SetEnvironment(const Value: TODBCEnvironMent);
76
 
  Protected
77
 
    procedure ConnectToDriver;
78
 
    procedure ConnectToDSN;
79
 
    Procedure ConnectBrowsing;
80
 
    Function ParentHandle : SQLHandle; override;
81
 
    Procedure CheckActive;
82
 
    Procedure CheckInActive;
83
 
  Public
84
 
    Constructor Create(Aowner : TComponent);override;
85
 
    Destructor Destroy; override;
86
 
    Procedure Connect;
87
 
    Procedure Disconnect;
88
 
    Procedure GetTableNames(S : TStrings; SystemTables : Boolean);
89
 
    Procedure GetFieldNames(TableName : String; S : TStrings);
90
 
    Procedure GetPrimaryKeyFields(TableName : String; S : TStrings);
91
 
    procedure GetProcedureNames(S : TStrings);
92
 
    procedure GetProcedureParams(ProcName : String;ParamTypes : TODBCParamTypes; S : TStrings);
93
 
    Property DSN : String Read FDSN Write SetDSN;
94
 
    Property DriverName : String Read GetDriverName Write SetDriverName;
95
 
    Property DriverCompletion : SQLUSmallInt Read FDriverCOmpletion Write FDriverCompletion;
96
 
    Property DriverParams : TStrings Read GetDriverParams Write SetDriverParams;
97
 
    Property Active : Boolean Read FActive Write SetActive;
98
 
    Property Environment : TODBCEnvironMent Read GetEnvironment Write SetEnvironment;
99
 
    Property UserName : String Read FUserName Write FUserName;
100
 
    Property Password  : string Read FPassword Write FPassword;
101
 
    Property OnBrowseConnection : TConnectionBrowseEvent Read FonBrowseConnection Write FOnBrowseConnection;
102
 
    Property WindowHandle : integer Read FWindowHandle Write FWindowHandle;
103
 
  end;
104
 
 
105
 
  TODBCStatement = Class;
106
 
 
107
 
  TODBCFieldList = Class(TCollection)
108
 
  Private
109
 
    FStatement : TODBCStatement;
110
 
  Public
111
 
    Constructor Create(Statement : TODBCStatement);
112
 
  end;
113
 
 
114
 
  {
115
 
    TODBCStatement allocates 1 big data buffer. For each bound field
116
 
    two things are allocated in the buffer:
117
 
    - Size of fetched data as filled in by fetch.
118
 
    - data. (may be zero for blobs etc)
119
 
    The FBuffOffset contains the offset in the buffer of the size field.
120
 
    Data immediatly follows the size.
121
 
  }
122
 
 
123
 
  TODBCField = Class(TCollectionItem)
124
 
  Private
125
 
    FDecimalDigits,
126
 
    FPosition : SQLSmallInt;
127
 
    FName : String;
128
 
    FSize : SQLUInteger;       // Declared size, as returned by DescribeCol
129
 
    FNullable : Boolean;
130
 
    FDataType : SQLSmallInt;   // Declared type, as returned by DescribeCol
131
 
    FBuffOffSet : SQLInteger;  // Offset in data buffer.
132
 
    FBuffer : Pointer;         // Pointer to data.
133
 
    FBufSize : SQLInteger;     // Allocated buffer size.
134
 
    FBufType : SQLSmallInt;    // Allocated buffer type
135
 
    function GetAsString: String;
136
 
    function GetData : PChar;
137
 
    Function GetIsNull : Boolean;
138
 
    Function GetAsInteger : Integer;
139
 
    Function GetAsBoolean : Boolean;
140
 
    Function GetAsDouble : Double;
141
 
    Function GetAsDateTime : TDateTime;
142
 
  Public
143
 
    Property Position : SQLSmallint Read FPosition;
144
 
    Property Name : String read FName;
145
 
    Property DataType : SQLSmallInt read FDatatype;
146
 
    Property Size : SQLUinteger read FSize;
147
 
    property DecimalDigits : SQLSmallInt read FDecimalDigits;
148
 
    Property Nullable : Boolean Read FNullable;
149
 
    Property Data : Pchar Read GetData;
150
 
    Property BufType : SQLSmallInt Read FBufType;
151
 
    Property BufSize : SQLInteger Read FBufSize;
152
 
    Property IsNull : Boolean Read GetIsNull;
153
 
    Property AsString : String Read GetAsString;
154
 
    Property AsInteger : Integer Read GetAsInteger;
155
 
    Property AsBoolean : Boolean Read GetAsBoolean;
156
 
    Property AsDouble : Double Read GetAsDouble;
157
 
    Property AsDateTime : TDateTime Read GetAsDateTime;
158
 
  end;
159
 
 
160
 
  TODBCStatement = Class(TODBCObject)
161
 
  Private
162
 
    FBOF,FEOF : Boolean;
163
 
    FConnection: TODBCConnection;
164
 
    FFields : TODBCFieldList;
165
 
    FBuffer : Pointer;
166
 
  Protected
167
 
    Function ParentHandle : SQLHandle; override;
168
 
    procedure SetConnection(const Value: TODBCConnection);
169
 
    procedure AllocBuffers;
170
 
  Public
171
 
    Constructor Create(Aowner : TComponent);override;
172
 
    Destructor Destroy; override;
173
 
    Procedure BindFields(RestrictList : TStrings);virtual;
174
 
    Procedure ClearFields;virtual;
175
 
    Function Fetch : Boolean;
176
 
    Property Connection : TODBCConnection Read FConnection Write SetConnection;
177
 
    Property BOF : Boolean read FBOF;
178
 
    Property EOF : Boolean read FEOF;
179
 
    Property Fields : TODBCFieldList Read FFields;
180
 
  end;
181
 
 
182
 
  TODBCTableList = Class(TODBCStatement)
183
 
  Public
184
 
    Procedure GetTableNames(S : TStrings; SystemTables : Boolean);
185
 
  end;
186
 
 
187
 
  TODBCFieldNamesList = Class(TODBCStatement)
188
 
  Public
189
 
    Procedure GetFieldNames(TableName : String;S : TStrings);
190
 
  end;
191
 
 
192
 
  TODBCPrimaryKeyFieldsList = Class(TODBCStatement)
193
 
  Public
194
 
    Procedure GetPrimaryKeyFields(TableName : String;S : TStrings);
195
 
  end;
196
 
 
197
 
  TODBCProcedureList = Class(TODBCStatement)
198
 
  Public
199
 
    Procedure GetProcedureList(S : TStrings);
200
 
  end;
201
 
 
202
 
  TODBCProcedureParams = Class(TODBCStatement)
203
 
    Procedure GetProcedureParams(ProcName: String; ParamTypes: TODBCParamTypes; S: TStrings);
204
 
  end;
205
 
 
206
 
  TStatementState = (ssInactive,ssPrepared,ssBound,ssOpen);
207
 
 
208
 
  TODBCSQLStatement = Class(TODBCStatement)
209
 
  Private
210
 
    FSQL : TStrings;
211
 
    FState : TStatementState;
212
 
    function GetActive: Boolean;
213
 
    procedure SetActive(const Value: Boolean);
214
 
  Protected
215
 
    procedure FreeStatement(Option: SQLUSMALLINT);
216
 
    procedure ExecuteDirect;
217
 
    procedure ExecutePrepared;
218
 
    Procedure SetSQL(const Value: TStrings);
219
 
  Public
220
 
    Constructor Create(Aowner : TComponent);override;
221
 
    Destructor Destroy; override;
222
 
    procedure Prepare;
223
 
    procedure Unprepare;
224
 
    Procedure BindFields(RestrictList : TStrings);override;
225
 
    procedure ExecSQL;
226
 
    Procedure Open;
227
 
    Procedure Close;
228
 
    procedure GetFieldList(List: TStrings);
229
 
    Property Active : Boolean Read GetActive Write SetActive;
230
 
    Property SQL : TStrings Read FSQL Write SetSQL;
231
 
  end;
232
 
 
233
 
  EODBCError = Class(Exception);
234
 
 
235
 
Const
236
 
  ODBCParamTypeNames : Array [TODBCParamType] of string
237
 
                     = ('Unknown','Input','Input/Output','Result','Output','RetVal');
238
 
 
239
 
Function DefaultEnvironment : TODBCEnvironment;
240
 
 
241
 
implementation
242
 
 
243
 
{ TODBCObject }
244
 
 
245
 
resourcestring
246
 
  SErrUnexpected = 'Unexpected ODBC error:';
247
 
  SErrEnvironmentHandle = 'Cannot allocate environment handle:';
248
 
  SErrInvalidBehaviour = 'Invalid value for ODBC behaviour: %d';
249
 
  SErrNotConnected = 'Operation invalid when not connected.';
250
 
  SErrConnected = 'Operation invalid when connected.';
251
 
  SNeedDSNOrDriver = 'Cannot connect with empty DSN and driver names.';
252
 
  SErrGettingDataSources = 'Error getting datasources:';
253
 
  SErrGettingDriverNames = 'Error getting driver names:';
254
 
  SErrGettingDriverOptions = 'Error getting driver options:';
255
 
  SErrSettingEnvAttribute = 'Error setting environment attribute:';
256
 
  SErrGettingEnvAttribute = 'Error Getting environment attribute:';
257
 
  SErrBrowseConnecting = 'Error connecting to datasource via browse:';
258
 
  SErrDSNConnect = 'Error connecting to DSN:';
259
 
  SErrDriverConnect = 'Error connecting to driver:';
260
 
  SErrDisconnecting = 'Error disconnecting:';
261
 
  SErrNoConnectionForStatement = 'Missing connection for statement.';
262
 
  SErrNoSQLStatement = 'Missing SQL statement.';
263
 
  SErrPreparing = 'Error preparing statement:';
264
 
  SErrGettingTableNames = 'Error getting table names:';
265
 
  SErrFetchingData = 'Error fetching data:';
266
 
  SErrFieldNames = 'Error getting field names:';
267
 
  SErrPrimaryKeys = 'Error getting primary key names:';
268
 
  SErrProcedureNames = 'Error getting procedure names:';
269
 
  SErrExecuting = 'Error while executing statement:';
270
 
  SErrExecutingPrepared = 'Error while executing prepared statement:';
271
 
  SErrNotPrepared = 'Statement is not prepared';
272
 
  SErrNotInactive = 'Statement is already prepared or executed.';
273
 
  SErrStatementActive = 'A statement is still active';
274
 
  SErrColumnCount = 'Error retrieving cilumn count:';
275
 
  SErrColDescription = 'Error retrieving column description';
276
 
  SErrInvalidConversion = 'invalid type conversion';
277
 
  SErrBindCol = 'Error binding column';
278
 
Const
279
 
  ODBCSuccess = [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO];
280
 
 
281
 
Procedure ODBCError (Msg : String);
282
 
 
283
 
begin
284
 
  Raise EODBCError.Create(Msg);
285
 
end;
286
 
 
287
 
Procedure ODBCErrorFmt (Fmt : String;Args : Array of const);
288
 
 
289
 
begin
290
 
  Raise EODBCError.CreateFmt(Fmt,Args);
291
 
end;
292
 
 
293
 
Function CheckODBC(Res : Integer;Msg : String) : Integer;
294
 
 
295
 
begin
296
 
  Result:=Res;
297
 
  if not Res in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO] then
298
 
    begin
299
 
    If MSG='' then
300
 
      MSG:=SErrUnexpected;
301
 
    ODBCErrorFmt(msg,[res]);
302
 
    end;
303
 
end;
304
 
 
305
 
function TODBCObject.CheckODBC(Res: Integer; Msg: String): Integer;
306
 
 
307
 
Var S : String;
308
 
 
309
 
begin
310
 
  Result:=Res;
311
 
  if not Res in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO] then
312
 
    begin
313
 
    If MSG='' then
314
 
      MSG:=SErrUnexpected;
315
 
    S:=GetExtendedErrorInfo;
316
 
    If S<>'' then
317
 
      Msg:=Msg+LineEnding+S;
318
 
    ODBCError(msg);
319
 
    end;
320
 
end;
321
 
 
322
 
function TODBCObject.GetExtendedErrorInfo : String;
323
 
 
324
 
Var
325
 
  Res : SQLreturn;
326
 
  I,MsgLen : SQLSmallInt;
327
 
  SQLState : Array[0..6] of Char;
328
 
  NativeError : SQLInteger;
329
 
  MSg : Array[0..SQL_MAX_MESSAGE_LENGTH] of Char;
330
 
  SState,SMsg : String;
331
 
 
332
 
begin
333
 
   I:=0;
334
 
   Result:='';
335
 
   Repeat
336
 
     Inc(i);
337
 
     Res:=SQLGetDiagRec(FhandleType, FHandle, i, SqlState, NativeError,
338
 
            Msg, sizeof(Msg), MsgLen);
339
 
     If Res<>SQL_NO_DATA then
340
 
       begin
341
 
       SState:=SQLState;
342
 
       SMsg:=Msg;
343
 
       If Length(Result)>0 then
344
 
         Result:=Result+LineEnding;
345
 
       Result:=Result+Format('[%s] : %s (%d)',[SState,SMsg,NativeError]);
346
 
       end;
347
 
   Until (Res=SQL_NO_DATA);
348
 
end;
349
 
 
350
 
 
351
 
 
352
 
 
353
 
function TODBCObject.CreateHandle: SQLHandle;
354
 
begin
355
 
{$ifdef debug}
356
 
  Writeln(Classname,': Creating handle of type ',FHAndleType,' and parent ',ParentHandle);
357
 
{$endif}
358
 
  CheckODBC(SQLAllocHandle(FHandleType,ParentHandle,FHandle),SErrEnvironmentHandle);
359
 
  Result:=FHandle;
360
 
end;
361
 
 
362
 
 
363
 
destructor TODBCObject.Destroy;
364
 
begin
365
 
  If FHandle<>0 then
366
 
    FreeHandle;
367
 
  inherited;
368
 
end;
369
 
 
370
 
procedure TODBCObject.FreeHandle;
371
 
begin
372
 
  If FHandle<>0 then
373
 
    begin
374
 
    SQLFreeHandle(FHandleType,FHandle);
375
 
    FHandle:=0;
376
 
    end;
377
 
end;
378
 
 
379
 
function TODBCObject.GetHandle: SQLHandle;
380
 
begin
381
 
  If FHandle=0 then
382
 
    CreateHandle;
383
 
  Result:=FHandle;
384
 
end;
385
 
 
386
 
function TODBCObject.GetHandleAllocated: Boolean;
387
 
begin
388
 
  Result:=(FHandle<>0)
389
 
end;
390
 
 
391
 
function TODBCObject.ParentHandle: SQLHandle;
392
 
begin
393
 
  Result:=SQL_NULL_HANDLE;
394
 
end;
395
 
 
396
 
{ TODBCEnvironment }
397
 
 
398
 
constructor TODBCEnvironment.Create(Aowner: TComponent);
399
 
begin
400
 
  FHandleType:=SQL_HANDLE_ENV;
401
 
  inherited;
402
 
end;
403
 
 
404
 
function TODBCEnvironment.CreateHandle: SQLHandle;
405
 
begin
406
 
  Result:=Inherited CreateHandle;
407
 
  ODBCbehaviour:=SQL_OV_ODBC3;
408
 
end;
409
 
 
410
 
function TODBCEnvironment.GetDataSourceNames(List: Tstrings;
411
 
  Types: TDSNTypes;Descriptions : Boolean): Integer;
412
 
 
413
 
var
414
 
  DSNName,
415
 
  DSNDesc: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
416
 
  lenn,lend : SQLSmallInt;
417
 
  Dir : SQLSmallInt;
418
 
  Sn,SD : String;
419
 
 
420
 
begin
421
 
  Case Types of
422
 
    dtSystem : Dir:=SQL_FETCH_FIRST_SYSTEM;
423
 
    dtUser : Dir:=SQL_FETCH_FIRST_USER;
424
 
    dtBoth : Dir:=SQL_FETCH_FIRST;
425
 
  end;
426
 
  List.Clear;
427
 
  CheckODBC(SQLDatasources(Handle, Dir,
428
 
                           DSNName,SQL_MAX_OPTION_STRING_LENGTH, @lenn,
429
 
                           DSNDesc,SQL_MAX_OPTION_STRING_LENGTH, @lend),SErrGettingDataSources);
430
 
  Repeat
431
 
    If Not Descriptions then
432
 
      List.Add(DSNName)
433
 
    else
434
 
      begin
435
 
      SN:=DSNName;
436
 
      SD:=DSNDesc;
437
 
      List.Add(SN+'='+SD);
438
 
      end;
439
 
  Until Not (SQLDataSources(Handle, SQL_FETCH_NEXT,
440
 
                            DSNName, SQL_MAX_OPTION_STRING_LENGTH, @lenn,
441
 
                            DSNDesc,SQL_MAX_OPTION_STRING_LENGTH, @lend) in ODBCSuccess);
442
 
  Result:=List.Count;
443
 
end;
444
 
 
445
 
function TODBCEnvironment.GetDriverNames(List : Tstrings): Integer;
446
 
 
447
 
Var
448
 
  DriverName: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
449
 
  len : SQLSmallInt;
450
 
 
451
 
begin
452
 
  List.Clear;
453
 
  CheckODBC(SQLDrivers(Handle, SQL_FETCH_FIRST, DriverName,
454
 
        SQL_MAX_OPTION_STRING_LENGTH, @len, Nil,0,Nil),SErrGettingDriverNames);
455
 
  Repeat
456
 
    List.Add(DriverName);
457
 
  Until Not (SQLDrivers(Handle, SQL_FETCH_NEXT, DriverName,
458
 
        SQL_MAX_OPTION_STRING_LENGTH, @len, Nil,0,Nil) in ODBCSuccess);
459
 
  Result:=List.Count;
460
 
end;
461
 
 
462
 
function TODBCEnvironment.GetDriverOptions(Driver : String;Options: Tstrings): Integer;
463
 
 
464
 
Var
465
 
  DriverName,
466
 
  DriverOptions: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
467
 
  lenn,leno : SQLSmallInt;
468
 
  Found : Boolean;
469
 
  P : PChar;
470
 
  S : string;
471
 
 
472
 
begin
473
 
  CheckODBC(SQLDrivers(Handle, SQL_FETCH_FIRST, DriverName,
474
 
        SQL_MAX_OPTION_STRING_LENGTH, @lenn, DriverOptions,
475
 
        SQL_MAX_OPTION_STRING_LENGTH,@Leno),SErrGettingDriverOptions);
476
 
  Result:=0;
477
 
  Options.Clear;
478
 
  Repeat
479
 
    Found:=CompareText(Driver,DriverName)=0;
480
 
    If Found then
481
 
      begin
482
 
      P:=@DriverOptions[0];
483
 
      While P[0]<>#0 do
484
 
        begin
485
 
        S:=StrPas(P);
486
 
        options.Add(S);
487
 
        Inc(P,Length(S)+1);
488
 
        end;
489
 
      end;
490
 
  Until Not (SQLDrivers(Handle, SQL_FETCH_NEXT, DriverName,
491
 
        SQL_MAX_OPTION_STRING_LENGTH, @lenn, DriverOptions,
492
 
        SQL_MAX_OPTION_STRING_LENGTH,@Leno) in ODBCSuccess) or Found;
493
 
  Result:=Options.Count;
494
 
end;
495
 
 
496
 
function TODBCEnvironment.GetIntAttribute(const Attr: Integer): Integer;
497
 
begin
498
 
  CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(@result),0),SErrSettingEnvAttribute);
499
 
end;
500
 
 
501
 
function TODBCEnvironment.GetNullTerminate: Boolean;
502
 
begin
503
 
  Result:=(GetIntAttribute(SQL_ATTR_OUTPUT_NTS)=SQL_TRUE);
504
 
end;
505
 
 
506
 
function TODBCEnvironment.GetStringAttribute(const Attr: Integer): String;
507
 
 
508
 
Var
509
 
  OldLen,Len: Integer;
510
 
 
511
 
begin
512
 
  OldLen:=0;
513
 
  Repeat
514
 
    Inc(OldLen,255);
515
 
    SetLength(Result,OldLen);
516
 
    CheckODBC(SQLGetEnvAttr(Handle,Attr,SQLPointer(@result),OldLen,@Len),SErrGettingEnvAttribute);
517
 
  until (Len<=OldLen);
518
 
  SetLength(Result,Len);
519
 
end;
520
 
 
521
 
procedure TODBCEnvironment.SetIntAttribute(const Attr, Value: Integer);
522
 
begin
523
 
  CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(Value),0),SErrSettingEnvAttribute);
524
 
end;
525
 
 
526
 
procedure TODBCEnvironment.SetNullTerminate(const Value: Boolean);
527
 
begin
528
 
  If Value then
529
 
    SetIntAttribute(SQL_ATTR_OUTPUT_NTS,SQL_TRUE)
530
 
  else
531
 
    SetIntAttribute(SQL_ATTR_OUTPUT_NTS,SQL_FALSE);
532
 
end;
533
 
 
534
 
procedure TODBCEnvironment.SetODBCbehaviour(const Value: Integer);
535
 
begin
536
 
  If (Value<>FODBCBehaviour) then
537
 
    begin
538
 
    If Not (Value in [SQL_OV_ODBC3,SQL_OV_ODBC2]) Then
539
 
      ODBCErrorFmt(SErrInvalidBehaviour,[Value]);
540
 
    SetIntAttribute(SQL_ATTR_ODBC_VERSION,Value);
541
 
    FODBCBehaviour := Value;
542
 
    end;
543
 
end;
544
 
 
545
 
procedure TODBCEnvironment.SetStringAttribute(const Attr: Integer;
546
 
  Value: String);
547
 
begin
548
 
  CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(Value),Length(Value)),SErrSettingEnvAttribute);
549
 
end;
550
 
 
551
 
{ TODBCConnection }
552
 
 
553
 
procedure TODBCConnection.CheckActive;
554
 
begin
555
 
  If Not FActive then
556
 
    ODBCError(SErrNotConnected);
557
 
end;
558
 
 
559
 
procedure TODBCConnection.CheckInActive;
560
 
begin
561
 
  If FActive then
562
 
    ODBCError(SErrConnected);
563
 
end;
564
 
 
565
 
procedure TODBCConnection.Connect;
566
 
begin
567
 
  If Not FActive then
568
 
    begin
569
 
    If Assigned (FonBrowseConnection) then
570
 
      ConnectBrowsing
571
 
    else If (FDSN<>'') then
572
 
      ConnectToDSN
573
 
    else if FDriverName<>'' then
574
 
      ConnectToDriver
575
 
    else
576
 
      ODBCError(SNeedDSNOrDriver);
577
 
    FActive:=True;
578
 
    end;
579
 
end;
580
 
 
581
 
Function ListToBuf(List : Tstrings; Buf : PChar; Sep : Char; MaxLen : Integer) : Boolean;
582
 
 
583
 
Var
584
 
  P : PChar;
585
 
  S : String;
586
 
  I,Len : Integer;
587
 
 
588
 
begin
589
 
  P:=Buf;
590
 
  I:=0;
591
 
  Result:=True;
592
 
  While Result and (I<List.Count) do
593
 
    begin
594
 
    S:=List[i];
595
 
    If I<List.Count-1 then
596
 
      S:=S+Sep;
597
 
    Len:=Length(S);
598
 
    Result:=(Longint(P-Buf)+Len)<=MaxLen;
599
 
    If Result then
600
 
      begin
601
 
      Move(S[1],P^,Len);
602
 
      Inc(P,Len);
603
 
      end;
604
 
    Inc(i);
605
 
    end;
606
 
  P[0]:=#0;
607
 
end;
608
 
 
609
 
Function BufToList(Buf : PChar;MaxLen : Integer;List : Tstrings;Sep : Char) : Integer;
610
 
 
611
 
Var
612
 
  S : String;
613
 
  P : PChar;
614
 
  Totlen,Len : Integer;
615
 
 
616
 
begin
617
 
  List.Clear;
618
 
  Result:=0;
619
 
  P:=Buf;
620
 
  TotLen:=0;
621
 
  While (P[0]<>#0) or (totlen<Maxlen) do
622
 
    begin
623
 
    Len:=0;
624
 
    While Not (P[len] in [Sep,#0]) do
625
 
      Inc(len);
626
 
    SetLength(S,Len);
627
 
    List.Add(S);
628
 
    Move(P[0],S[1],Len);
629
 
    Inc(P,Len);
630
 
    If P[0]<>#0 then
631
 
      Inc(P,1);
632
 
    inc(Totlen,Len+1);
633
 
    end;
634
 
  Result:=List.Count;
635
 
end;
636
 
 
637
 
 
638
 
Procedure TODBCConnection.ConnectBrowsing;
639
 
 
640
 
Var
641
 
  Inlist,OutList : TStringList;
642
 
  InStr,
643
 
  OutStr: Array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
644
 
  i,Res : Integer;
645
 
  olen : SQLSmallint;
646
 
 
647
 
begin
648
 
  InList:=TStringList.Create;
649
 
  OutList:=TstringList.Create;
650
 
  try
651
 
    If FDSN<>'' then
652
 
      InList.Add('DSN='+FDSN)
653
 
    else If FDriverName<>'' then
654
 
      begin
655
 
      Inlist.Add('DRIVER='+FDriverName);
656
 
      For I:=0 to DriverParams.Count-1 do
657
 
        Inlist.Add(DriverParams[i]);
658
 
      end;
659
 
    Repeat
660
 
      ListToBuf(Inlist,Instr,';',SQL_MAX_OPTION_STRING_LENGTH);
661
 
      Res:=SQLBrowseConnect(Handle,Instr,SQL_NTS,Outstr,SQL_MAX_OPTION_STRING_LENGTH,Olen);
662
 
      If RES=SQL_NEED_DATA then
663
 
        begin
664
 
        OutList.Clear;
665
 
        BufToList(OutStr,Olen,OutList,';');
666
 
        FOnBrowseConnection(Self,InList,OutList);
667
 
        end
668
 
    Until (Res<>SQL_NEED_DATA);
669
 
    CheckODBC(Res,SErrBrowseConnecting);
670
 
  Finally
671
 
    Outlist.free;
672
 
    InList.Free;
673
 
  end;
674
 
end;
675
 
 
676
 
Procedure TODBCConnection.ConnectToDSN;
677
 
begin
678
 
  CheckODBC(SQLConnect(Handle,PSQLChar(FDSN),SQL_NTS,
679
 
                    PSQLChar(FUserName),SQL_NTS,
680
 
                    PSQLChar(FPassword),SQL_NTS),SErrDSNConnect);
681
 
end;
682
 
 
683
 
 
684
 
Procedure TODBCConnection.ConnectToDriver;
685
 
 
686
 
Var
687
 
  Instr,
688
 
  OutStr :  Array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
689
 
  OLen : SQLSmallint;
690
 
  InList : TStringList;
691
 
 
692
 
begin
693
 
  InList:=TStringList.Create;
694
 
  Try
695
 
    Inlist.Assign(DriverParams);
696
 
    Inlist.Insert(0,'DRIVER={'+DRIVERNAME+'}');
697
 
    ListToBuf(Inlist,InStr,';',SQL_MAX_OPTION_STRING_LENGTH);
698
 
  Finally
699
 
    Inlist.Free;
700
 
  end;
701
 
  CheckODBC(SQLDriverConnect(Handle,FWindowHandle,
702
 
               Instr,SQL_NTS,
703
 
               OutStr,SQL_MAX_OPTION_STRING_LENGTH,
704
 
               Olen,FDriverCompletion),SErrDriverConnect);
705
 
end;
706
 
 
707
 
constructor TODBCConnection.Create(Aowner: TComponent);
708
 
begin
709
 
  inherited;
710
 
  FHandleType:=SQL_HANDLE_DBC;
711
 
  FDriverParams:=TStringList.Create;
712
 
  FDriverCompletion:=SQL_DRIVER_NOPROMPT;
713
 
end;
714
 
 
715
 
destructor TODBCConnection.Destroy;
716
 
begin
717
 
  Disconnect;
718
 
  inherited;
719
 
end;
720
 
 
721
 
procedure TODBCConnection.Disconnect;
722
 
begin
723
 
  If FActive then
724
 
    begin
725
 
    CheckODBC(SQLDisconnect(Handle),SErrDisconnecting);
726
 
    Factive:=False;
727
 
    end;
728
 
end;
729
 
 
730
 
function TODBCConnection.GetDriverName: String;
731
 
begin
732
 
  Result:=FDriverName;
733
 
end;
734
 
 
735
 
function TODBCConnection.GetDriverParams: TStrings;
736
 
begin
737
 
  Result:=FDriverParams;
738
 
end;
739
 
 
740
 
function TODBCConnection.GetEnvironment: TODBCEnvironMent;
741
 
begin
742
 
  If FEnvironment=Nil then
743
 
    result:=DefaultEnvironment
744
 
  else
745
 
    Result:=FEnvironment;
746
 
end;
747
 
 
748
 
procedure TODBCConnection.SetActive(const Value: Boolean);
749
 
begin
750
 
  If Value then
751
 
    Connect
752
 
  else
753
 
    Disconnect;
754
 
end;
755
 
 
756
 
procedure TODBCConnection.SetDriverName(const Value: String);
757
 
begin
758
 
  CheckInactive;
759
 
  FDSN:='';
760
 
  If CompareText(FDriverName,Value)<>0 then
761
 
    begin
762
 
    FDriverName:=Value;
763
 
    FDriverParams.Clear;
764
 
    end;
765
 
end;
766
 
 
767
 
procedure TODBCConnection.SetDriverParams(const Value: TStrings);
768
 
begin
769
 
  CheckInactive;
770
 
  FDriverParams.Assign(Value);
771
 
end;
772
 
 
773
 
procedure TODBCConnection.SetDSN(const Value: String);
774
 
begin
775
 
  CheckInactive;
776
 
  FDSN := Value;
777
 
end;
778
 
 
779
 
procedure TODBCConnection.SetEnvironment(const Value: TODBCEnvironMent);
780
 
begin
781
 
  CheckInactive;
782
 
  If (Value<>Environment) then // !! may be defaultenvironment...
783
 
    begin
784
 
    If HandleAllocated then
785
 
      FreeHandle;
786
 
    FEnvironment:=Value
787
 
    end;
788
 
end;
789
 
 
790
 
 
791
 
function TODBCConnection.ParentHandle: SQLHandle;
792
 
begin
793
 
  Result:=Environment.Handle
794
 
end;
795
 
 
796
 
Const
797
 
  DefEnv : Pointer = Nil;
798
 
 
799
 
Function DefaultEnvironment : TODBCEnvironment;
800
 
 
801
 
begin
802
 
  If DefEnv=Nil then
803
 
    DefEnv:=TODBCEnvironment.Create(Nil);
804
 
  Result:=TODBCEnvironment(DefEnv);
805
 
end;
806
 
 
807
 
procedure TODBCConnection.GetTableNames(S: TStrings;
808
 
  SystemTables: Boolean);
809
 
begin
810
 
  With TODBCTableList.Create(Self) do
811
 
    try
812
 
      GetTableNames(S,SystemTables);
813
 
    finally
814
 
      Free;
815
 
    end;
816
 
end;
817
 
 
818
 
procedure TODBCConnection.GetFieldNames(TableName: String; S: TStrings);
819
 
begin
820
 
  With TODBCFieldNamesList.Create(Self) do
821
 
    try
822
 
      GetFieldNames(TableName,S);
823
 
    finally
824
 
      Free;
825
 
    end;
826
 
end;
827
 
 
828
 
procedure TODBCConnection.GetPrimaryKeyFields(TableName: String;
829
 
  S: TStrings);
830
 
begin
831
 
  With TODBCPrimaryKeyFieldsList.Create(Self) do
832
 
    try
833
 
      GetPrimaryKeyFields(TableName,S);
834
 
    finally
835
 
      Free;
836
 
    end;
837
 
end;
838
 
 
839
 
procedure TODBCConnection.GetProcedureNames(S: TStrings);
840
 
begin
841
 
  With TODBCProcedureList.Create(Self) do
842
 
    try
843
 
      GetProcedureList(S);
844
 
    Finally
845
 
      Free;
846
 
    end;
847
 
end;
848
 
 
849
 
procedure TODBCConnection.GetProcedureParams(ProcName: String;
850
 
  ParamTypes: TODBCParamTypes; S: TStrings);
851
 
begin
852
 
  With TODBCProcedureParams.Create(Self) do
853
 
    Try
854
 
      GetProcedureParams(ProcName,Paramtypes,S);
855
 
    finally
856
 
      Free;
857
 
    end;
858
 
end;
859
 
 
860
 
{ TODBCStatement }
861
 
 
862
 
Type
863
 
  TODBCFieldBufRec = Record
864
 
    T{ype}    : SQlSmallint;
865
 
    B{ufsize} : SQLInteger;
866
 
    {Buftyp}e : SQLSmallint;
867
 
  end;
868
 
 
869
 
Const
870
 
  BufDescrCount = 26;
871
 
  BufDescr : Array[1..BufDescrCount] of TODBCFieldBufRec =
872
 
  { Type                Bufsize              Buftype }
873
 
  (
874
 
  (T:SQL_CHAR          ;b:-1                  ;e: SQL_CHAR),
875
 
  (T:SQL_NUMERIC       ;b:sizeof(SQLDouble)   ;e: SQL_DOUBLE),
876
 
  (T:SQL_DECIMAL       ;b:sizeof(SQLDouble)   ;e: SQL_DOUBLE),
877
 
  (T:SQL_INTEGER       ;b:sizeof(SQLInteger)  ;e: SQL_INTEGER),
878
 
  (T:SQL_SMALLINT      ;b:sizeof(SQLSmallInt) ;e: SQL_SMALLINT),
879
 
  (T:SQL_FLOAT         ;b:sizeof(SQLDOUBLE)   ;e: SQL_DOUBLE),
880
 
  (T:SQL_REAL          ;b:sizeof(SQLDOUBLE)   ;e: SQL_DOUBLE),
881
 
  (T:SQL_DOUBLE        ;b:Sizeof(SQLDOUBLE)   ;e: SQL_DOUBLE),
882
 
  (T:SQL_DATE          ;b:Sizeof(SQL_DATE_STRUCT) ;e: SQL_DATE),
883
 
  (T:SQL_TIME          ;b:sizeof(SQL_TIME_STRUCT) ;e: SQL_TIME),
884
 
  (T:SQL_TIMESTAMP     ;b:sizeof(SQL_TIMESTAMP_STRUCT) ;e: SQL_TIMESTAMP),
885
 
  (T:SQL_VARCHAR       ;b:-1                  ;e: SQL_CHAR),
886
 
  (T:SQL_UNKNOWN_TYPE  ;b:0                   ;e: SQL_UNKNOWN_TYPE),
887
 
  (T:SQL_LONGVARCHAR   ;b:-1                  ;e: SQL_CHAR),
888
 
  (T:SQL_BINARY        ;b:-2                  ;e: SQL_BINARY),
889
 
  (T:SQL_VARBINARY     ;b:-2                  ;e: SQL_BINARY),
890
 
  (T:SQL_LONGVARBINARY ;b:-2                  ;e: SQL_BINARY),
891
 
  (T:SQL_BIGINT        ;b:sizeOf(SQLDOUBLE)   ;e: SQL_DOUBLE),
892
 
  (T:SQL_TINYINT       ;b:Sizeof(SQLSMALLINT) ;e: SQL_SMALLINT),
893
 
  (T:SQL_BIT           ;b:sizeof(SQL_CHAR)    ;e: SQL_BIT),
894
 
  (T:SQL_WCHAR         ;b:-1                  ;e: SQL_CHAR),
895
 
  (T:SQL_WVARCHAR      ;b:-1                  ;e: SQL_CHAR),
896
 
  (T:SQL_WLONGVARCHAR  ;b:-1                  ;e: SQL_CHAR),
897
 
  (T:SQL_TYPE_DATE     ;b:sizeof(SQL_DATE_STRUCT) ;e: SQL_TYPE_DATE),
898
 
  (T:SQL_TYPE_TIME     ;b:sizeof(SQL_TIME_STRUCT) ;e: SQL_TYPE_TIME),
899
 
  (T:SQL_TYPE_TIMESTAMP;b:sizeof(SQL_TIMESTAMP_STRUCT) ;e: SQL_TYPE_TIMESTAMP)
900
 
  );
901
 
{  // template
902
 
  (T: ;b: ;e: ),
903
 
}
904
 
 
905
 
Function GetColSizeBufType (Coltype: SQLSmallint;
906
 
                             Var BufSize : SQLInteger;
907
 
                             Var BufType : SQLSmallInt) : Boolean;
908
 
Var
909
 
  I : Integer;
910
 
 
911
 
begin
912
 
  I:=0;
913
 
  BufSize:=0;
914
 
  BufType:=0;
915
 
  While (I<=BufDescrCount) and (BufDescr[i].t<>Coltype) do
916
 
    Inc(i);
917
 
  Result:=(i<=BufDescrCount);
918
 
  If Result then
919
 
    begin
920
 
    BufSize:=BufDescr[i].b;
921
 
    BufType:=BufDescr[i].e;
922
 
    end;
923
 
end;
924
 
 
925
 
 
926
 
procedure TODBCStatement.BindFields(RestrictList : TStrings);
927
 
 
928
 
Var
929
 
  Count: SQLSmallInt;
930
 
  CName : Array[0..SQL_NAME_LEN] of Char;
931
 
  CSize : SQLUINTEGER;
932
 
  CDataType,CDecimals,CNullable,CNameLen: SQLSmallInt;
933
 
  I : integer;
934
 
 
935
 
begin
936
 
  CheckODBC(SQLNumResultCols(Handle,Count),SErrColumnCount);
937
 
  For I:=1 to Count do
938
 
    begin
939
 
    CheckODBC(SQLDescribeCol(Handle,i,CName,SQL_NAME_LEN,CNameLen,
940
 
                             CdataType,CSize, CDecimals,CNullable)
941
 
              ,SErrColDescription);
942
 
    If Not Assigned(RestrictList) or (RestrictList.IndexOf(Cname)<>-1) then
943
 
      With FFields.Add as TODBCField do
944
 
        begin
945
 
        FPosition:=I;
946
 
        FName:=Cname;
947
 
        FDataType:=CDataType;
948
 
        FSize:=CSize;
949
 
        FDecimalDigits:=CDecimals;
950
 
        FNullable:=(CNullable=SQL_TRUE);
951
 
        GetColsizeBufType(FDataType,FBufSize,FBufType);
952
 
        If FBufSize=-1 then
953
 
          FBufSize:=FSize;
954
 
        end;
955
 
    end;
956
 
  AllocBuffers;
957
 
  For I:=0 to Count-1 do
958
 
    With FFields.Items[i] as TODBCField do
959
 
      CheckODBC(SQLBindCol(Handle,FPosition,FBufType,GetData,FBufSize,FBuffer+FBuffOffset)
960
 
               ,SErrBindCol);
961
 
 
962
 
end;
963
 
 
964
 
procedure TODBCStatement.ClearFields;
965
 
begin
966
 
  FFields.Clear;
967
 
end;
968
 
 
969
 
constructor TODBCStatement.Create(Aowner: TComponent);
970
 
begin
971
 
  FHandleType:=SQL_HANDLE_STMT;
972
 
  inherited;
973
 
  If AOwner is TODBCConnection then
974
 
    Connection:=TODBCConnection(Aowner);
975
 
  FFields:=TODBCFieldList.Create(Self);
976
 
end;
977
 
 
978
 
function TODBCStatement.ParentHandle: SQLHandle;
979
 
begin
980
 
   If (Connection=Nil) then
981
 
     ODBCError(SErrNoConnectionForStatement);
982
 
   Result:=Connection.Handle;
983
 
end;
984
 
 
985
 
procedure TODBCStatement.SetConnection(const Value: TODBCConnection);
986
 
begin
987
 
  If Value<>FConnection then
988
 
    begin
989
 
    If HandleAllocated then
990
 
      FreeHandle;
991
 
    FConnection := Value;
992
 
    end;
993
 
end;
994
 
 
995
 
Function TODBCStatement.fetch : Boolean;
996
 
 
997
 
Var
998
 
  res : SQLReturn;
999
 
 
1000
 
begin
1001
 
  Res:=SQLFetch(Handle);
1002
 
  Result:=(Res=SQL_SUCCESS);
1003
 
  If Not Result and (Res<>SQL_NO_DATA) then
1004
 
    CheckODBC(Res,SErrFetchingData);
1005
 
  FBof:=False;
1006
 
  If (Res=SQL_NO_DATA) then
1007
 
    FEOF:=True;
1008
 
end;
1009
 
 
1010
 
destructor TODBCStatement.Destroy;
1011
 
begin
1012
 
  FFields.Free;
1013
 
  inherited;
1014
 
end;
1015
 
 
1016
 
{ TODBCSQLStatement }
1017
 
 
1018
 
procedure TODBCSQLStatement.GetFieldList(List : TStrings);
1019
 
 
1020
 
Var
1021
 
  Count: SQLSmallInt;
1022
 
  CName : Array[0..SQL_NAME_LEN] of Char;
1023
 
  CSize : SQLUINTEGER;
1024
 
  CDataType,CDecimals,CNullable,CNameLen: SQLSmallInt;
1025
 
  I : integer;
1026
 
 
1027
 
begin
1028
 
  if Not (FState in [ssPrepared,ssBound,ssOpen]) then
1029
 
    ODBCError(SErrNotPrepared);
1030
 
  List.Clear;
1031
 
  CheckODBC(SQLNumResultCols(Handle,Count),SErrColumnCount);
1032
 
  For I:=1 to Count do
1033
 
    begin
1034
 
    CheckODBC(SQLDescribeCol(Handle,i,CName,SQL_NAME_LEN,CNameLen,
1035
 
                             CdataType,CSize, CDecimals,CNullable)
1036
 
              ,SErrColDescription);
1037
 
    List.Add(CName);
1038
 
    end;
1039
 
end;
1040
 
 
1041
 
 
1042
 
procedure TODBCSQLStatement.Unprepare;
1043
 
 
1044
 
begin
1045
 
  Case FState of
1046
 
    ssBound,ssOpen :
1047
 
              begin
1048
 
              ClearFields;
1049
 
              FreeStatement(SQL_CLOSE);
1050
 
              end;
1051
 
    ssPrepared : begin
1052
 
                 FreeStatement(SQL_CLOSE);
1053
 
                 end;
1054
 
  end;
1055
 
  FState:=ssInactive;
1056
 
end;
1057
 
 
1058
 
procedure TODBCSQLStatement.FreeStatement(Option : SQLUSMALLINT);
1059
 
 
1060
 
begin
1061
 
  SQLFreeStmt(Handle,SQL_CLOSE);
1062
 
end;
1063
 
 
1064
 
procedure TODBCSQLStatement.Close;
1065
 
begin
1066
 
  if FState<>ssInactive then
1067
 
    begin
1068
 
    Unprepare;
1069
 
    FreeStatement(SQL_CLOSE);
1070
 
    FState:=ssInactive;
1071
 
    end;
1072
 
end;
1073
 
 
1074
 
constructor TODBCSQLStatement.Create(Aowner: TComponent);
1075
 
begin
1076
 
  inherited;
1077
 
  FSQL:=TStringList.Create;
1078
 
end;
1079
 
 
1080
 
destructor TODBCSQLStatement.Destroy;
1081
 
begin
1082
 
  if FState=ssOpen then
1083
 
    Close
1084
 
  else If FState<>ssInactive then
1085
 
    Unprepare;
1086
 
  FSQL.Free;
1087
 
  inherited;
1088
 
end;
1089
 
 
1090
 
procedure TODBCSQLStatement.ExecSQL;
1091
 
begin
1092
 
  Case FState of
1093
 
    ssPrepared,ssBound : ExecutePrepared;
1094
 
    ssInactive : ExecuteDirect;
1095
 
  else
1096
 
    Raise Exception.Create(SErrStatementActive)
1097
 
  end;
1098
 
end;
1099
 
 
1100
 
procedure TODBCSQLStatement.ExecuteDirect;
1101
 
 
1102
 
Var
1103
 
  S : String;
1104
 
 
1105
 
begin
1106
 
  if FState<>ssInactive then
1107
 
    ODBCError(SErrStatementActive);
1108
 
  S:=SQL.Text;
1109
 
  CheckODBC(SQLExecDirect(Handle,PChar(S),SQL_NTS),SErrExecuting);
1110
 
end;
1111
 
 
1112
 
procedure TODBCSQLStatement.ExecutePrepared;
1113
 
begin
1114
 
  if Not (FState in [ssPrepared,ssBound]) then
1115
 
    ODBCError(SErrNotPrepared);
1116
 
  CheckODBC(SQLExecute(Handle),SErrExecutingPrepared);
1117
 
end;
1118
 
 
1119
 
function TODBCSQLStatement.GetActive: Boolean;
1120
 
begin
1121
 
  Result:=(FState=ssOpen);
1122
 
end;
1123
 
 
1124
 
procedure TODBCSQLStatement.Open;
1125
 
begin
1126
 
  if (FState<>ssOpen) then
1127
 
    begin
1128
 
    Writeln('Preparing');
1129
 
    If FState=ssInactive then
1130
 
      Prepare;
1131
 
    Writeln('Bind fields');
1132
 
    if FState=ssPrepared then
1133
 
      BindFields(Nil);
1134
 
    Writeln('Executing');
1135
 
    ExecSQL;
1136
 
    Writeln('Fetching');
1137
 
    If FState=ssBound then
1138
 
      Fetch;
1139
 
    FState:=ssOpen;
1140
 
    FBOF:=True;
1141
 
    end;
1142
 
end;
1143
 
 
1144
 
procedure TODBCSQLStatement.Prepare;
1145
 
 
1146
 
Var
1147
 
  S : String;
1148
 
 
1149
 
begin
1150
 
  If FState<>ssInactive then
1151
 
    ODBCError(SErrNotInactive);
1152
 
  If (FSQL.Count=0) then
1153
 
    ODBCError(SErrNoSQLStatement);
1154
 
  S:=FSQL.Text;
1155
 
  CheckODBC(SQLPrepare(Handle,PChar(S),SQL_NTS),SErrPreparing);
1156
 
  FState:=ssPrepared;
1157
 
end;
1158
 
 
1159
 
procedure TODBCSQLStatement.SetActive(const Value: Boolean);
1160
 
begin
1161
 
  If Value then
1162
 
    Open
1163
 
  else
1164
 
    Close;
1165
 
end;
1166
 
 
1167
 
procedure TODBCSQLStatement.SetSQL(const Value: TStrings);
1168
 
 
1169
 
begin
1170
 
  FSQL.Assign(Value);
1171
 
end;
1172
 
 
1173
 
 
1174
 
procedure TODBCSQLStatement.BindFields(RestrictList: TStrings);
1175
 
begin
1176
 
  inherited;
1177
 
  FState:=ssBound;
1178
 
end;
1179
 
 
1180
 
 
1181
 
procedure TODBCStatement.AllocBuffers;
1182
 
 
1183
 
Var
1184
 
  I,TotalSize,AddSize : Integer;
1185
 
 
1186
 
begin
1187
 
  TotalSize:=0;
1188
 
  For i:=0 to FFields.Count-1 do
1189
 
    With (FFields.Items[i] as TODBCField) do
1190
 
        begin
1191
 
        AddSize:=FBufSize;
1192
 
        If FBufSize=-2 then // Blob.
1193
 
          AddSize:=0
1194
 
        else if FBufSize=-1 then
1195
 
          AddSize:=FSize+1; // some Char variant.
1196
 
        // Store offset temporarily in FData
1197
 
        FBuffOffset:=TotalSize;
1198
 
        Inc(TotalSize,AddSize+SizeOf(SQLinteger));
1199
 
        end;
1200
 
  FBuffer:=GetMem(TotalSize);
1201
 
  TotalSize:=0;
1202
 
  For i:=0 to FFields.Count-1 do
1203
 
    With (FFields.Items[i] as TODBCField) do
1204
 
      FBuffer:=Self.FBuffer;
1205
 
end;
1206
 
 
1207
 
{ TODBCTableList }
1208
 
 
1209
 
procedure TODBCTableList.GetTableNames(S: TStrings; SystemTables : Boolean);
1210
 
 
1211
 
var
1212
 
  TName,
1213
 
  TType: array[0..SQL_NAME_LEN+1] of char;
1214
 
  NL,TL: SQLINTEGER;
1215
 
  Res: SQLRETURN;
1216
 
 
1217
 
begin
1218
 
  S.Clear;
1219
 
  Res:=CheckODBC(SQLTables(handle, nil,0,nil,0,nil,0,nil,0),SErrGettingTableNames);
1220
 
  if Res=SQL_SUCCESS then
1221
 
    begin
1222
 
    // Must bind by colno, because names changed between ODBC 2.0 and 3.0 !!
1223
 
    SQLBindCol(handle,3,SQL_CHAR,@TName,SQL_NAME_LEN,@NL);
1224
 
    SQLBindCol(handle,4,SQL_CHAR,@TType,SQL_NAME_LEN,@TL);
1225
 
    While Fetch do
1226
 
      if SystemTables or (CompareText(TType,'SYSTEM TABLE')<>0) then
1227
 
         S.Add(TName);
1228
 
    end;
1229
 
end;
1230
 
 
1231
 
{ TODBCFieldNamesList }
1232
 
 
1233
 
procedure TODBCFieldNamesList.GetFieldNames(TableName: String;
1234
 
  S: TStrings);
1235
 
 
1236
 
var
1237
 
  FName : array[0..SQL_NAME_LEN+1] of char;
1238
 
  NF : SQLINTEGER;
1239
 
  Res: SQLRETURN;
1240
 
 
1241
 
begin
1242
 
  S.Clear;
1243
 
  Res:=CheckODBC(SQLColumns(handle, nil, 0, nil, 0, pchar(TableName), SQL_NTS, nil, 0),SErrFieldNames);
1244
 
  if Res=SQL_SUCCESS then
1245
 
    begin
1246
 
    SQLBindCol(handle, 4, SQL_CHAR, @FNAme, SQL_NAME_LEN, @NF);
1247
 
    While Fetch do
1248
 
       S.Add(FName);
1249
 
    end;
1250
 
end;
1251
 
 
1252
 
{ TODBCPrimaryKeyFieldsList }
1253
 
 
1254
 
procedure TODBCPrimaryKeyFieldsList.GetPrimaryKeyFields(TableName: String;
1255
 
  S: TStrings);
1256
 
var
1257
 
  FName : array[0..SQL_NAME_LEN+1] of char;
1258
 
  NF : SQLINTEGER;
1259
 
  Res: SQLRETURN;
1260
 
 
1261
 
begin
1262
 
  S.Clear;
1263
 
  Res:=CheckODBC(SQLPrimaryKeys(handle, nil, 0, nil, 0, pchar(TableName), SQL_NTS),SErrPrimaryKeys);
1264
 
  if Res=SQL_SUCCESS then
1265
 
    begin
1266
 
    SQLBindCol(handle, 4, SQL_CHAR, @FNAme, SQL_NAME_LEN, @NF);
1267
 
    While Fetch do
1268
 
       S.Add(FName);
1269
 
    end;
1270
 
 
1271
 
end;
1272
 
 
1273
 
{ TODBCProcedureList }
1274
 
 
1275
 
procedure TODBCProcedureList.GetProcedureList(S: TStrings);
1276
 
 
1277
 
var
1278
 
  PName : array[0..SQL_NAME_LEN+1] of char;
1279
 
  NP : SQLINTEGER;
1280
 
  Res: SQLRETURN;
1281
 
 
1282
 
begin
1283
 
  S.Clear;
1284
 
  Res:=CheckODBC(SQLProcedures(handle, nil, 0, nil, 0, Nil, 0),SErrProcedureNames);
1285
 
  if Res=SQL_SUCCESS then
1286
 
    begin
1287
 
    SQLBindCol(handle, 3, SQL_CHAR, @PNAme, SQL_NAME_LEN, @NP);
1288
 
    While Fetch do
1289
 
      S.Add(PName);
1290
 
    end;
1291
 
 
1292
 
end;
1293
 
 
1294
 
{ TODBCProcedureParams }
1295
 
 
1296
 
procedure TODBCProcedureParams.GetProcedureParams(ProcName: String;
1297
 
  ParamTypes: TODBCParamTypes; S: TStrings);
1298
 
 
1299
 
var
1300
 
  PName : array[0..SQL_NAME_LEN+1] of char;
1301
 
  NP,NT : SQLINTEGER;
1302
 
  Ptype : SQLSmallInt;
1303
 
  Res: SQLRETURN;
1304
 
 
1305
 
begin
1306
 
  S.Clear;
1307
 
  Res:=CheckODBC(SQLProcedureColumns(handle, nil, 0, nil, 0, PChar(ProcName),SQL_NTS,Nil, 0),SErrProcedureNames);
1308
 
  if Res=SQL_SUCCESS then
1309
 
    begin
1310
 
    SQLBindCol(handle, 4, SQL_CHAR, @PName, SQL_NAME_LEN, @NP);
1311
 
    SQLBindCol(handle, 5, SQL_SMALLINT, @PType, SizeOf(SQLSmallInt), @NT);
1312
 
    While Fetch do
1313
 
      begin
1314
 
      If TODBCParamType(PType) in ParamTypes then
1315
 
        S.Add(PName);
1316
 
      end;
1317
 
    end;
1318
 
end;
1319
 
 
1320
 
{ TODBCFieldList }
1321
 
 
1322
 
constructor TODBCFieldList.Create(Statement: TODBCStatement);
1323
 
begin
1324
 
  FStatement:=Statement;
1325
 
  Inherited Create(TODBCField);
1326
 
end;
1327
 
 
1328
 
{ TODBCField }
1329
 
 
1330
 
function TODBCField.GetAsString: String;
1331
 
begin
1332
 
  If IsNull then
1333
 
    Result:=''
1334
 
  else
1335
 
    Case FBufType of
1336
 
      SQL_Smallint : Result:=IntToStr(PSQLSmallInt(Data)^);
1337
 
      SQL_Integer  : Result:=IntToStr(PSQLINTEGER(Data)^);
1338
 
      SQL_BIT      : Result:=IntToStr(PByte(Data)^);
1339
 
      SQL_CHAR     : Result:=StrPas(Data);
1340
 
      SQL_DOUBLE   : Result:=FloatToStr(GetAsDouble);
1341
 
      SQL_DATE     : result:=DateToStr(AsDateTime);
1342
 
      SQL_TIME     : Result:=TimeToStr(AsDateTime);
1343
 
      SQL_TIMESTAMP : result:=datetimeToStr(AsDateTime);
1344
 
      SQL_TYPE_DATE  : result:=dateToStr(AsDateTime);
1345
 
      SQL_TYPE_TIMESTAMP : result:=datetimeToStr(AsDateTime);
1346
 
      SQL_TYPE_TIME : Result:=TimeToStr(AsDateTime);
1347
 
    else
1348
 
      ODBCError(SErrInvalidConversion)
1349
 
    end;
1350
 
end;
1351
 
 
1352
 
function TODBCField.GetData : Pchar;
1353
 
 
1354
 
begin
1355
 
  Result:=FBuffer+FBuffOffset+SizeOf(SQLinteger);
1356
 
end;
1357
 
 
1358
 
function TODBCField.GetIsNull : boolean;
1359
 
 
1360
 
begin
1361
 
  Result:=PSQLinteger(FBuffer+FBuffOffset)^=SQL_NULL_DATA;
1362
 
end;
1363
 
 
1364
 
Function TODBCField.GetAsInteger : Integer;
1365
 
 
1366
 
begin
1367
 
  If IsNull then
1368
 
    Result:=0
1369
 
  else
1370
 
    Case FBufType of
1371
 
      SQL_Smallint : Result:=PSQLSmallInt(Data)^;
1372
 
      SQL_Integer  : Result:=PSQLINTEGER(Data)^;
1373
 
      SQL_BIT      : Result:=PByte(Data)^;
1374
 
      SQL_CHAR     : Result:=StrToInt(GetAsString);
1375
 
      SQL_DOUBLE   : Result:=Round(GetAsDouble);
1376
 
      SQL_DATE,
1377
 
      SQL_TIME,
1378
 
      SQL_TIMESTAMP,
1379
 
      SQL_TYPE_DATE,
1380
 
      SQL_TYPE_TIMESTAMP,
1381
 
      SQL_TYPE_TIME : Result:=Round(AsDateTime);
1382
 
    else
1383
 
      ODBCError(SErrInvalidConversion)
1384
 
    end;
1385
 
end;
1386
 
 
1387
 
Function TODBCField.GetAsBoolean : Boolean;
1388
 
 
1389
 
begin
1390
 
  If IsNull then
1391
 
    Result:=False
1392
 
  else
1393
 
    Case FBufType of
1394
 
      SQL_Smallint : Result:=PSQLSmallInt(Data)^=0;
1395
 
      SQL_Integer  : Result:=PSQLINTEGER(Data)^=0;
1396
 
      SQL_BIT      : Result:=PBYTE(Data)^=0;
1397
 
      SQL_CHAR     : Result:=(StrToInt(GetAsString)=0);
1398
 
      SQL_DOUBLE   : Result:=Round(GetAsDouble)=0;
1399
 
      SQL_DATE,
1400
 
      SQL_TIME,
1401
 
      SQL_TIMESTAMP,
1402
 
      SQL_TYPE_DATE,
1403
 
      SQL_TYPE_TIMESTAMP,
1404
 
      SQL_TYPE_TIME : Result:=Round(AsDateTime)=0;
1405
 
    else
1406
 
      ODBCError(SErrInvalidConversion)
1407
 
    end;
1408
 
end;
1409
 
 
1410
 
Function TODBCField.GetAsDouble : Double;
1411
 
 
1412
 
begin
1413
 
  If IsNull then
1414
 
    Result:=0
1415
 
  else
1416
 
    Case FBufType of
1417
 
      SQL_Smallint : Result:=PSQLSmallInt(Data)^;
1418
 
      SQL_Integer  : Result:=PSQLINTEGER(Data)^;
1419
 
      SQL_BIT      : Result:=PBYTE(Data)^;
1420
 
      SQL_CHAR     : Result:=StrToFloat(GetAsString);
1421
 
      SQL_DOUBLE   : Result:=PSQLDOUBLE(GetData)^;
1422
 
      SQL_DATE,
1423
 
      SQL_TIME,
1424
 
      SQL_TIMESTAMP,
1425
 
      SQL_TYPE_DATE,
1426
 
      SQL_TYPE_TIMESTAMP,
1427
 
      SQL_TYPE_TIME : Result:=AsDateTime;
1428
 
    else
1429
 
      ODBCError(SErrInvalidConversion)
1430
 
    end;
1431
 
end;
1432
 
 
1433
 
{
1434
 
function DateStructToDateTime( b:PSQL_DATE_STRUCT):TDateTime;
1435
 
function DateTimeToDateStruct( b:TDateTime):SQL_DATE_STRUCT;
1436
 
procedure DateTime2TimeStampStruct( var Value:SQL_TIMESTAMP_STRUCT; b:TDateTime);
1437
 
}
1438
 
Function TODBCField.GetAsDateTime : TDateTime;
1439
 
 
1440
 
begin
1441
 
  If IsNull then
1442
 
    Result:=0
1443
 
  else
1444
 
    Case FBufType of
1445
 
      SQL_Smallint : Result:=PSQLSmallInt(Data)^;
1446
 
      SQL_Integer  : Result:=PSQLINTEGER(Data)^;
1447
 
      SQL_BIT      : Result:=PBYTE(Data)^;
1448
 
      SQL_CHAR     : Result:=StrToInt(GetAsString);
1449
 
      SQL_DOUBLE   : Result:=PSQLDOUBLE(GetData)^;
1450
 
      SQL_DATE     : Result:=DateStructToDateTime(PSQL_DATE_STRUCT(Data));
1451
 
      SQL_TIME     : Result:=TimeStructToDateTime(PSQL_TIME_STRUCT(Data));
1452
 
      SQL_TIMESTAMP : Result:=TimeStampStructToDateTime(PSQL_TIMESTAMP_STRUCT(Data));
1453
 
      SQL_TYPE_DATE : Result:=DateStructToDateTime(PSQL_DATE_STRUCT(Data));
1454
 
      SQL_TYPE_TIMESTAMP :  Result:=TimeStampStructToDateTime(PSQL_TIMESTAMP_STRUCT(Data));
1455
 
      SQL_TYPE_TIME : Result:=TimeStructToDateTime(PSQL_TIME_STRUCT(Data));
1456
 
    else
1457
 
      ODBCError(SErrInvalidConversion)
1458
 
    end;
1459
 
end;
1460
 
 
1461
 
Finalization
1462
 
  If Assigned(DefEnv) then
1463
 
    TODBCEnvironment(DefEnv).Free;
1464
 
end.
1465