zeoslib  UNKNOWN
 All Files
ZDbcASAResultSet.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { Interbase Database Connectivity Classes }
5 { }
6 { Originally written by Sergey Merkuriev }
7 { }
8 {*********************************************************}
9 
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
12 { }
13 { License Agreement: }
14 { }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
20 { }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
39 { }
40 { }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
45 { }
46 { http://www.sourceforge.net/projects/zeoslib. }
47 { }
48 { }
49 { Zeos Development Group. }
50 {********************************************************@}
51 
52 unit ZDbcASAResultSet;
53 
54 interface
55 
56 {$I ZDbc.inc}
57 
58 uses
59  {$IFDEF WITH_TOBJECTLIST_INLINE}System.Types, System.Contnrs{$ELSE}Types{$ENDIF},
60  Classes, {$IFDEF MSEgui}mclasses,{$ENDIF}
61  ZSysUtils, ZDbcIntfs, ZDbcResultSet, ZDbcASA, ZPlainASADriver, ZCompatibility,
62  ZDbcResultSetMetadata, ZDbcASAUtils, ZMessages, ZVariant;
63 
64 type
65 
66  {** Implements ASA ResultSet. }
67  TZASAResultSet = class(TZAbstractResultSet)
68  private
69  FCachedBlob: boolean;
70  FFetchStat: Integer;
71  FCursorName: AnsiString;
72  FStmtNum: SmallInt;
73  FSqlData: IZASASQLDA;
74  FParamsSqlData: IZASASQLDA;
75  FUpdateSqlData: IZASASQLDA;
76  FASAConnection: IZASAConnection;
77  FInsert: Boolean;
78  FUpdate: Boolean;
79  FDelete: Boolean;
80  protected
81  procedure Open; override;
82  procedure PrepareUpdateSQLData; virtual;
83  function GetFieldValue(ColumnIndex: Integer): Variant;
84  function InternalGetString(ColumnIndex: Integer): RawByteString; override;
85  public
86  constructor Create(Statement: IZStatement; SQL: string;
87  var StmtNum: SmallInt; CursorName: AnsiString;
88  SqlData: IZASASQLDA; ParamsSqlData: IZASASQLDA;
89  CachedBlob: boolean);
90 
91  function GetCursorName: AnsiString; override;
92  procedure Close; override;
93 
94  function IsNull(ColumnIndex: Integer): Boolean; override;
95  function GetBoolean(ColumnIndex: Integer): Boolean; override;
96  function GetByte(ColumnIndex: Integer): Byte; override;
97  function GetShort(ColumnIndex: Integer): SmallInt; override;
98  function GetInt(ColumnIndex: Integer): Integer; override;
99  function GetLong(ColumnIndex: Integer): Int64; override;
100  function GetFloat(ColumnIndex: Integer): Single; override;
101  function GetDouble(ColumnIndex: Integer): Double; override;
102  function GetBigDecimal(ColumnIndex: Integer): Extended; override;
103  function GetBytes(ColumnIndex: Integer): TByteDynArray; override;
104  function GetDate(ColumnIndex: Integer): TDateTime; override;
105  function GetTime(ColumnIndex: Integer): TDateTime; override;
106  function GetTimestamp(ColumnIndex: Integer): TDateTime; override;
107  function GetBlob(ColumnIndex: Integer): IZBlob; override;
108 
109  function Last: Boolean; override;
110  function MoveAbsolute(Row: Integer): Boolean; override;
111  function MoveRelative(Rows: Integer): Boolean; override;
112  function Previous: Boolean; override;
113  function Next: Boolean; override;
114 
115  function RowUpdated: Boolean; override;
116  function RowInserted: Boolean; override;
117  function RowDeleted: Boolean; override;
118 
119  procedure UpdateNull(ColumnIndex: Integer); override;
120  procedure UpdateBoolean(ColumnIndex: Integer; Value: Boolean); override;
121  procedure UpdateByte(ColumnIndex: Integer; Value: ShortInt); override;
122  procedure UpdateShort(ColumnIndex: Integer; Value: SmallInt); override;
123  procedure UpdateInt(ColumnIndex: Integer; Value: Integer); override;
124  procedure UpdateLong(ColumnIndex: Integer; Value: Int64); override;
125  procedure UpdateFloat(ColumnIndex: Integer; Value: Single); override;
126  procedure UpdateDouble(ColumnIndex: Integer; Value: Double); override;
127  procedure UpdateBigDecimal(ColumnIndex: Integer; Value: Extended); override;
128  procedure UpdatePChar(ColumnIndex: Integer; Value: PChar); override;
129  procedure UpdateString(ColumnIndex: Integer; const Value: String); override;
130  procedure UpdateUnicodeString(ColumnIndex: Integer; const Value: WideString); override;
131  procedure UpdateBytes(ColumnIndex: Integer; const Value: TByteDynArray); override;
132  procedure UpdateDate(ColumnIndex: Integer; Value: TDateTime); override;
133  procedure UpdateTime(ColumnIndex: Integer; Value: TDateTime); override;
134  procedure UpdateTimestamp(ColumnIndex: Integer; Value: TDateTime); override;
135  procedure UpdateAsciiStream(ColumnIndex: Integer; Value: TStream); override;
136  procedure UpdateUnicodeStream(ColumnIndex: Integer; Value: TStream); override;
137  procedure UpdateBinaryStream(ColumnIndex: Integer; Value: TStream); override;
138  procedure UpdateValue(ColumnIndex: Integer; const Value: TZVariant); override;
139 
140  procedure InsertRow; override;
141  procedure UpdateRow; override;
142  procedure DeleteRow; override;
143  procedure RefreshRow; override;
144  procedure CancelRowUpdates; override;
145  procedure MoveToInsertRow; override;
146  procedure MoveToCurrentRow; override;
147 
148  property SQLData: IZASASQLDA read FSQLData;
149  end;
150 
151  IZASABlob = interface(IZBlob)
152  ['{1E043426-5856-4953-88B8-F6FB276B7B61}']
153  procedure ReadBlob;
154  end;
155 
156  {** Implements external blob wrapper object for PostgreSQL. }
157  TZASABlob = class(TZAbstractBlob, IZASABlob)
158  private
159  FBlobRead: Boolean;
160  FResultSet: TZASAResultSet;
161  FColID: Integer;
162  protected
163  procedure ReadBlob;
164  public
165  constructor Create( ResultSet: TZASAResultSet; ColID: Integer);
166  constructor CreateWithStream(Stream: TStream; Connection: IZConnection);
167  constructor CreateWithData(Data: Pointer; Size: Integer; Connection: IZConnection);
168 
169  function IsEmpty: Boolean; override;
170  function Clone: IZBlob; override;
171  function GetStream: TStream; override;
172  function GetString: RawByteString; override;
173  function GetUnicodeString: WideString; override;
174  function GetBytes: TByteDynArray; override;
175  property BlobSize;
176  property BlobData;
177  end;
178 
179 implementation
180 
181 uses
182 {$IFNDEF FPC}
183  Variants,
184 {$ENDIF}
185  SysUtils, Math, ZdbcLogging, ZPlainASAConstants, ZDbcUtils, ZEncoding;
186 
187 { TZASAResultSet }
188 
189 {**
190  Constructs this object, assignes main properties and
191  opens the record set.
192  @param Statement a related SQL statement object.
193  @param handle a Interbase6 database connect handle.
194  @param the statement previously prepared
195  @param the sql out data previously allocated
196  @param the Interbase sql dialect
197 }
198 constructor TZASAResultSet.Create(Statement: IZStatement; SQL: string;
199  var StmtNum: SmallInt; CursorName: AnsiString;
200  SqlData: IZASASQLDA; ParamsSqlData: IZASASQLDA;
201  CachedBlob: boolean);
202 begin
203  inherited Create( Statement, SQL, nil,Statement.GetConnection.GetConSettings);
204 
205  FFetchStat := 0;
206  FSqlData := SqlData;
207  FCursorName := CursorName;
208  FCachedBlob := CachedBlob;
209  FASAConnection := Statement.GetConnection as IZASAConnection;
210  FDelete := False;
211  FInsert := False;
212  FUpdate := False;
213 
214  FParamsSqlData := ParamsSqlData;
215  FStmtNum := StmtNum;
216  ResultSetType := rtScrollSensitive;
217  ResultSetConcurrency := rcUpdatable;
218 
219  Open;
220 end;
221 
222 {**
223  Return field value by it index
224  @param the index column 0 first, 1 second ...
225  @return the field value as variant type
226 }
227 function TZASAResultSet.GetFieldValue(ColumnIndex: Integer): Variant;
228 begin
229  CheckClosed;
230  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
231  Result := FUpdateSqlData.GetValue( ColumnIndex - 1)
232  else
233  Result := FSqlData.GetValue( ColumnIndex - 1);
234  LastWasNull := IsNull( ColumnIndex);
235 end;
236 
237 {**
238  Gets the value of the designated column in the current row
239  of this <code>ResultSet</code> object as
240  a <code>java.sql.BigDecimal</code> in the Java programming language.
241 
242  @param columnIndex the first column is 1, the second is 2, ...
243  @param scale the number of digits to the right of the decimal point
244  @return the column value; if the value is SQL <code>NULL</code>, the
245  value returned is <code>null</code>
246 }
247 function TZASAResultSet.GetBigDecimal(ColumnIndex: Integer): Extended;
248 begin
249  CheckClosed;
250  CheckColumnConvertion(ColumnIndex, stBigDecimal);
251  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
252  Result := FUpdateSqlData.GetBigDecimal( ColumnIndex - 1)
253  else
254  Result := FSqlData.GetBigDecimal( ColumnIndex - 1);
255  LastWasNull := IsNull( ColumnIndex);
256 end;
257 
258 {**
259  Returns the value of the designated column in the current row
260  of this <code>ResultSet</code> object as a <code>Blob</code> object
261  in the Java programming language.
262 
263  @param ColumnIndex the first column is 1, the second is 2, ...
264  @return a <code>Blob</code> object representing the SQL <code>BLOB</code> value in
265  the specified column
266 }
267 function TZASAResultSet.GetBlob(ColumnIndex: Integer): IZBlob;
268 var
269  Blob: IZASABlob;
270  TempStream: TStream;
271 begin
272  Result := nil;
273  CheckClosed;
274  CheckBlobColumn(ColumnIndex);
275 
276  LastWasNull := IsNull(ColumnIndex);
277  if LastWasNull then
278  Exit;
279 
280  Blob := TZASABlob.Create( Self, ColumnIndex - 1);
281  if FCachedBlob then
282  Blob.ReadBlob;
283  if ( GetMetadata.GetColumnType(ColumnIndex) in [stUnicodeStream, stAsciiStream] ) then
284  begin
285  case GetMetaData.GetColumnType(ColumnIndex) of
286  stAsciiStream:
287  Blob.SetString(GetValidatedAnsiString(Blob.GetString, ConSettings, True));
288  else
289  begin
290  TempStream := GetValidatedUnicodeStream(Blob.GetBuffer, Blob.Length, ConSettings, True);
291  Blob.SetStream(TempStream, True);
292  TempStream.Free;
293  end;
294  end;
295  end;
296  Result := Blob;
297 end;
298 
299 {**
300  Gets the value of the designated column in the current row
301  of this <code>ResultSet</code> object as
302  a <code>boolean</code> in the Java programming language.
303 
304  @param columnIndex the first column is 1, the second is 2, ...
305  @return the column value; if the value is SQL <code>NULL</code>, the
306  value returned is <code>false</code>
307 }
308 function TZASAResultSet.GetBoolean(ColumnIndex: Integer): Boolean;
309 begin
310  CheckClosed;
311  CheckColumnConvertion(ColumnIndex, stBoolean);
312  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
313  Result := FUpdateSqlData.GetBoolean( ColumnIndex - 1)
314  else
315  Result := FSqlData.GetBoolean( ColumnIndex - 1);
316  LastWasNull := IsNull( ColumnIndex);
317 end;
318 
319 {**
320  Gets the value of the designated column in the current row
321  of this <code>ResultSet</code> object as
322  a <code>byte</code> in the Java programming language.
323 
324  @param columnIndex the first column is 1, the second is 2, ...
325  @return the column value; if the value is SQL <code>NULL</code>, the
326  value returned is <code>0</code>
327 }
328 function TZASAResultSet.GetByte(ColumnIndex: Integer): Byte;
329 begin
330  CheckClosed;
331  CheckColumnConvertion(ColumnIndex, stByte);
332  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
333  Result := FUpdateSqlData.GetByte( ColumnIndex - 1)
334  else
335  Result := FSqlData.GetByte( ColumnIndex - 1);
336  LastWasNull := IsNull( ColumnIndex);
337 end;
338 
339 {**
340  Gets the value of the designated column in the current row
341  of this <code>ResultSet</code> object as
342  a <code>byte</code> array in the Java programming language.
343  The bytes represent the raw values returned by the driver.
344 
345  @param columnIndex the first column is 1, the second is 2, ...
346  @return the column value; if the value is SQL <code>NULL</code>, the
347  value returned is <code>null</code>
348 }
349 function TZASAResultSet.GetBytes(
350  ColumnIndex: Integer): TByteDynArray;
351 begin
352  CheckClosed;
353  CheckColumnConvertion(ColumnIndex, stBytes);
354  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
355  Result := FUpdateSqlData.GetBytes( ColumnIndex - 1)
356  else
357  Result := FSqlData.GetBytes( ColumnIndex - 1);
358  LastWasNull := IsNull( ColumnIndex);
359 end;
360 
361 {**
362  Gets the value of the designated column in the current row
363  of this <code>ResultSet</code> object as
364  a <code>java.sql.Date</code> object in the Java programming language.
365 
366  @param columnIndex the first column is 1, the second is 2, ...
367  @return the column value; if the value is SQL <code>NULL</code>, the
368  value returned is <code>null</code>
369 }
370 function TZASAResultSet.GetDate(ColumnIndex: Integer): TDateTime;
371 begin
372  CheckClosed;
373  CheckColumnConvertion(ColumnIndex, stDate);
374  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
375  Result := FUpdateSqlData.GetDate( ColumnIndex - 1)
376  else
377  Result := FSqlData.GetDate( ColumnIndex - 1);
378  LastWasNull := IsNull( ColumnIndex);
379 end;
380 
381 {**
382  Gets the value of the designated column in the current row
383  of this <code>ResultSet</code> object as
384  a <code>double</code> in the Java programming language.
385 
386  @param columnIndex the first column is 1, the second is 2, ...
387  @return the column value; if the value is SQL <code>NULL</code>, the
388  value returned is <code>0</code>
389 }
390 function TZASAResultSet.GetDouble(ColumnIndex: Integer): Double;
391 begin
392  CheckClosed;
393  CheckColumnConvertion(ColumnIndex, stDouble);
394  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
395  Result := FUpdateSqlData.GetDouble( ColumnIndex - 1)
396  else
397  Result := FSqlData.GetDouble( ColumnIndex - 1);
398  LastWasNull := IsNull( ColumnIndex);
399 end;
400 
401 {**
402  Gets the value of the designated column in the current row
403  of this <code>ResultSet</code> object as
404  a <code>float</code> in the Java programming language.
405 
406  @param columnIndex the first column is 1, the second is 2, ...
407  @return the column value; if the value is SQL <code>NULL</code>, the
408  value returned is <code>0</code>
409 }
410 function TZASAResultSet.GetFloat(ColumnIndex: Integer): Single;
411 begin
412  CheckClosed;
413  CheckColumnConvertion(ColumnIndex, stFloat);
414  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
415  Result := FUpdateSqlData.GetFloat( ColumnIndex - 1)
416  else
417  Result := FSqlData.GetFloat( ColumnIndex - 1);
418  LastWasNull := IsNull( ColumnIndex);
419 end;
420 
421 {**
422  Gets the value of the designated column in the current row
423  of this <code>ResultSet</code> object as
424  an <code>int</code> in the Java programming language.
425 
426  @param columnIndex the first column is 1, the second is 2, ...
427  @return the column value; if the value is SQL <code>NULL</code>, the
428  value returned is <code>0</code>
429 }
430 function TZASAResultSet.GetInt(ColumnIndex: Integer): Integer;
431 begin
432  CheckClosed;
433  CheckColumnConvertion(ColumnIndex, stInteger);
434  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
435  Result := FUpdateSqlData.GetInt( ColumnIndex - 1)
436  else
437  Result := FSqlData.GetInt( ColumnIndex - 1);
438  LastWasNull := IsNull( ColumnIndex);
439 end;
440 
441 {**
442  Gets the value of the designated column in the current row
443  of this <code>ResultSet</code> object as
444  a <code>long</code> in the Java programming language.
445 
446  @param columnIndex the first column is 1, the second is 2, ...
447  @return the column value; if the value is SQL <code>NULL</code>, the
448  value returned is <code>0</code>
449 }
450 function TZASAResultSet.GetLong(ColumnIndex: Integer): Int64;
451 begin
452  CheckClosed;
453  CheckColumnConvertion(ColumnIndex, stLong);
454  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
455  Result := FUpdateSqlData.GetLong( ColumnIndex - 1)
456  else
457  Result := FSqlData.GetLong( ColumnIndex - 1);
458  LastWasNull := IsNull( ColumnIndex);
459 end;
460 
461 {**
462  Gets the value of the designated column in the current row
463  of this <code>ResultSet</code> object as
464  a <code>short</code> in the Java programming language.
465 
466  @param columnIndex the first column is 1, the second is 2, ...
467  @return the column value; if the value is SQL <code>NULL</code>, the
468  value returned is <code>0</code>
469 }
470 function TZASAResultSet.GetShort(ColumnIndex: Integer): SmallInt;
471 begin
472  CheckClosed;
473  CheckColumnConvertion(ColumnIndex, stShort);
474  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
475  Result := FUpdateSqlData.GetShort( ColumnIndex - 1)
476  else
477  Result := FSqlData.GetShort( ColumnIndex - 1);
478  LastWasNull := IsNull( ColumnIndex);
479 end;
480 
481 {**
482  Gets the value of the designated column in the current row
483  of this <code>ResultSet</code> object as
484  a <code>String</code> in the Java programming language.
485 
486  @param columnIndex the first column is 1, the second is 2, ...
487  @return the column value; if the value is SQL <code>NULL</code>, the
488  value returned is <code>null</code>
489 }
490 function TZASAResultSet.InternalGetString(ColumnIndex: Integer): RawByteString;
491 begin
492  CheckClosed;
493  CheckColumnConvertion( ColumnIndex, stString);
494  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
495  Result := FUpdateSqlData.GetString( ColumnIndex - 1)
496  else
497  Result := FSqlData.GetString( ColumnIndex - 1);
498  LastWasNull := IsNull( ColumnIndex);
499 end;
500 
501 {**
502  Gets the value of the designated column in the current row
503  of this <code>ResultSet</code> object as
504  a <code>java.sql.Time</code> object in the Java programming language.
505 
506  @param columnIndex the first column is 1, the second is 2, ...
507  @return the column value; if the value is SQL <code>NULL</code>, the
508  value returned is <code>null</code>
509 }
510 function TZASAResultSet.GetTime(ColumnIndex: Integer): TDateTime;
511 begin
512  CheckClosed;
513  CheckColumnConvertion(ColumnIndex, stTime);
514  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
515  Result := FUpdateSqlData.GetTime( ColumnIndex - 1)
516  else
517  Result := FSqlData.GetTime( ColumnIndex - 1);
518  LastWasNull := IsNull( ColumnIndex);
519 end;
520 
521 {**
522  Gets the value of the designated column in the current row
523  of this <code>ResultSet</code> object as
524  a <code>java.sql.Timestamp</code> object in the Java programming language.
525 
526  @param columnIndex the first column is 1, the second is 2, ...
527  @return the column value; if the value is SQL <code>NULL</code>, the
528  value returned is <code>null</code>
529  @exception SQLException if a database access error occurs
530 }
531 function TZASAResultSet.GetTimestamp(ColumnIndex: Integer): TDateTime;
532 begin
533  CheckClosed;
534  CheckColumnConvertion(ColumnIndex, stTimestamp);
535  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
536  Result := FUpdateSqlData.GetTimestamp( ColumnIndex - 1)
537  else
538  Result := FSqlData.GetTimestamp( ColumnIndex - 1);
539  LastWasNull := IsNull( ColumnIndex);
540 end;
541 
542 {**
543  Indicates if the value of the designated column in the current row
544  of this <code>ResultSet</code> object is Null.
545 
546  @param columnIndex the first column is 1, the second is 2, ...
547  @return if the value is SQL <code>NULL</code>, the
548  value returned is <code>true</code>. <code>false</code> otherwise.
549 }
550 function TZASAResultSet.IsNull(ColumnIndex: Integer): Boolean;
551 begin
552  CheckClosed;
553  if FInsert or ( FUpdate and FUpdateSQLData.IsAssigned( ColumnIndex - 1)) then
554  Result := FUpdateSqlData.IsNull( ColumnIndex - 1)
555  else
556  Result := FSqlData.IsNull(ColumnIndex - 1);
557 end;
558 
559 function TZASAResultSet.Last: Boolean;
560 begin
561  if LastRowNo <> MaxInt then
562  Result := MoveAbsolute( LastRowNo)
563  else
564  Result := MoveAbsolute( -1);
565 end;
566 
567 {**
568  Moves the cursor to the given row number in
569  this <code>ResultSet</code> object.
570 
571  <p>If the row number is positive, the cursor moves to
572  the given row number with respect to the
573  beginning of the result set. The first row is row 1, the second
574  is row 2, and so on.
575 
576  <p>If the given row number is negative, the cursor moves to
577  an absolute row position with respect to
578  the end of the result set. For example, calling the method
579  <code>absolute(-1)</code> positions the
580  cursor on the last row; calling the method <code>absolute(-2)</code>
581  moves the cursor to the next-to-last row, and so on.
582 
583  <p>An attempt to position the cursor beyond the first/last row in
584  the result set leaves the cursor before the first row or after
585  the last row.
586 
587  <p><B>Note:</B> Calling <code>absolute(1)</code> is the same
588  as calling <code>first()</code>. Calling <code>absolute(-1)</code>
589  is the same as calling <code>last()</code>.
590 
591  @return <code>true</code> if the cursor is on the result set;
592  <code>false</code> otherwise
593 }
594 function TZASAResultSet.MoveAbsolute(Row: Integer): Boolean;
595 begin
596  Result := False;
597  if (MaxRows > 0) and (Row >= MaxRows) then
598  Exit;
599 
600  FASAConnection.GetPlainDriver.db_fetch( FASAConnection.GetDBHandle,
601  PAnsiChar(FCursorName), CUR_ABSOLUTE, Row, FSqlData.GetData, BlockSize, CUR_FORREGULAR);
602  ZDbcASAUtils.CheckASAError( FASAConnection.GetPlainDriver,
603  FASAConnection.GetDBHandle, lcOther);
604 
605  if FASAConnection.GetDBHandle.sqlCode <> SQLE_NOTFOUND then
606  begin
607  RowNo := Row;
608  Result := True;
609  FFetchStat := 0;
610  FDelete := False;
611  FInsert := False;
612  FUpdate := False;
613  end
614  else
615  begin
616  FFetchStat := FASAConnection.GetDBHandle.sqlerrd[2];
617  if FFetchStat > 0 then
618  LastRowNo := Max( Row - FFetchStat, 0);
619  end;
620 end;
621 
622 function TZASAResultSet.MoveRelative(Rows: Integer): Boolean;
623 begin
624  Result := False;
625  if (RowNo > LastRowNo) or ((MaxRows > 0) and (RowNo >= MaxRows)) then
626  Exit;
627  FASAConnection.GetPlainDriver.db_fetch( FASAConnection.GetDBHandle,
628  PAnsiChar( FCursorName), CUR_RELATIVE, Rows, FSqlData.GetData, BlockSize, CUR_FORREGULAR);
629  ZDbcASAUtils.CheckASAError( FASAConnection.GetPlainDriver,
630  FASAConnection.GetDBHandle, lcOther, '', SQLE_CURSOR_NOT_OPEN); //handle a known null resultset issue (cursor not open)
631  if FASAConnection.GetDBHandle.sqlCode = SQLE_CURSOR_NOT_OPEN then Exit;
632  if FASAConnection.GetDBHandle.sqlCode <> SQLE_NOTFOUND then
633  begin
634  if ( RowNo > 0) or ( RowNo + Rows < 0) then
635  RowNo := RowNo + Rows;
636  Result := True;
637  FFetchStat := 0;
638  FDelete := False;
639  FInsert := False;
640  FUpdate := False;
641  end
642  else
643  begin
644  FFetchStat := FASAConnection.GetDBHandle.sqlerrd[2];
645  if ( FFetchStat > 0) and ( RowNo > 0) then
646  LastRowNo := Max( RowNo + Rows - FFetchStat, 0);
647  end;
648 end;
649 
650 function TZASAResultSet.Previous: Boolean;
651 begin
652  Result := MoveRelative( -1);
653 end;
654 
655 {**
656  Moves the cursor down one row from its current position.
657  A <code>ResultSet</code> cursor is initially positioned
658  before the first row; the first call to the method
659  <code>next</code> makes the first row the current row; the
660  second call makes the second row the current row, and so on.
661 
662  <P>If an input stream is open for the current row, a call
663  to the method <code>next</code> will
664  implicitly close it. A <code>ResultSet</code> object's
665  warning chain is cleared when a new row is read.
666 
667  @return <code>true</code> if the new current row is valid;
668  <code>false</code> if there are no more rows
669 }
670 function TZASAResultSet.Next: Boolean;
671 begin
672  Result := MoveRelative( 1);
673 end;
674 
675 {**
676  Opens this recordset.
677 }
678 procedure TZASAResultSet.Open;
679 var
680  i: Integer;
681  FieldSqlType: TZSQLType;
682  ColumnInfo: TZColumnInfo;
683 begin
684  if FStmtNum = 0 then
685  raise EZSQLException.Create(SCanNotRetrieveResultSetData);
686 
687  ColumnsInfo.Clear;
688  for i := 0 to FSqlData.GetFieldCount - 1 do
689  begin
690  ColumnInfo := TZColumnInfo.Create;
691  with ColumnInfo, FSqlData do
692  begin
693  FieldSqlType := GetFieldSqlType(I);
694  ColumnName := GetFieldName(I);
695 // TableName := GetFieldRelationName(I);
696  ColumnLabel := ColumnName;
697  ColumnType := FieldSqlType;
698 
699  case FieldSqlType of
700  stString,
701  stUnicodeString: Precision := GetFieldSize(FieldSqlType, ConSettings,
702  GetFieldLength(I)-4, ConSettings.ClientCodePage.CharWidth, @ColumnDisplaySize, True);
703  end;
704 
705  ReadOnly := False;
706 
707  if IsNullable(I) then
708  Nullable := ntNullable
709  else
710  Nullable := ntNoNulls;
711  Nullable := ntNullable;
712 
713  Scale := GetFieldScale(I);
714  AutoIncrement := False;
715  //Signed := False;
716  CaseSensitive := False;
717  end;
718  ColumnsInfo.Add(ColumnInfo);
719  end;
720  LastRowNo := MaxInt;
721  inherited Open;
722 end;
723 
724 procedure TZASAResultSet.Close;
725 begin
726  FSqlData := nil;
727  FParamsSqlData := nil;
728  FUpdateSqlData := nil;
729  if FCursorName <> '' then
730  begin
731  FASAConnection.GetPlainDriver.db_close(FASAConnection.GetDBHandle, PAnsiChar(FCursorName));
732  FCursorName := '';
733  end;
734  inherited Close;
735 end;
736 
737 function TZASAResultSet.GetCursorName: AnsiString;
738 begin
739  Result := FCursorName;
740 end;
741 
742 function TZASAResultSet.RowUpdated: Boolean;
743 begin
744  Result := FUpdate;
745 end;
746 
747 function TZASAResultSet.RowInserted: Boolean;
748 begin
749  Result := FInsert;
750 end;
751 
752 function TZASAResultSet.RowDeleted: Boolean;
753 begin
754  Result := FDelete;
755 end;
756 
757 procedure TZASAResultSet.PrepareUpdateSQLData;
758 begin
759  FUpdate := not FInsert;
760  if not Assigned( FUpdateSQLData) then
761  begin
762  FUpdateSQLData := TZASASQLDA.Create( FASAConnection.GetPlainDriver,
763  FASAConnection.GetDBHandle, FCursorName, ConSettings, FSQLData.GetFieldCount);
764  end
765  else if FUpdateSQLData.GetFieldCount = 0 then
766  FUpdateSQLData.AllocateSQLDA( FSQLData.GetFieldCount);
767 end;
768 
769 procedure TZASAResultSet.UpdateNull(ColumnIndex: Integer);
770 begin
771  PrepareUpdateSQLData;
772  FUpdateSqlData.UpdateNull( ColumnIndex, True);
773 end;
774 
775 procedure TZASAResultSet.UpdateBoolean(ColumnIndex: Integer; Value: Boolean);
776 begin
777  PrepareUpdateSQLData;
778  FUpdateSqlData.UpdateBoolean( ColumnIndex, Value);
779 end;
780 
781 procedure TZASAResultSet.UpdateByte(ColumnIndex: Integer; Value: ShortInt);
782 begin
783  PrepareUpdateSQLData;
784  FUpdateSqlData.UpdateByte( ColumnIndex, Value);
785 end;
786 
787 procedure TZASAResultSet.UpdateShort(ColumnIndex: Integer; Value: SmallInt);
788 begin
789  PrepareUpdateSQLData;
790  FUpdateSqlData.UpdateShort( ColumnIndex, Value);
791 end;
792 
793 procedure TZASAResultSet.UpdateInt(ColumnIndex: Integer; Value: Integer);
794 begin
795  PrepareUpdateSQLData;
796  FUpdateSqlData.UpdateInt( ColumnIndex, Value);
797 end;
798 
799 procedure TZASAResultSet.UpdateLong(ColumnIndex: Integer; Value: Int64);
800 begin
801  PrepareUpdateSQLData;
802  FUpdateSqlData.UpdateLong( ColumnIndex, Value);
803 end;
804 
805 procedure TZASAResultSet.UpdateFloat(ColumnIndex: Integer; Value: Single);
806 begin
807  PrepareUpdateSQLData;
808  FUpdateSqlData.UpdateFloat( ColumnIndex, Value);
809 end;
810 
811 procedure TZASAResultSet.UpdateDouble(ColumnIndex: Integer; Value: Double);
812 begin
813  PrepareUpdateSQLData;
814  FUpdateSqlData.UpdateDouble( ColumnIndex, Value);
815 end;
816 
817 procedure TZASAResultSet.UpdateBigDecimal(ColumnIndex: Integer; Value: Extended);
818 begin
819  PrepareUpdateSQLData;
820  FUpdateSqlData.UpdateBigDecimal( ColumnIndex, Value);
821 end;
822 
823 procedure TZASAResultSet.UpdatePChar(ColumnIndex: Integer; Value: PChar);
824 begin
825  PrepareUpdateSQLData;
826  FUpdateSqlData.UpdatePChar( ColumnIndex, Value);
827 end;
828 
829 procedure TZASAResultSet.UpdateString(ColumnIndex: Integer; const Value: String);
830 begin
831  PrepareUpdateSQLData;
832  FUpdateSqlData.UpdateString(ColumnIndex, ZPlainString(Value));
833 end;
834 
835 procedure TZASAResultSet.UpdateUnicodeString(ColumnIndex: Integer; const Value: WideString);
836 begin
837  PrepareUpdateSQLData;
838  FUpdateSqlData.UpdateString(ColumnIndex, ZPlainString(Value));
839 end;
840 
841 procedure TZASAResultSet.UpdateBytes(ColumnIndex: Integer; const Value: TByteDynArray);
842 begin
843  PrepareUpdateSQLData;
844  FUpdateSqlData.UpdateBytes( ColumnIndex, Value);
845 end;
846 
847 procedure TZASAResultSet.UpdateDate(ColumnIndex: Integer; Value: TDateTime);
848 begin
849  PrepareUpdateSQLData;
850  FUpdateSqlData.UpdateDate( ColumnIndex, Value);
851 end;
852 
853 procedure TZASAResultSet.UpdateTime(ColumnIndex: Integer; Value: TDateTime);
854 begin
855  PrepareUpdateSQLData;
856  FUpdateSqlData.UpdateTime( ColumnIndex, Value);
857 end;
858 
859 procedure TZASAResultSet.UpdateTimestamp(ColumnIndex: Integer; Value: TDateTime);
860 begin
861  PrepareUpdateSQLData;
862  FUpdateSqlData.UpdateTimestamp( ColumnIndex, Value);
863 end;
864 
865 procedure TZASAResultSet.UpdateAsciiStream(ColumnIndex: Integer; Value: TStream);
866 begin
867  PrepareUpdateSQLData;
868  FUpdateSqlData.WriteBlob( ColumnIndex, Value, stAsciiStream);
869 end;
870 
871 procedure TZASAResultSet.UpdateUnicodeStream(ColumnIndex: Integer; Value: TStream);
872 begin
873  PrepareUpdateSQLData;
874  FUpdateSqlData.WriteBlob( ColumnIndex, Value, stUnicodeStream);
875 end;
876 
877 procedure TZASAResultSet.UpdateBinaryStream(ColumnIndex: Integer; Value: TStream);
878 begin
879  PrepareUpdateSQLData;
880  FUpdateSqlData.WriteBlob( ColumnIndex, Value, stBinaryStream);
881 end;
882 
883 procedure TZASAResultSet.UpdateValue(ColumnIndex: Integer; const Value: TZVariant);
884 begin
885  PrepareUpdateSQLData;
886  FUpdateSqlData.UpdateValue( ColumnIndex, EncodeVariant( Value));
887 end;
888 
889 procedure TZASAResultSet.InsertRow;
890 begin
891  if Assigned( FUpdateSQLData) and FInsert then
892  begin
893  FASAConnection.GetPlainDriver.db_put_into( FASAConnection.GetDBHandle,
894  PAnsiChar(FCursorName), FUpdateSQLData.GetData, FSQLData.GetData);
895  ZDbcASAUtils.CheckASAError( FASAConnection.GetPlainDriver,
896  FASAConnection.GetDBHandle, lcOther, 'Insert row');
897 
898  FInsert := false;
899  FUpdateSQLData.FreeSQLDA;
900  end;
901 end;
902 
903 procedure TZASAResultSet.UpdateRow;
904 begin
905  if Assigned( FUpdateSQLData) and FUpdate then
906  begin
907  FASAConnection.GetPlainDriver.db_update( FASAConnection.GetDBHandle,
908  PAnsiChar(FCursorName), FUpdateSQLData.GetData);
909  ZDbcASAUtils.CheckASAError( FASAConnection.GetPlainDriver,
910  FASAConnection.GetDBHandle, lcOther, 'Update row:' + IntToStr( RowNo));
911 
912  FUpdate := false;
913  FUpdateSQLData.FreeSQLDA;
914  end;
915 end;
916 
917 procedure TZASAResultSet.DeleteRow;
918 begin
919  FASAConnection.GetPlainDriver.db_delete( FASAConnection.GetDBHandle,
920  PAnsiChar(FCursorName));
921  ZDbcASAUtils.CheckASAError( FASAConnection.GetPlainDriver,
922  FASAConnection.GetDBHandle, lcOther, 'Delete row:' + IntToStr( RowNo));
923 
924  FDelete := True;
925  if LastRowNo <> MaxInt then
926  LastRowNo := LastRowNo - FASAConnection.GetDBHandle.sqlerrd[2];
927 end;
928 
929 procedure TZASAResultSet.RefreshRow;
930 begin
931  MoveRelative( 0);
932 end;
933 
934 procedure TZASAResultSet.CancelRowUpdates;
935 begin
936  FUpdate := false;
937  if Assigned( FUpdateSQLData) then
938  FUpdateSQLData.FreeSQLDA;
939 end;
940 
941 procedure TZASAResultSet.MoveToInsertRow;
942 begin
943  FInsert := true;
944 end;
945 
946 procedure TZASAResultSet.MoveToCurrentRow;
947 begin
948  FInsert := false;
949  if Assigned( FUpdateSQLData) then
950  FUpdateSQLData.FreeSQLDA;
951 end;
952 
953 { TZASABlob }
954 
955 function TZASABlob.Clone: IZBlob;
956 var
957  Dt: Pointer;
958 begin
959  Dt := nil;
960  if BlobSize > 0 then
961  begin
962  GetMem( Dt, BlobSize);
963  System.Move( BlobData^, Dt^, BlobSize);
964  end;
965  Result := TZASABlob.CreateWithData( Dt, BlobSize, FConnection);
966 end;
967 
968 {**
969  Reads the blob information by blob handle.
970  @param handle a Interbase6 database connect handle.
971  @param the statement previously prepared
972 }
973 constructor TZASABlob.Create( ResultSet: TZASAResultSet; ColID: Integer);
974 begin
975  inherited Create;
976  FConnection := ResultSet.GetStatement.GetConnection;
977  FBlobRead := False;
978  FResultSet := ResultSet;
979  FColID := ColID;
980 end;
981 
982 constructor TZASABlob.CreateWithStream(Stream: TStream; Connection: IZConnection);
983 begin
984  inherited CreateWithStream(Stream, Connection);
985  FBlobRead := true;
986 end;
987 
988 constructor TZASABlob.CreateWithData(Data: Pointer; Size: Integer;
989  Connection: IZConnection);
990 begin
991  inherited Create;
992  FConnection := Connection;
993  BlobData := Data;
994  BlobSize := Size;
995  Updated := False;
996  FBlobRead := true;
997 end;
998 
999 function TZASABlob.GetBytes: TByteDynArray;
1000 begin
1001  ReadBlob;
1002  Result := inherited GetBytes;
1003 end;
1004 
1005 function TZASABlob.GetStream: TStream;
1006 begin
1007  ReadBlob;
1008  Result := inherited GetStream;
1009 end;
1010 
1011 function TZASABlob.GetString: RawByteString;
1012 begin
1013  ReadBlob;
1014  Result := inherited GetString;
1015 end;
1016 
1017 function TZASABlob.GetUnicodeString: WideString;
1018 begin
1019  Result := inherited GetUnicodeString;
1020 end;
1021 
1022 function TZASABlob.IsEmpty: Boolean;
1023 begin
1024  ReadBlob;
1025  Result := inherited IsEmpty;
1026 end;
1027 
1028 procedure TZASABlob.ReadBlob;
1029 var
1030  Size: LongWord;
1031  Buffer: Pointer;
1032 begin
1033  if FBlobRead then
1034  Exit;
1035  if Assigned(BlobData) then
1036  FreeMem(BlobData);
1037 
1038  if FResultSet.FInsert or ( FResultSet.FUpdate and FResultSet.FUpdateSQLData.IsAssigned( FColID)) then
1039  FResultSet.FUpdateSQLData.ReadBlobToMem( FColID, Buffer, Size)
1040  else
1041  FResultSet.FSQLData.ReadBlobToMem( FColID, Buffer, Size);
1042  BlobSize := Size;
1043  BlobData := Buffer;
1044  FBlobRead := True;
1045 end;
1046 
1047 end.