78 |
|
FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor; |
79 |
|
|
80 |
|
type |
81 |
– |
|
81 |
|
TFB30Statement = class; |
82 |
|
TIBXSQLDA = class; |
83 |
|
|
86 |
|
TIBXSQLVAR = class(TSQLVarData) |
87 |
|
private |
88 |
|
FStatement: TFB30Statement; |
89 |
+ |
FFirebird30ClientAPI: TFB30ClientAPI; |
90 |
|
FBlob: IBlob; {Cache references} |
91 |
– |
FArray: IArray; |
91 |
|
FNullIndicator: short; |
92 |
|
FOwnsSQLData: boolean; |
93 |
|
FBlobMetaData: IBlobMetaData; |
98 |
|
FSQLSubType: integer; |
99 |
|
FSQLData: PByte; {Address of SQL Data in Message Buffer} |
100 |
|
FSQLNullIndicator: PShort; {Address of null indicator} |
101 |
< |
FDataLength: integer; |
101 |
> |
FDataLength: cardinal; |
102 |
> |
FMetadataSize: cardinal; |
103 |
|
FNullable: boolean; |
104 |
|
FScale: integer; |
105 |
|
FCharSetID: cardinal; |
107 |
|
FFieldName: AnsiString; |
108 |
|
|
109 |
|
protected |
110 |
+ |
function CanChangeSQLType: boolean; |
111 |
|
function GetSQLType: cardinal; override; |
112 |
|
function GetSubtype: integer; override; |
113 |
|
function GetAliasName: AnsiString; override; |
116 |
|
function GetRelationName: AnsiString; override; |
117 |
|
function GetScale: integer; override; |
118 |
|
function GetCharSetID: cardinal; override; |
118 |
– |
function GetCodePage: TSystemCodePage; override; |
119 |
|
function GetIsNull: Boolean; override; |
120 |
|
function GetIsNullable: boolean; override; |
121 |
|
function GetSQLData: PByte; override; |
122 |
|
function GetDataLength: cardinal; override; |
123 |
+ |
function GetSize: cardinal; override; |
124 |
+ |
function GetDefaultTextSQLType: cardinal; override; |
125 |
|
procedure SetIsNull(Value: Boolean); override; |
126 |
|
procedure SetIsNullable(Value: Boolean); override; |
127 |
< |
procedure SetSQLData(AValue: PByte; len: cardinal); override; |
128 |
< |
procedure SetScale(aValue: integer); override; |
129 |
< |
procedure SetDataLength(len: cardinal); override; |
128 |
< |
procedure SetSQLType(aValue: cardinal); override; |
127 |
> |
procedure InternalSetScale(aValue: integer); override; |
128 |
> |
procedure InternalSetDataLength(len: cardinal); override; |
129 |
> |
procedure InternalSetSQLType(aValue: cardinal); override; |
130 |
|
procedure SetCharSetID(aValue: cardinal); override; |
131 |
< |
|
131 |
> |
procedure SetMetaSize(aValue: cardinal); override; |
132 |
|
public |
133 |
|
constructor Create(aParent: TIBXSQLDA; aIndex: integer); |
134 |
|
procedure Changed; override; |
135 |
+ |
procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata); |
136 |
+ |
procedure ColumnSQLDataInit; |
137 |
|
procedure RowChange; override; |
138 |
|
procedure FreeSQLData; |
139 |
< |
function GetAsArray(Array_ID: TISC_QUAD): IArray; override; |
139 |
> |
function GetAsArray: IArray; override; |
140 |
|
function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override; |
141 |
|
function GetArrayMetaData: IArrayMetaData; override; |
142 |
|
function GetBlobMetaData: IBlobMetaData; override; |
143 |
|
function CreateBlob: IBlob; override; |
144 |
+ |
procedure SetSQLData(AValue: PByte; len: cardinal); override; |
145 |
|
end; |
146 |
|
|
147 |
|
{ TIBXSQLDA } |
152 |
|
FSize: Integer; {Number of TIBXSQLVARs in column list} |
153 |
|
FMetaData: Firebird.IMessageMetadata; |
154 |
|
FTransactionSeqNo: integer; |
155 |
< |
protected |
155 |
> |
protected |
156 |
|
FStatement: TFB30Statement; |
157 |
+ |
FFirebird30ClientAPI: TFB30ClientAPI; |
158 |
+ |
FMessageBuffer: PByte; {Message Buffer} |
159 |
+ |
FMsgLength: integer; {Message Buffer length} |
160 |
|
function GetTransactionSeqNo: integer; override; |
161 |
|
procedure FreeXSQLDA; virtual; |
162 |
|
function GetStatement: IStatement; override; |
163 |
|
function GetPrepareSeqNo: integer; override; |
164 |
|
procedure SetCount(Value: Integer); override; |
165 |
+ |
procedure AllocMessageBuffer(len: integer); virtual; |
166 |
+ |
procedure FreeMessageBuffer; virtual; |
167 |
|
public |
168 |
< |
constructor Create(aStatement: TFB30Statement); |
168 |
> |
constructor Create(aStatement: TFB30Statement); overload; |
169 |
> |
constructor Create(api: IFirebirdAPI); overload; |
170 |
|
destructor Destroy; override; |
171 |
|
procedure Changed; virtual; |
172 |
|
function CheckStatementStatus(Request: TStatementStatus): boolean; override; |
173 |
|
function ColumnsInUseCount: integer; override; |
174 |
< |
function GetTransaction: TFB30Transaction; virtual; |
174 |
> |
function GetMetaData: Firebird.IMessageMetadata; virtual; |
175 |
|
procedure Initialize; override; |
176 |
|
function StateChanged(var ChangeSeqNo: integer): boolean; override; |
177 |
< |
property MetaData: Firebird.IMessageMetadata read FMetaData; |
177 |
> |
function CanChangeMetaData: boolean; override; |
178 |
|
property Count: Integer read FCount write SetCount; |
179 |
|
property Statement: TFB30Statement read FStatement; |
180 |
|
end; |
183 |
|
|
184 |
|
TIBXINPUTSQLDA = class(TIBXSQLDA) |
185 |
|
private |
176 |
– |
FMessageBuffer: PByte; {Message Buffer} |
177 |
– |
FMsgLength: integer; {Message Buffer length} |
186 |
|
FCurMetaData: Firebird.IMessageMetadata; |
187 |
< |
procedure FreeMessageBuffer; |
187 |
> |
procedure FreeCurMetaData; |
188 |
|
function GetMessageBuffer: PByte; |
181 |
– |
function GetMetaData: Firebird.IMessageMetadata; |
189 |
|
function GetModified: Boolean; |
190 |
|
function GetMsgLength: integer; |
191 |
< |
procedure PackBuffer; |
191 |
> |
procedure BuildMetadata; |
192 |
|
protected |
193 |
+ |
procedure PackBuffer; |
194 |
|
procedure FreeXSQLDA; override; |
195 |
|
public |
196 |
< |
constructor Create(aStatement: TFB30Statement); |
196 |
> |
constructor Create(aStatement: TFB30Statement); overload; |
197 |
> |
constructor Create(api: IFirebirdAPI); overload; |
198 |
|
destructor Destroy; override; |
199 |
|
procedure Bind(aMetaData: Firebird.IMessageMetadata); |
200 |
|
procedure Changed; override; |
201 |
+ |
function GetMetaData: Firebird.IMessageMetadata; override; |
202 |
+ |
procedure ReInitialise; |
203 |
|
function IsInputDataArea: boolean; override; |
193 |
– |
property MetaData: Firebird.IMessageMetadata read GetMetaData; |
204 |
|
property MessageBuffer: PByte read GetMessageBuffer; |
205 |
|
property MsgLength: integer read GetMsgLength; |
206 |
|
end; |
210 |
|
TIBXOUTPUTSQLDA = class(TIBXSQLDA) |
211 |
|
private |
212 |
|
FTransaction: TFB30Transaction; {transaction used to execute the statement} |
203 |
– |
FMessageBuffer: PByte; {Message Buffer} |
204 |
– |
FMsgLength: integer; {Message Buffer length} |
213 |
|
protected |
214 |
< |
procedure FreeXSQLDA; override; |
214 |
> |
function GetTransaction: ITransaction; override; |
215 |
|
public |
216 |
|
procedure Bind(aMetaData: Firebird.IMessageMetadata); |
217 |
|
procedure GetData(index: integer; var aIsNull: boolean; var len: short; |
227 |
|
private |
228 |
|
FResults: TIBXOUTPUTSQLDA; |
229 |
|
FCursorSeqNo: integer; |
230 |
+ |
procedure RowChange; |
231 |
|
public |
232 |
|
constructor Create(aResults: TIBXOUTPUTSQLDA); |
233 |
|
destructor Destroy; override; |
234 |
|
{IResultSet} |
235 |
< |
function FetchNext: boolean; |
235 |
> |
function FetchNext: boolean; {fetch next record} |
236 |
> |
function FetchPrior: boolean; {fetch previous record} |
237 |
> |
function FetchFirst:boolean; {fetch first record} |
238 |
> |
function FetchLast: boolean; {fetch last record} |
239 |
> |
function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set} |
240 |
> |
function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current} |
241 |
|
function GetCursorName: AnsiString; |
242 |
< |
function GetTransaction: ITransaction; override; |
242 |
> |
function IsBof: boolean; |
243 |
|
function IsEof: boolean; |
244 |
|
procedure Close; |
245 |
|
end; |
246 |
|
|
247 |
+ |
{ TBatchCompletion } |
248 |
+ |
|
249 |
+ |
TBatchCompletion = class(TInterfaceOwner,IBatchCompletion) |
250 |
+ |
private |
251 |
+ |
FCompletionState: Firebird.IBatchCompletionState; |
252 |
+ |
FFirebird30ClientAPI: TFB30ClientAPI; |
253 |
+ |
public |
254 |
+ |
constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState); |
255 |
+ |
destructor Destroy; override; |
256 |
+ |
{IBatchCompletion} |
257 |
+ |
function getErrorStatus(var RowNo: integer; var status: IStatus): boolean; |
258 |
+ |
function getTotalProcessed: cardinal; |
259 |
+ |
function getState(updateNo: cardinal): TBatchCompletionState; |
260 |
+ |
function getStatusMessage(updateNo: cardinal): AnsiString; |
261 |
+ |
function getUpdated: integer; |
262 |
+ |
end; |
263 |
+ |
|
264 |
+ |
TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative); |
265 |
+ |
|
266 |
|
{ TFB30Statement } |
267 |
|
|
268 |
|
TFB30Statement = class(TFBStatement,IStatement) |
269 |
|
private |
270 |
|
FStatementIntf: Firebird.IStatement; |
271 |
+ |
FFirebird30ClientAPI: TFB30ClientAPI; |
272 |
|
FSQLParams: TIBXINPUTSQLDA; |
273 |
|
FSQLRecord: TIBXOUTPUTSQLDA; |
274 |
|
FResultSet: Firebird.IResultSet; |
275 |
|
FCursorSeqNo: integer; |
276 |
+ |
FCursor: AnsiString; |
277 |
+ |
FBatch: Firebird.IBatch; |
278 |
+ |
FBatchCompletion: IBatchCompletion; |
279 |
+ |
FBatchRowCount: integer; |
280 |
+ |
FBatchBufferSize: integer; |
281 |
+ |
FBatchBufferUsed: integer; |
282 |
|
protected |
283 |
+ |
procedure CheckChangeBatchRowLimit; override; |
284 |
|
procedure CheckHandle; override; |
285 |
+ |
procedure CheckBatchModeAvailable; |
286 |
|
procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override; |
287 |
< |
procedure InternalPrepare; override; |
287 |
> |
function GetStatementIntf: IStatement; override; |
288 |
> |
procedure InternalPrepare(CursorName: AnsiString=''); override; |
289 |
|
function InternalExecute(aTransaction: ITransaction): IResults; override; |
290 |
< |
function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override; |
290 |
> |
function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean |
291 |
> |
): IResultSet; override; |
292 |
> |
procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override; |
293 |
|
procedure FreeHandle; override; |
294 |
|
procedure InternalClose(Force: boolean); override; |
295 |
+ |
function SavePerfStats(var Stats: TPerfStatistics): boolean; |
296 |
|
public |
297 |
|
constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction; |
298 |
< |
sql: AnsiString; aSQLDialect: integer); |
298 |
> |
sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''); |
299 |
|
constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction; |
300 |
< |
sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean =false); |
300 |
> |
sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean =false; |
301 |
> |
CaseSensitiveParams: boolean=false; CursorName: AnsiString=''); |
302 |
|
destructor Destroy; override; |
303 |
< |
function FetchNext: boolean; |
303 |
> |
function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean; |
304 |
|
property StatementIntf: Firebird.IStatement read FStatementIntf; |
305 |
+ |
property SQLParams: TIBXINPUTSQLDA read FSQLParams; |
306 |
+ |
property SQLRecord: TIBXOUTPUTSQLDA read FSQLRecord; |
307 |
|
|
308 |
|
public |
309 |
|
{IStatement} |
311 |
|
function GetMetaData: IMetaData; override; |
312 |
|
function GetPlan: AnsiString; |
313 |
|
function IsPrepared: boolean; |
314 |
+ |
function GetFlags: TStatementFlags; override; |
315 |
|
function CreateBlob(column: TColumnMetaData): IBlob; override; |
316 |
|
function CreateArray(column: TColumnMetaData): IArray; override; |
317 |
|
procedure SetRetainInterfaces(aValue: boolean); override; |
318 |
< |
|
318 |
> |
function IsInBatchMode: boolean; override; |
319 |
> |
function HasBatchMode: boolean; override; |
320 |
> |
procedure AddToBatch; override; |
321 |
> |
function ExecuteBatch(aTransaction: ITransaction |
322 |
> |
): IBatchCompletion; override; |
323 |
> |
procedure CancelBatch; override; |
324 |
> |
function GetBatchCompletion: IBatchCompletion; override; |
325 |
|
end; |
326 |
|
|
327 |
|
implementation |
328 |
|
|
329 |
< |
uses IBUtils, FBMessages, FBBLob, FB30Blob, variants, FBArray, FB30Array; |
329 |
> |
uses IBUtils, FBMessages, FBBlob, FB30Blob, variants, FBArray, FB30Array; |
330 |
|
|
331 |
|
const |
332 |
|
ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches'; |
333 |
|
|
334 |
+ |
{ EIBBatchCompletionError } |
335 |
+ |
|
336 |
+ |
{ TBatchCompletion } |
337 |
+ |
|
338 |
+ |
constructor TBatchCompletion.Create(api: TFB30ClientAPI; |
339 |
+ |
cs: IBatchCompletionState); |
340 |
+ |
begin |
341 |
+ |
inherited Create; |
342 |
+ |
FFirebird30ClientAPI := api; |
343 |
+ |
FCompletionState := cs; |
344 |
+ |
end; |
345 |
+ |
|
346 |
+ |
destructor TBatchCompletion.Destroy; |
347 |
+ |
begin |
348 |
+ |
if FCompletionState <> nil then |
349 |
+ |
begin |
350 |
+ |
FCompletionState.dispose; |
351 |
+ |
FCompletionState := nil; |
352 |
+ |
end; |
353 |
+ |
inherited Destroy; |
354 |
+ |
end; |
355 |
+ |
|
356 |
+ |
function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus |
357 |
+ |
): boolean; |
358 |
+ |
var i: integer; |
359 |
+ |
upcount: cardinal; |
360 |
+ |
state: integer; |
361 |
+ |
FBStatus: Firebird.IStatus; |
362 |
+ |
begin |
363 |
+ |
Result := false; |
364 |
+ |
RowNo := -1; |
365 |
+ |
FBStatus := nil; |
366 |
+ |
with FFirebird30ClientAPI do |
367 |
+ |
begin |
368 |
+ |
upcount := FCompletionState.getSize(StatusIntf); |
369 |
+ |
Check4DataBaseError; |
370 |
+ |
for i := 0 to upcount - 1 do |
371 |
+ |
begin |
372 |
+ |
state := FCompletionState.getState(StatusIntf,i); |
373 |
+ |
if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then |
374 |
+ |
begin |
375 |
+ |
RowNo := i+1; |
376 |
+ |
FBStatus := MasterIntf.getStatus; |
377 |
+ |
try |
378 |
+ |
FCompletionState.getStatus(StatusIntf,FBStatus,i); |
379 |
+ |
Check4DataBaseError; |
380 |
+ |
except |
381 |
+ |
FBStatus.dispose; |
382 |
+ |
raise |
383 |
+ |
end; |
384 |
+ |
status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus, |
385 |
+ |
Format(SBatchCompletionError,[RowNo])); |
386 |
+ |
status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages); |
387 |
+ |
Result := true; |
388 |
+ |
break; |
389 |
+ |
end; |
390 |
+ |
end; |
391 |
+ |
end; |
392 |
+ |
end; |
393 |
+ |
|
394 |
+ |
function TBatchCompletion.getTotalProcessed: cardinal; |
395 |
+ |
begin |
396 |
+ |
with FFirebird30ClientAPI do |
397 |
+ |
begin |
398 |
+ |
Result := FCompletionState.getsize(StatusIntf); |
399 |
+ |
Check4DataBaseError; |
400 |
+ |
end; |
401 |
+ |
end; |
402 |
+ |
|
403 |
+ |
function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState; |
404 |
+ |
var state: integer; |
405 |
+ |
begin |
406 |
+ |
with FFirebird30ClientAPI do |
407 |
+ |
begin |
408 |
+ |
state := FCompletionState.getState(StatusIntf,updateNo); |
409 |
+ |
Check4DataBaseError; |
410 |
+ |
case state of |
411 |
+ |
Firebird.IBatchCompletionState.EXECUTE_FAILED: |
412 |
+ |
Result := bcExecuteFailed; |
413 |
+ |
|
414 |
+ |
Firebird.IBatchCompletionState.SUCCESS_NO_INFO: |
415 |
+ |
Result := bcSuccessNoInfo; |
416 |
+ |
|
417 |
+ |
else |
418 |
+ |
Result := bcNoMoreErrors; |
419 |
+ |
end; |
420 |
+ |
end; |
421 |
+ |
end; |
422 |
+ |
|
423 |
+ |
function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString; |
424 |
+ |
var status: Firebird.IStatus; |
425 |
+ |
begin |
426 |
+ |
with FFirebird30ClientAPI do |
427 |
+ |
begin |
428 |
+ |
status := MasterIntf.getStatus; |
429 |
+ |
FCompletionState.getStatus(StatusIntf,status,updateNo); |
430 |
+ |
Check4DataBaseError; |
431 |
+ |
Result := FormatStatus(status); |
432 |
+ |
end; |
433 |
+ |
end; |
434 |
+ |
|
435 |
+ |
function TBatchCompletion.getUpdated: integer; |
436 |
+ |
var i: integer; |
437 |
+ |
upcount: cardinal; |
438 |
+ |
state: integer; |
439 |
+ |
begin |
440 |
+ |
Result := 0; |
441 |
+ |
with FFirebird30ClientAPI do |
442 |
+ |
begin |
443 |
+ |
upcount := FCompletionState.getSize(StatusIntf); |
444 |
+ |
Check4DataBaseError; |
445 |
+ |
for i := 0 to upcount -1 do |
446 |
+ |
begin |
447 |
+ |
state := FCompletionState.getState(StatusIntf,i); |
448 |
+ |
if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then |
449 |
+ |
break; |
450 |
+ |
Inc(Result); |
451 |
+ |
end; |
452 |
+ |
end; |
453 |
+ |
end; |
454 |
+ |
|
455 |
|
{ TIBXSQLVAR } |
456 |
|
|
457 |
|
procedure TIBXSQLVAR.Changed; |
460 |
|
TIBXSQLDA(Parent).Changed; |
461 |
|
end; |
462 |
|
|
463 |
+ |
procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata); |
464 |
+ |
begin |
465 |
+ |
with FFirebird30ClientAPI do |
466 |
+ |
begin |
467 |
+ |
FSQLType := aMetaData.getType(StatusIntf,Index); |
468 |
+ |
Check4DataBaseError; |
469 |
+ |
if FSQLType = SQL_BLOB then |
470 |
+ |
begin |
471 |
+ |
FSQLSubType := aMetaData.getSubType(StatusIntf,Index); |
472 |
+ |
Check4DataBaseError; |
473 |
+ |
end |
474 |
+ |
else |
475 |
+ |
FSQLSubType := 0; |
476 |
+ |
FDataLength := aMetaData.getLength(StatusIntf,Index); |
477 |
+ |
Check4DataBaseError; |
478 |
+ |
FMetadataSize := FDataLength; |
479 |
+ |
FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index)); |
480 |
+ |
Check4DataBaseError; |
481 |
+ |
FFieldName := strpas(aMetaData.getField(StatusIntf,Index)); |
482 |
+ |
Check4DataBaseError; |
483 |
+ |
FNullable := aMetaData.isNullable(StatusIntf,Index); |
484 |
+ |
Check4DataBaseError; |
485 |
+ |
FScale := aMetaData.getScale(StatusIntf,Index); |
486 |
+ |
Check4DataBaseError; |
487 |
+ |
FCharSetID := aMetaData.getCharSet(StatusIntf,Index) and $FF; |
488 |
+ |
Check4DataBaseError; |
489 |
+ |
end; |
490 |
+ |
end; |
491 |
+ |
|
492 |
+ |
procedure TIBXSQLVAR.ColumnSQLDataInit; |
493 |
+ |
begin |
494 |
+ |
FreeSQLData; |
495 |
+ |
with FFirebird30ClientAPI do |
496 |
+ |
begin |
497 |
+ |
case SQLType of |
498 |
+ |
SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP, |
499 |
+ |
SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN, |
500 |
+ |
SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, |
501 |
+ |
SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34, |
502 |
+ |
SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX: |
503 |
+ |
begin |
504 |
+ |
if (FDataLength = 0) then |
505 |
+ |
{ Make sure you get a valid pointer anyway |
506 |
+ |
select '' from foo } |
507 |
+ |
IBAlloc(FSQLData, 0, 1) |
508 |
+ |
else |
509 |
+ |
IBAlloc(FSQLData, 0, FDataLength) |
510 |
+ |
end; |
511 |
+ |
SQL_VARYING: |
512 |
+ |
IBAlloc(FSQLData, 0, FDataLength + 2); |
513 |
+ |
else |
514 |
+ |
IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)]) |
515 |
+ |
end; |
516 |
+ |
FOwnsSQLData := true; |
517 |
+ |
FNullIndicator := -1; |
518 |
+ |
end; |
519 |
+ |
end; |
520 |
+ |
|
521 |
+ |
function TIBXSQLVAR.CanChangeSQLType: boolean; |
522 |
+ |
begin |
523 |
+ |
Result := Parent.CanChangeMetaData; |
524 |
+ |
end; |
525 |
+ |
|
526 |
|
function TIBXSQLVAR.GetSQLType: cardinal; |
527 |
|
begin |
528 |
|
Result := FSQLType; |
534 |
|
end; |
535 |
|
|
536 |
|
function TIBXSQLVAR.GetAliasName: AnsiString; |
537 |
+ |
var metadata: Firebird.IMessageMetadata; |
538 |
|
begin |
539 |
< |
with Firebird30ClientAPI do |
540 |
< |
begin |
541 |
< |
result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index)); |
542 |
< |
Check4DataBaseError; |
539 |
> |
metadata := TIBXSQLDA(Parent).GetMetaData; |
540 |
> |
try |
541 |
> |
with FFirebird30ClientAPI do |
542 |
> |
begin |
543 |
> |
result := strpas(metaData.getAlias(StatusIntf,Index)); |
544 |
> |
Check4DataBaseError; |
545 |
> |
end; |
546 |
> |
finally |
547 |
> |
metadata.release; |
548 |
|
end; |
549 |
|
end; |
550 |
|
|
554 |
|
end; |
555 |
|
|
556 |
|
function TIBXSQLVAR.GetOwnerName: AnsiString; |
557 |
+ |
var metadata: Firebird.IMessageMetadata; |
558 |
|
begin |
559 |
< |
with Firebird30ClientAPI do |
560 |
< |
begin |
561 |
< |
result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index)); |
562 |
< |
Check4DataBaseError; |
559 |
> |
metadata := TIBXSQLDA(Parent).GetMetaData; |
560 |
> |
try |
561 |
> |
with FFirebird30ClientAPI do |
562 |
> |
begin |
563 |
> |
result := strpas(metaData.getOwner(StatusIntf,Index)); |
564 |
> |
Check4DataBaseError; |
565 |
> |
end; |
566 |
> |
finally |
567 |
> |
metadata.release; |
568 |
|
end; |
569 |
|
end; |
570 |
|
|
580 |
|
|
581 |
|
function TIBXSQLVAR.GetCharSetID: cardinal; |
582 |
|
begin |
583 |
< |
result := 0; |
583 |
> |
result := 0; {NONE} |
584 |
|
case SQLType of |
585 |
|
SQL_VARYING, SQL_TEXT: |
586 |
|
result := FCharSetID; |
587 |
|
|
588 |
|
SQL_BLOB: |
589 |
|
if (SQLSubType = 1) then |
590 |
< |
result := FCharSetID; |
590 |
> |
result := FCharSetID |
591 |
> |
else |
592 |
> |
result := 1; {OCTETS} |
593 |
|
|
594 |
|
SQL_ARRAY: |
595 |
|
if (FRelationName <> '') and (FFieldName <> '') then |
599 |
|
end; |
600 |
|
end; |
601 |
|
|
348 |
– |
function TIBXSQLVAR.GetCodePage: TSystemCodePage; |
349 |
– |
begin |
350 |
– |
result := CP_NONE; |
351 |
– |
with Firebird30ClientAPI do |
352 |
– |
CharSetID2CodePage(GetCharSetID,result); |
353 |
– |
end; |
354 |
– |
|
602 |
|
function TIBXSQLVAR.GetIsNull: Boolean; |
603 |
|
begin |
604 |
|
Result := IsNullable and (FSQLNullIndicator^ = -1); |
619 |
|
Result := FDataLength; |
620 |
|
end; |
621 |
|
|
622 |
+ |
function TIBXSQLVAR.GetSize: cardinal; |
623 |
+ |
begin |
624 |
+ |
Result := FMetadataSize; |
625 |
+ |
end; |
626 |
+ |
|
627 |
|
function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData; |
628 |
|
begin |
629 |
|
if GetSQLType <> SQL_ARRAY then |
630 |
|
IBError(ibxeInvalidDataConversion,[nil]); |
631 |
|
|
632 |
|
if FArrayMetaData = nil then |
633 |
< |
FArrayMetaData := TFB30ArrayMetaData.Create(FStatement.GetAttachment as TFB30Attachment, |
634 |
< |
FStatement.GetTransaction as TFB30Transaction, |
633 |
> |
FArrayMetaData := TFB30ArrayMetaData.Create(GetAttachment as TFB30Attachment, |
634 |
> |
GetTransaction as TFB30Transaction, |
635 |
|
GetRelationName,GetFieldName); |
636 |
|
Result := FArrayMetaData; |
637 |
|
end; |
642 |
|
IBError(ibxeInvalidDataConversion,[nil]); |
643 |
|
|
644 |
|
if FBlobMetaData = nil then |
645 |
< |
FBlobMetaData := TFB30BlobMetaData.Create(FStatement.GetAttachment as TFB30Attachment, |
646 |
< |
FStatement.GetTransaction as TFB30Transaction, |
645 |
> |
FBlobMetaData := TFB30BlobMetaData.Create(GetAttachment as TFB30Attachment, |
646 |
> |
GetTransaction as TFB30Transaction, |
647 |
|
GetRelationName,GetFieldName, |
648 |
|
GetSubType); |
649 |
|
(FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID); |
673 |
|
end |
674 |
|
else |
675 |
|
FSQLNullIndicator := nil; |
676 |
+ |
Changed; |
677 |
|
end; |
678 |
|
|
679 |
|
procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal); |
683 |
|
FSQLData := AValue; |
684 |
|
FDataLength := len; |
685 |
|
FOwnsSQLData := false; |
686 |
+ |
Changed; |
687 |
|
end; |
688 |
|
|
689 |
< |
procedure TIBXSQLVAR.SetScale(aValue: integer); |
689 |
> |
procedure TIBXSQLVAR.InternalSetScale(aValue: integer); |
690 |
|
begin |
691 |
|
FScale := aValue; |
692 |
+ |
Changed; |
693 |
|
end; |
694 |
|
|
695 |
< |
procedure TIBXSQLVAR.SetDataLength(len: cardinal); |
695 |
> |
procedure TIBXSQLVAR.InternalSetDataLength(len: cardinal); |
696 |
|
begin |
697 |
|
if not FOwnsSQLData then |
698 |
|
FSQLData := nil; |
699 |
|
FDataLength := len; |
700 |
< |
with Firebird30ClientAPI do |
700 |
> |
with FFirebird30ClientAPI do |
701 |
|
IBAlloc(FSQLData, 0, FDataLength); |
702 |
|
FOwnsSQLData := true; |
703 |
+ |
Changed; |
704 |
|
end; |
705 |
|
|
706 |
< |
procedure TIBXSQLVAR.SetSQLType(aValue: cardinal); |
706 |
> |
procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal); |
707 |
|
begin |
708 |
|
FSQLType := aValue; |
709 |
+ |
Changed; |
710 |
|
end; |
711 |
|
|
712 |
|
procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal); |
713 |
|
begin |
714 |
|
FCharSetID := aValue; |
715 |
+ |
Changed; |
716 |
+ |
end; |
717 |
+ |
|
718 |
+ |
procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal); |
719 |
+ |
begin |
720 |
+ |
if (aValue > FMetaDataSize) and not CanChangeSQLType then |
721 |
+ |
IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]); |
722 |
+ |
FMetaDataSize := aValue; |
723 |
+ |
end; |
724 |
+ |
|
725 |
+ |
function TIBXSQLVAR.GetDefaultTextSQLType: cardinal; |
726 |
+ |
begin |
727 |
+ |
Result := SQL_VARYING; |
728 |
|
end; |
729 |
|
|
730 |
|
constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer); |
731 |
|
begin |
732 |
|
inherited Create(aParent,aIndex); |
733 |
|
FStatement := aParent.Statement; |
734 |
+ |
FFirebird30ClientAPI := aParent.FFirebird30ClientAPI; |
735 |
|
end; |
736 |
|
|
737 |
|
procedure TIBXSQLVAR.RowChange; |
738 |
|
begin |
739 |
|
inherited; |
740 |
|
FBlob := nil; |
470 |
– |
FArray := nil; |
741 |
|
end; |
742 |
|
|
743 |
|
procedure TIBXSQLVAR.FreeSQLData; |
748 |
|
FOwnsSQLData := true; |
749 |
|
end; |
750 |
|
|
751 |
< |
function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray; |
751 |
> |
function TIBXSQLVAR.GetAsArray: IArray; |
752 |
|
begin |
753 |
|
if SQLType <> SQL_ARRAY then |
754 |
|
IBError(ibxeInvalidDataConversion,[nil]); |
757 |
|
Result := nil |
758 |
|
else |
759 |
|
begin |
760 |
< |
if FArray = nil then |
761 |
< |
FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment, |
762 |
< |
TIBXSQLDA(Parent).GetTransaction, |
763 |
< |
GetArrayMetaData,Array_ID); |
764 |
< |
Result := FArray; |
760 |
> |
if FArrayIntf = nil then |
761 |
> |
FArrayIntf := TFB30Array.Create(GetAttachment as TFB30Attachment, |
762 |
> |
GetTransaction as TFB30Transaction, |
763 |
> |
GetArrayMetaData,PISC_QUAD(SQLData)^); |
764 |
> |
Result := FArrayIntf; |
765 |
|
end; |
766 |
|
end; |
767 |
|
|
776 |
|
if IsNull then |
777 |
|
Result := nil |
778 |
|
else |
779 |
< |
Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment, |
780 |
< |
TIBXSQLDA(Parent).GetTransaction, |
779 |
> |
Result := TFB30Blob.Create(GetAttachment as TFB30Attachment, |
780 |
> |
GetTransaction as TFB30Transaction, |
781 |
|
GetBlobMetaData, |
782 |
|
Blob_ID,BPB); |
783 |
|
FBlob := Result; |
786 |
|
|
787 |
|
function TIBXSQLVAR.CreateBlob: IBlob; |
788 |
|
begin |
789 |
< |
Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment, |
790 |
< |
FStatement.GetTransaction as TFB30Transaction, |
789 |
> |
Result := TFB30Blob.Create(GetAttachment as TFB30Attachment, |
790 |
> |
GetTransaction as TFB30Transaction, |
791 |
|
GetSubType,GetCharSetID,nil); |
792 |
|
end; |
793 |
|
|
794 |
|
{ TResultSet } |
795 |
|
|
796 |
+ |
procedure TResultSet.RowChange; |
797 |
+ |
var i: integer; |
798 |
+ |
begin |
799 |
+ |
for i := 0 to getCount - 1 do |
800 |
+ |
FResults.Column[i].RowChange; |
801 |
+ |
end; |
802 |
+ |
|
803 |
|
constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA); |
804 |
|
begin |
805 |
|
inherited Create(aResults); |
814 |
|
end; |
815 |
|
|
816 |
|
function TResultSet.FetchNext: boolean; |
540 |
– |
var i: integer; |
817 |
|
begin |
818 |
|
CheckActive; |
819 |
< |
Result := FResults.FStatement.FetchNext; |
819 |
> |
Result := FResults.FStatement.Fetch(ftNext); |
820 |
|
if Result then |
821 |
< |
for i := 0 to getCount - 1 do |
822 |
< |
FResults.Column[i].RowChange; |
821 |
> |
RowChange; |
822 |
> |
end; |
823 |
> |
|
824 |
> |
function TResultSet.FetchPrior: boolean; |
825 |
> |
begin |
826 |
> |
CheckActive; |
827 |
> |
Result := FResults.FStatement.Fetch(ftPrior); |
828 |
> |
if Result then |
829 |
> |
RowChange; |
830 |
> |
end; |
831 |
> |
|
832 |
> |
function TResultSet.FetchFirst: boolean; |
833 |
> |
begin |
834 |
> |
CheckActive; |
835 |
> |
Result := FResults.FStatement.Fetch(ftFirst); |
836 |
> |
if Result then |
837 |
> |
RowChange; |
838 |
> |
end; |
839 |
> |
|
840 |
> |
function TResultSet.FetchLast: boolean; |
841 |
> |
begin |
842 |
> |
CheckActive; |
843 |
> |
Result := FResults.FStatement.Fetch(ftLast); |
844 |
> |
if Result then |
845 |
> |
RowChange; |
846 |
> |
end; |
847 |
> |
|
848 |
> |
function TResultSet.FetchAbsolute(position: Integer): boolean; |
849 |
> |
begin |
850 |
> |
CheckActive; |
851 |
> |
Result := FResults.FStatement.Fetch(ftAbsolute,position); |
852 |
> |
if Result then |
853 |
> |
RowChange; |
854 |
> |
end; |
855 |
> |
|
856 |
> |
function TResultSet.FetchRelative(offset: Integer): boolean; |
857 |
> |
begin |
858 |
> |
CheckActive; |
859 |
> |
Result := FResults.FStatement.Fetch(ftRelative,offset); |
860 |
> |
if Result then |
861 |
> |
RowChange; |
862 |
|
end; |
863 |
|
|
864 |
|
function TResultSet.GetCursorName: AnsiString; |
865 |
|
begin |
866 |
< |
IBError(ibxeNotSupported,[nil]); |
552 |
< |
Result := ''; |
866 |
> |
Result := FResults.FStatement.FCursor; |
867 |
|
end; |
868 |
|
|
869 |
< |
function TResultSet.GetTransaction: ITransaction; |
869 |
> |
function TResultSet.IsBof: boolean; |
870 |
|
begin |
871 |
< |
Result := FResults.FTransaction; |
871 |
> |
Result := FResults.FStatement.FBof; |
872 |
|
end; |
873 |
|
|
874 |
|
function TResultSet.IsEof: boolean; |
897 |
|
end; |
898 |
|
end; |
899 |
|
|
900 |
< |
procedure TIBXINPUTSQLDA.FreeMessageBuffer; |
900 |
> |
procedure TIBXINPUTSQLDA.FreeCurMetaData; |
901 |
|
begin |
902 |
|
if FCurMetaData <> nil then |
903 |
|
begin |
904 |
|
FCurMetaData.release; |
905 |
|
FCurMetaData := nil; |
906 |
|
end; |
593 |
– |
if FMessageBuffer <> nil then |
594 |
– |
begin |
595 |
– |
FreeMem(FMessageBuffer); |
596 |
– |
FMessageBuffer := nil; |
597 |
– |
end; |
598 |
– |
FMsgLength := 0; |
907 |
|
end; |
908 |
|
|
909 |
|
function TIBXINPUTSQLDA.GetMessageBuffer: PByte; |
914 |
|
|
915 |
|
function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata; |
916 |
|
begin |
917 |
< |
PackBuffer; |
917 |
> |
BuildMetadata; |
918 |
|
Result := FCurMetaData; |
919 |
+ |
if Result <> nil then |
920 |
+ |
Result.addRef; |
921 |
|
end; |
922 |
|
|
923 |
|
function TIBXINPUTSQLDA.GetMsgLength: integer; |
926 |
|
Result := FMsgLength; |
927 |
|
end; |
928 |
|
|
929 |
< |
procedure TIBXINPUTSQLDA.PackBuffer; |
929 |
> |
procedure TIBXINPUTSQLDA.BuildMetadata; |
930 |
|
var Builder: Firebird.IMetadataBuilder; |
931 |
|
i: integer; |
932 |
+ |
version: NativeInt; |
933 |
|
begin |
934 |
< |
if FMsgLength > 0 then Exit; |
935 |
< |
|
625 |
< |
with Firebird30ClientAPI do |
934 |
> |
if (FCurMetaData = nil) and (Count > 0) then |
935 |
> |
with FFirebird30ClientAPI do |
936 |
|
begin |
937 |
< |
Builder := inherited MetaData.getBuilder(StatusIntf); |
937 |
> |
Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count); |
938 |
|
Check4DataBaseError; |
939 |
|
try |
940 |
|
for i := 0 to Count - 1 do |
941 |
|
with TIBXSQLVar(Column[i]) do |
942 |
|
begin |
943 |
+ |
version := Builder.vtable.version; |
944 |
+ |
if version >= 4 then |
945 |
+ |
{Firebird 4 or later} |
946 |
+ |
begin |
947 |
+ |
Builder.setField(StatusIntf,i,PAnsiChar(Name)); |
948 |
+ |
Check4DataBaseError; |
949 |
+ |
Builder.setAlias(StatusIntf,i,PAnsiChar(Name)); |
950 |
+ |
Check4DataBaseError; |
951 |
+ |
end; |
952 |
|
Builder.setType(StatusIntf,i,FSQLType); |
953 |
|
Check4DataBaseError; |
954 |
|
Builder.setSubType(StatusIntf,i,FSQLSubType); |
955 |
|
Check4DataBaseError; |
956 |
< |
Builder.setLength(StatusIntf,i,FDataLength); |
956 |
> |
// writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength); |
957 |
> |
if FSQLType = SQL_VARYING then |
958 |
> |
begin |
959 |
> |
{The datalength can be greater than the metadata size when SQLType has been overridden to text} |
960 |
> |
if (GetDataLength > GetSize) and CanChangeMetaData then |
961 |
> |
Builder.setLength(StatusIntf,i,GetDataLength) |
962 |
> |
else |
963 |
> |
Builder.setLength(StatusIntf,i,GetSize) |
964 |
> |
end |
965 |
> |
else |
966 |
> |
Builder.setLength(StatusIntf,i,GetDataLength); |
967 |
|
Check4DataBaseError; |
968 |
|
Builder.setCharSet(StatusIntf,i,GetCharSetID); |
969 |
|
Check4DataBaseError; |
975 |
|
finally |
976 |
|
Builder.release; |
977 |
|
end; |
978 |
+ |
end; |
979 |
+ |
end; |
980 |
|
|
981 |
< |
FMsgLength := FCurMetaData.getMessageLength(StatusIntf); |
981 |
> |
procedure TIBXINPUTSQLDA.PackBuffer; |
982 |
> |
var i: integer; |
983 |
> |
P: PByte; |
984 |
> |
MsgLen: cardinal; |
985 |
> |
aNullIndicator: short; |
986 |
> |
begin |
987 |
> |
BuildMetadata; |
988 |
> |
|
989 |
> |
if (FMsgLength = 0) and (FCurMetaData <> nil) then |
990 |
> |
with FFirebird30ClientAPI do |
991 |
> |
begin |
992 |
> |
MsgLen := FCurMetaData.getMessageLength(StatusIntf); |
993 |
|
Check4DataBaseError; |
994 |
|
|
995 |
< |
IBAlloc(FMessageBuffer,0,FMsgLength); |
995 |
> |
AllocMessageBuffer(MsgLen); |
996 |
|
|
997 |
|
for i := 0 to Count - 1 do |
998 |
|
with TIBXSQLVar(Column[i]) do |
999 |
|
begin |
1000 |
+ |
P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i); |
1001 |
+ |
// writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength); |
1002 |
+ |
if not Modified then |
1003 |
+ |
IBError(ibxeUninitializedInputParameter,[i,Name]); |
1004 |
|
if IsNull then |
1005 |
< |
FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0) |
1005 |
> |
FillChar(P^,FDataLength,0) |
1006 |
|
else |
1007 |
< |
Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength); |
1008 |
< |
Check4DataBaseError; |
1007 |
> |
if FSQLData <> nil then |
1008 |
> |
begin |
1009 |
> |
if SQLType = SQL_VARYING then |
1010 |
> |
begin |
1011 |
> |
EncodeInteger(FDataLength,2,P); |
1012 |
> |
Inc(P,2); |
1013 |
> |
end |
1014 |
> |
else |
1015 |
> |
if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then |
1016 |
> |
begin |
1017 |
> |
FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData)); |
1018 |
> |
Check4DatabaseError; |
1019 |
> |
end; |
1020 |
> |
Move(FSQLData^,P^,FDataLength); |
1021 |
> |
end; |
1022 |
|
if IsNullable then |
1023 |
|
begin |
1024 |
|
Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator)); |
1025 |
|
Check4DataBaseError; |
1026 |
+ |
end |
1027 |
+ |
else |
1028 |
+ |
begin |
1029 |
+ |
aNullIndicator := 0; |
1030 |
+ |
Move(aNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(aNullIndicator)); |
1031 |
|
end; |
1032 |
|
end; |
1033 |
|
end; |
1036 |
|
procedure TIBXINPUTSQLDA.FreeXSQLDA; |
1037 |
|
begin |
1038 |
|
inherited FreeXSQLDA; |
1039 |
< |
FreeMessageBuffer; |
1039 |
> |
FreeCurMetaData; |
1040 |
|
end; |
1041 |
|
|
1042 |
|
constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement); |
1045 |
|
FMessageBuffer := nil; |
1046 |
|
end; |
1047 |
|
|
1048 |
+ |
constructor TIBXINPUTSQLDA.Create(api: IFirebirdAPI); |
1049 |
+ |
begin |
1050 |
+ |
inherited Create(api); |
1051 |
+ |
FMessageBuffer := nil; |
1052 |
+ |
end; |
1053 |
+ |
|
1054 |
|
destructor TIBXINPUTSQLDA.Destroy; |
1055 |
|
begin |
1056 |
< |
FreeMessageBuffer; |
1056 |
> |
FreeXSQLDA; |
1057 |
|
inherited Destroy; |
1058 |
|
end; |
1059 |
|
|
1061 |
|
var i: integer; |
1062 |
|
begin |
1063 |
|
FMetaData := aMetaData; |
1064 |
< |
with Firebird30ClientAPI do |
1064 |
> |
FMetaData.AddRef; |
1065 |
> |
with FFirebird30ClientAPI do |
1066 |
|
begin |
1067 |
< |
Count := metadata.getCount(StatusIntf); |
1067 |
> |
Count := aMetadata.getCount(StatusIntf); |
1068 |
|
Check4DataBaseError; |
1069 |
|
Initialize; |
1070 |
|
|
1071 |
|
for i := 0 to Count - 1 do |
1072 |
|
with TIBXSQLVar(Column[i]) do |
1073 |
|
begin |
1074 |
< |
FSQLType := aMetaData.getType(StatusIntf,i); |
1075 |
< |
Check4DataBaseError; |
705 |
< |
if FSQLType = SQL_BLOB then |
706 |
< |
begin |
707 |
< |
FSQLSubType := aMetaData.getSubType(StatusIntf,i); |
708 |
< |
Check4DataBaseError; |
709 |
< |
end |
710 |
< |
else |
711 |
< |
FSQLSubType := 0; |
712 |
< |
FDataLength := aMetaData.getLength(StatusIntf,i); |
713 |
< |
Check4DataBaseError; |
714 |
< |
case SQLType of |
715 |
< |
SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP, |
716 |
< |
SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN, |
717 |
< |
SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
718 |
< |
begin |
719 |
< |
if (FDataLength = 0) then |
720 |
< |
{ Make sure you get a valid pointer anyway |
721 |
< |
select '' from foo } |
722 |
< |
IBAlloc(FSQLData, 0, 1) |
723 |
< |
else |
724 |
< |
IBAlloc(FSQLData, 0, FDataLength) |
725 |
< |
end; |
726 |
< |
SQL_VARYING: |
727 |
< |
IBAlloc(FSQLData, 0, FDataLength + 2); |
728 |
< |
else |
729 |
< |
IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)]) |
730 |
< |
end; |
731 |
< |
FNullable := aMetaData.isNullable(StatusIntf,i); |
732 |
< |
FOwnsSQLData := true; |
733 |
< |
Check4DataBaseError; |
734 |
< |
FNullIndicator := -1; |
1074 |
> |
InitColumnMetaData(aMetaData); |
1075 |
> |
SaveMetaData; |
1076 |
|
if FNullable then |
1077 |
|
FSQLNullIndicator := @FNullIndicator |
1078 |
|
else |
1079 |
|
FSQLNullIndicator := nil; |
1080 |
< |
FScale := aMetaData.getScale(StatusIntf,i); |
740 |
< |
Check4DataBaseError; |
741 |
< |
FCharSetID := aMetaData.getCharSet(StatusIntf,i); |
742 |
< |
Check4DataBaseError; |
1080 |
> |
ColumnSQLDataInit; |
1081 |
|
end; |
1082 |
|
end; |
1083 |
|
end; |
1085 |
|
procedure TIBXINPUTSQLDA.Changed; |
1086 |
|
begin |
1087 |
|
inherited Changed; |
1088 |
+ |
FreeCurMetaData; |
1089 |
|
FreeMessageBuffer; |
1090 |
|
end; |
1091 |
|
|
1092 |
+ |
procedure TIBXINPUTSQLDA.ReInitialise; |
1093 |
+ |
var i: integer; |
1094 |
+ |
begin |
1095 |
+ |
FreeMessageBuffer; |
1096 |
+ |
for i := 0 to Count - 1 do |
1097 |
+ |
TIBXSQLVar(Column[i]).ColumnSQLDataInit; |
1098 |
+ |
end; |
1099 |
+ |
|
1100 |
|
function TIBXINPUTSQLDA.IsInputDataArea: boolean; |
1101 |
|
begin |
1102 |
|
Result := true; |
1104 |
|
|
1105 |
|
{ TIBXOUTPUTSQLDA } |
1106 |
|
|
1107 |
< |
procedure TIBXOUTPUTSQLDA.FreeXSQLDA; |
1107 |
> |
function TIBXOUTPUTSQLDA.GetTransaction: ITransaction; |
1108 |
|
begin |
1109 |
< |
inherited FreeXSQLDA; |
1110 |
< |
FreeMem(FMessageBuffer); |
1111 |
< |
FMessageBuffer := nil; |
1112 |
< |
FMsgLength := 0; |
1109 |
> |
if FTransaction <> nil then |
1110 |
> |
Result := FTransaction |
1111 |
> |
else |
1112 |
> |
Result := inherited GetTransaction; |
1113 |
|
end; |
1114 |
|
|
1115 |
|
procedure TIBXOUTPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata); |
1116 |
|
var i: integer; |
1117 |
+ |
MsgLen: cardinal; |
1118 |
|
begin |
1119 |
|
FMetaData := aMetaData; |
1120 |
< |
with Firebird30ClientAPI do |
1120 |
> |
FMetaData.AddRef; |
1121 |
> |
with FFirebird30ClientAPI do |
1122 |
|
begin |
1123 |
< |
Count := metadata.getCount(StatusIntf); |
1123 |
> |
Count := aMetaData.getCount(StatusIntf); |
1124 |
|
Check4DataBaseError; |
1125 |
|
Initialize; |
1126 |
|
|
1127 |
< |
FMsgLength := metaData.getMessageLength(StatusIntf); |
1127 |
> |
MsgLen := aMetaData.getMessageLength(StatusIntf); |
1128 |
|
Check4DataBaseError; |
1129 |
< |
IBAlloc(FMessageBuffer,0,FMsgLength); |
1129 |
> |
AllocMessageBuffer(MsgLen); |
1130 |
|
|
1131 |
|
for i := 0 to Count - 1 do |
1132 |
|
with TIBXSQLVar(Column[i]) do |
1133 |
|
begin |
1134 |
< |
FSQLType := aMetaData.getType(StatusIntf,i); |
1135 |
< |
Check4DataBaseError; |
787 |
< |
if FSQLType = SQL_BLOB then |
788 |
< |
begin |
789 |
< |
FSQLSubType := aMetaData.getSubType(StatusIntf,i); |
790 |
< |
Check4DataBaseError; |
791 |
< |
end |
792 |
< |
else |
793 |
< |
FSQLSubType := 0; |
794 |
< |
FBlob := nil; |
795 |
< |
FArray := nil; |
796 |
< |
FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i); |
797 |
< |
Check4DataBaseError; |
798 |
< |
FDataLength := aMetaData.getLength(StatusIntf,i); |
799 |
< |
Check4DataBaseError; |
800 |
< |
FRelationName := strpas(aMetaData.getRelation(StatusIntf,i)); |
801 |
< |
Check4DataBaseError; |
802 |
< |
FFieldName := strpas(aMetaData.getField(StatusIntf,i)); |
803 |
< |
Check4DataBaseError; |
804 |
< |
FNullable := aMetaData.isNullable(StatusIntf,i); |
1134 |
> |
InitColumnMetaData(aMetaData); |
1135 |
> |
FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i); |
1136 |
|
Check4DataBaseError; |
1137 |
|
if FNullable then |
1138 |
|
begin |
1141 |
|
end |
1142 |
|
else |
1143 |
|
FSQLNullIndicator := nil; |
1144 |
< |
FScale := aMetaData.getScale(StatusIntf,i); |
1145 |
< |
Check4DataBaseError; |
815 |
< |
FCharSetID := aMetaData.getCharSet(StatusIntf,i); |
816 |
< |
Check4DataBaseError; |
1144 |
> |
FBlob := nil; |
1145 |
> |
FArrayIntf := nil; |
1146 |
|
end; |
1147 |
|
end; |
1148 |
|
SetUniqueRelationName; |
1158 |
|
len := FDataLength; |
1159 |
|
if not IsNull and (FSQLType = SQL_VARYING) then |
1160 |
|
begin |
1161 |
< |
with Firebird30ClientAPI do |
1161 |
> |
with FFirebird30ClientAPI do |
1162 |
|
len := DecodeInteger(data,2); |
1163 |
|
Inc(Data,2); |
1164 |
|
end; |
1175 |
|
begin |
1176 |
|
inherited Create; |
1177 |
|
FStatement := aStatement; |
1178 |
+ |
FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI; |
1179 |
|
FSize := 0; |
1180 |
|
// writeln('Creating ',ClassName); |
1181 |
|
end; |
1182 |
|
|
1183 |
+ |
constructor TIBXSQLDA.Create(api: IFirebirdAPI); |
1184 |
+ |
begin |
1185 |
+ |
inherited Create; |
1186 |
+ |
FStatement := nil; |
1187 |
+ |
FSize := 0; |
1188 |
+ |
FFirebird30ClientAPI := api as TFB30ClientAPI; |
1189 |
+ |
end; |
1190 |
+ |
|
1191 |
|
destructor TIBXSQLDA.Destroy; |
1192 |
|
begin |
1193 |
|
FreeXSQLDA; |
1203 |
|
function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean; |
1204 |
|
begin |
1205 |
|
Result := false; |
1206 |
+ |
if FStatement <> nil then |
1207 |
|
case Request of |
1208 |
|
ssPrepared: |
1209 |
|
Result := FStatement.IsPrepared; |
1210 |
|
|
1211 |
|
ssExecuteResults: |
1212 |
< |
Result :=FStatement.FSingleResults; |
1212 |
> |
Result := FStatement.FSingleResults; |
1213 |
|
|
1214 |
|
ssCursorOpen: |
1215 |
|
Result := FStatement.FOpen; |
1227 |
|
Result := FCount; |
1228 |
|
end; |
1229 |
|
|
891 |
– |
function TIBXSQLDA.GetTransaction: TFB30Transaction; |
892 |
– |
begin |
893 |
– |
Result := FStatement.GetTransaction as TFB30Transaction; |
894 |
– |
end; |
895 |
– |
|
1230 |
|
procedure TIBXSQLDA.Initialize; |
1231 |
|
begin |
1232 |
|
if FMetaData <> nil then |
1235 |
|
|
1236 |
|
function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean; |
1237 |
|
begin |
1238 |
< |
Result := FStatement.ChangeSeqNo <> ChangeSeqNo; |
1238 |
> |
Result := (FStatement <> nil) and (FStatement.ChangeSeqNo <> ChangeSeqNo); |
1239 |
|
if Result then |
1240 |
|
ChangeSeqNo := FStatement.ChangeSeqNo; |
1241 |
|
end; |
1242 |
|
|
1243 |
+ |
function TIBXSQLDA.CanChangeMetaData: boolean; |
1244 |
+ |
begin |
1245 |
+ |
Result := FStatement.FBatch = nil; |
1246 |
+ |
end; |
1247 |
+ |
|
1248 |
|
procedure TIBXSQLDA.SetCount(Value: Integer); |
1249 |
|
var |
1250 |
|
i: Integer; |
1261 |
|
end; |
1262 |
|
end; |
1263 |
|
|
1264 |
+ |
procedure TIBXSQLDA.AllocMessageBuffer(len: integer); |
1265 |
+ |
begin |
1266 |
+ |
with FFirebird30ClientAPI do |
1267 |
+ |
IBAlloc(FMessageBuffer,0,len); |
1268 |
+ |
FMsgLength := len; |
1269 |
+ |
end; |
1270 |
+ |
|
1271 |
+ |
procedure TIBXSQLDA.FreeMessageBuffer; |
1272 |
+ |
begin |
1273 |
+ |
if FMessageBuffer <> nil then |
1274 |
+ |
begin |
1275 |
+ |
FreeMem(FMessageBuffer); |
1276 |
+ |
FMessageBuffer := nil; |
1277 |
+ |
end; |
1278 |
+ |
FMsgLength := 0; |
1279 |
+ |
end; |
1280 |
+ |
|
1281 |
+ |
function TIBXSQLDA.GetMetaData: Firebird.IMessageMetadata; |
1282 |
+ |
begin |
1283 |
+ |
Result := FMetadata; |
1284 |
+ |
if Result <> nil then |
1285 |
+ |
Result.addRef; |
1286 |
+ |
end; |
1287 |
+ |
|
1288 |
|
function TIBXSQLDA.GetTransactionSeqNo: integer; |
1289 |
|
begin |
1290 |
|
Result := FTransactionSeqNo; |
1300 |
|
TIBXSQLVAR(Column[i]).FreeSQLData; |
1301 |
|
for i := 0 to FSize - 1 do |
1302 |
|
TIBXSQLVAR(Column[i]).Free; |
1303 |
+ |
FCount := 0; |
1304 |
|
SetLength(FColumnList,0); |
1305 |
|
FSize := 0; |
1306 |
+ |
FreeMessageBuffer; |
1307 |
|
end; |
1308 |
|
|
1309 |
|
function TIBXSQLDA.GetStatement: IStatement; |
1313 |
|
|
1314 |
|
function TIBXSQLDA.GetPrepareSeqNo: integer; |
1315 |
|
begin |
1316 |
< |
Result := FStatement.FPrepareSeqNo; |
1316 |
> |
if FStatement = nil then |
1317 |
> |
Result := 0 |
1318 |
> |
else |
1319 |
> |
Result := FStatement.FPrepareSeqNo; |
1320 |
|
end; |
1321 |
|
|
1322 |
|
{ TFB30Statement } |
1323 |
|
|
1324 |
+ |
procedure TFB30Statement.CheckChangeBatchRowLimit; |
1325 |
+ |
begin |
1326 |
+ |
if IsInBatchMode then |
1327 |
+ |
IBError(ibxeInBatchMode,[nil]); |
1328 |
+ |
end; |
1329 |
+ |
|
1330 |
|
procedure TFB30Statement.CheckHandle; |
1331 |
|
begin |
1332 |
|
if FStatementIntf = nil then |
1333 |
|
IBError(ibxeInvalidStatementHandle,[nil]); |
1334 |
|
end; |
1335 |
|
|
1336 |
+ |
procedure TFB30Statement.CheckBatchModeAvailable; |
1337 |
+ |
begin |
1338 |
+ |
if not HasBatchMode then |
1339 |
+ |
IBError(ibxeBatchModeNotSupported,[nil]); |
1340 |
+ |
case SQLStatementType of |
1341 |
+ |
SQLInsert, |
1342 |
+ |
SQLUpdate: {OK}; |
1343 |
+ |
else |
1344 |
+ |
IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]); |
1345 |
+ |
end; |
1346 |
+ |
end; |
1347 |
+ |
|
1348 |
|
procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults |
1349 |
|
); |
1350 |
|
begin |
1351 |
< |
with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do |
1351 |
> |
with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do |
1352 |
|
begin |
1353 |
|
StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request), |
1354 |
|
GetBufSize, BytePtr(Buffer)); |
1356 |
|
end; |
1357 |
|
end; |
1358 |
|
|
1359 |
< |
procedure TFB30Statement.InternalPrepare; |
1359 |
> |
function TFB30Statement.GetStatementIntf: IStatement; |
1360 |
> |
begin |
1361 |
> |
Result := self; |
1362 |
> |
end; |
1363 |
> |
|
1364 |
> |
procedure TFB30Statement.InternalPrepare(CursorName: AnsiString); |
1365 |
> |
var GUID : TGUID; |
1366 |
> |
metadata: Firebird.IMessageMetadata; |
1367 |
|
begin |
1368 |
|
if FPrepared then |
1369 |
|
Exit; |
1370 |
+ |
|
1371 |
+ |
FCursor := CursorName; |
1372 |
|
if (FSQL = '') then |
1373 |
|
IBError(ibxeEmptyQuery, [nil]); |
1374 |
|
try |
1375 |
|
CheckTransaction(FTransactionIntf); |
1376 |
< |
with Firebird30ClientAPI do |
1376 |
> |
with FFirebird30ClientAPI do |
1377 |
|
begin |
1378 |
+ |
if FCursor = '' then |
1379 |
+ |
begin |
1380 |
+ |
CreateGuid(GUID); |
1381 |
+ |
FCursor := GUIDToString(GUID); |
1382 |
+ |
end; |
1383 |
+ |
|
1384 |
|
if FHasParamNames then |
1385 |
|
begin |
1386 |
|
if FProcessedSQL = '' then |
1387 |
< |
FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL); |
1387 |
> |
ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL); |
1388 |
|
FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf, |
1389 |
|
(FTransactionIntf as TFB30Transaction).TransactionIntf, |
1390 |
|
Length(FProcessedSQL), |
1403 |
|
FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf)); |
1404 |
|
Check4DataBaseError; |
1405 |
|
|
1406 |
+ |
if FSQLStatementType = SQLSelect then |
1407 |
+ |
begin |
1408 |
+ |
FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor)); |
1409 |
+ |
Check4DataBaseError; |
1410 |
+ |
end; |
1411 |
|
{ Done getting the type } |
1412 |
|
case FSQLStatementType of |
1413 |
|
SQLGetSegment, |
1424 |
|
SQLExecProcedure: |
1425 |
|
begin |
1426 |
|
{set up input sqlda} |
1427 |
< |
FSQLParams.Bind(FStatementIntf.getInputMetadata(StatusIntf)); |
1427 |
> |
metadata := FStatementIntf.getInputMetadata(StatusIntf); |
1428 |
|
Check4DataBaseError; |
1429 |
+ |
try |
1430 |
+ |
FSQLParams.Bind(metadata); |
1431 |
+ |
finally |
1432 |
+ |
metadata.release; |
1433 |
+ |
end; |
1434 |
|
|
1435 |
|
{setup output sqlda} |
1436 |
|
if FSQLStatementType in [SQLSelect, SQLSelectForUpdate, |
1437 |
|
SQLExecProcedure] then |
1438 |
< |
FSQLRecord.Bind(FStatementIntf.getOutputMetadata(StatusIntf)); |
1439 |
< |
Check4DataBaseError; |
1438 |
> |
begin |
1439 |
> |
metadata := FStatementIntf.getOutputMetadata(StatusIntf); |
1440 |
> |
Check4DataBaseError; |
1441 |
> |
try |
1442 |
> |
FSQLRecord.Bind(metadata); |
1443 |
> |
finally |
1444 |
> |
metadata.release; |
1445 |
> |
end; |
1446 |
> |
end; |
1447 |
|
end; |
1448 |
|
end; |
1449 |
|
end; |
1452 |
|
if (FStatementIntf <> nil) then |
1453 |
|
FreeHandle; |
1454 |
|
if E is EIBInterBaseError then |
1455 |
< |
raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode, |
1456 |
< |
EIBInterBaseError(E).IBErrorCode, |
1039 |
< |
EIBInterBaseError(E).Message + |
1040 |
< |
sSQLErrorSeparator + FSQL) |
1041 |
< |
else |
1042 |
< |
raise; |
1455 |
> |
E.Message := E.Message + sSQLErrorSeparator + FSQL; |
1456 |
> |
raise; |
1457 |
|
end; |
1458 |
|
end; |
1459 |
|
FPrepared := true; |
1460 |
+ |
|
1461 |
|
FSingleResults := false; |
1462 |
|
if RetainInterfaces then |
1463 |
|
begin |
1475 |
|
end; |
1476 |
|
|
1477 |
|
function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults; |
1478 |
+ |
|
1479 |
+ |
procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil); |
1480 |
+ |
var inMetadata: Firebird.IMessageMetaData; |
1481 |
+ |
begin |
1482 |
+ |
with FFirebird30ClientAPI do |
1483 |
+ |
begin |
1484 |
+ |
SavePerfStats(FBeforeStats); |
1485 |
+ |
inMetadata := FSQLParams.GetMetaData; |
1486 |
+ |
try |
1487 |
+ |
FStatementIntf.execute(StatusIntf, |
1488 |
+ |
(aTransaction as TFB30Transaction).TransactionIntf, |
1489 |
+ |
inMetaData, |
1490 |
+ |
FSQLParams.MessageBuffer, |
1491 |
+ |
outMetaData, |
1492 |
+ |
outBuffer); |
1493 |
+ |
Check4DataBaseError; |
1494 |
+ |
finally |
1495 |
+ |
if inMetadata <> nil then |
1496 |
+ |
inMetadata.release; |
1497 |
+ |
end; |
1498 |
+ |
FStatisticsAvailable := SavePerfStats(FAfterStats); |
1499 |
+ |
end; |
1500 |
+ |
end; |
1501 |
+ |
|
1502 |
+ |
var Cursor: IResultSet; |
1503 |
+ |
outMetadata: Firebird.IMessageMetaData; |
1504 |
+ |
|
1505 |
|
begin |
1506 |
|
Result := nil; |
1507 |
+ |
FBatchCompletion := nil; |
1508 |
|
FBOF := false; |
1509 |
|
FEOF := false; |
1510 |
|
FSingleResults := false; |
1511 |
+ |
FStatisticsAvailable := false; |
1512 |
+ |
if IsInBatchMode then |
1513 |
+ |
IBerror(ibxeInBatchMode,[]); |
1514 |
|
CheckTransaction(aTransaction); |
1515 |
|
if not FPrepared then |
1516 |
|
InternalPrepare; |
1517 |
|
CheckHandle; |
1518 |
|
if aTransaction <> FTransactionIntf then |
1519 |
|
AddMonitor(aTransaction as TFB30Transaction); |
1520 |
< |
if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then |
1520 |
> |
if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then |
1521 |
|
IBError(ibxeInterfaceOutofDate,[nil]); |
1522 |
|
|
1523 |
+ |
|
1524 |
|
try |
1525 |
< |
with Firebird30ClientAPI do |
1525 |
> |
with FFirebird30ClientAPI do |
1526 |
|
begin |
1080 |
– |
if FCollectStatistics then |
1081 |
– |
begin |
1082 |
– |
UtilIntf.getPerfCounters(StatusIntf, |
1083 |
– |
(GetAttachment as TFB30Attachment).AttachmentIntf, |
1084 |
– |
ISQL_COUNTERS,@FBeforeStats); |
1085 |
– |
Check4DataBaseError; |
1086 |
– |
end; |
1087 |
– |
|
1527 |
|
case FSQLStatementType of |
1528 |
|
SQLSelect: |
1529 |
< |
IBError(ibxeIsAExecuteProcedure,[]); |
1529 |
> |
{e.g. Update...returning with a single row in Firebird 5 and later} |
1530 |
> |
begin |
1531 |
> |
Cursor := InternalOpenCursor(aTransaction,false); |
1532 |
> |
if not Cursor.IsEof then |
1533 |
> |
Cursor.FetchNext; |
1534 |
> |
Result := Cursor; {note only first row} |
1535 |
> |
FSingleResults := true; |
1536 |
> |
end; |
1537 |
|
|
1538 |
|
SQLExecProcedure: |
1539 |
|
begin |
1540 |
< |
FStatementIntf.execute(StatusIntf, |
1541 |
< |
(aTransaction as TFB30Transaction).TransactionIntf, |
1542 |
< |
FSQLParams.MetaData, |
1543 |
< |
FSQLParams.MessageBuffer, |
1544 |
< |
FSQLRecord.MetaData, |
1545 |
< |
FSQLRecord.MessageBuffer); |
1546 |
< |
Check4DataBaseError; |
1540 |
> |
outMetadata := FSQLRecord.GetMetaData; |
1541 |
> |
try |
1542 |
> |
ExecuteQuery(outMetadata,FSQLRecord.MessageBuffer); |
1543 |
> |
Result := TResults.Create(FSQLRecord); |
1544 |
> |
FSingleResults := true; |
1545 |
> |
finally |
1546 |
> |
if outMetadata <> nil then |
1547 |
> |
outMetadata.release; |
1548 |
> |
end; |
1549 |
> |
end; |
1550 |
|
|
1102 |
– |
Result := TResults.Create(FSQLRecord); |
1103 |
– |
FSingleResults := true; |
1104 |
– |
end |
1551 |
|
else |
1552 |
< |
FStatementIntf.execute(StatusIntf, |
1107 |
< |
(aTransaction as TFB30Transaction).TransactionIntf, |
1108 |
< |
FSQLParams.MetaData, |
1109 |
< |
FSQLParams.MessageBuffer, |
1110 |
< |
nil, |
1111 |
< |
nil); |
1112 |
< |
Check4DataBaseError; |
1113 |
< |
end; |
1114 |
< |
if FCollectStatistics then |
1115 |
< |
begin |
1116 |
< |
UtilIntf.getPerfCounters(StatusIntf, |
1117 |
< |
(GetAttachment as TFB30Attachment).AttachmentIntf, |
1118 |
< |
ISQL_COUNTERS, @FAfterStats); |
1119 |
< |
Check4DataBaseError; |
1120 |
< |
FStatisticsAvailable := true; |
1552 |
> |
ExecuteQuery; |
1553 |
|
end; |
1554 |
|
end; |
1555 |
|
finally |
1557 |
|
RemoveMonitor(aTransaction as TFB30Transaction); |
1558 |
|
end; |
1559 |
|
FExecTransactionIntf := aTransaction; |
1560 |
+ |
FSQLRecord.FTransaction := (aTransaction as TFB30Transaction); |
1561 |
+ |
FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo; |
1562 |
|
SignalActivity; |
1563 |
|
Inc(FChangeSeqNo); |
1564 |
|
end; |
1565 |
|
|
1566 |
< |
function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction |
1567 |
< |
): IResultSet; |
1566 |
> |
function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction; |
1567 |
> |
Scrollable: boolean): IResultSet; |
1568 |
> |
var flags: cardinal; |
1569 |
> |
inMetadata, |
1570 |
> |
outMetadata: Firebird.IMessageMetadata; |
1571 |
|
begin |
1572 |
< |
if FSQLStatementType <> SQLSelect then |
1572 |
> |
flags := 0; |
1573 |
> |
if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then |
1574 |
|
IBError(ibxeIsASelectStatement,[]); |
1575 |
|
|
1576 |
< |
CheckTransaction(aTransaction); |
1576 |
> |
FBatchCompletion := nil; |
1577 |
> |
CheckTransaction(aTransaction); |
1578 |
|
if not FPrepared then |
1579 |
|
InternalPrepare; |
1580 |
|
CheckHandle; |
1581 |
|
if aTransaction <> FTransactionIntf then |
1582 |
|
AddMonitor(aTransaction as TFB30Transaction); |
1583 |
< |
if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then |
1583 |
> |
if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then |
1584 |
|
IBError(ibxeInterfaceOutofDate,[nil]); |
1585 |
|
|
1586 |
< |
with Firebird30ClientAPI do |
1586 |
> |
if Scrollable then |
1587 |
> |
flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE; |
1588 |
> |
|
1589 |
> |
with FFirebird30ClientAPI do |
1590 |
|
begin |
1591 |
|
if FCollectStatistics then |
1592 |
|
begin |
1596 |
|
Check4DataBaseError; |
1597 |
|
end; |
1598 |
|
|
1599 |
< |
FResultSet := FStatementIntf.openCursor(StatusIntf, |
1599 |
> |
inMetadata := FSQLParams.GetMetaData; |
1600 |
> |
outMetadata := FSQLRecord.GetMetaData; |
1601 |
> |
try |
1602 |
> |
FResultSet := FStatementIntf.openCursor(StatusIntf, |
1603 |
|
(aTransaction as TFB30Transaction).TransactionIntf, |
1604 |
< |
FSQLParams.MetaData, |
1604 |
> |
inMetaData, |
1605 |
|
FSQLParams.MessageBuffer, |
1606 |
< |
FSQLRecord.MetaData, |
1607 |
< |
0); |
1608 |
< |
Check4DataBaseError; |
1606 |
> |
outMetaData, |
1607 |
> |
flags); |
1608 |
> |
Check4DataBaseError; |
1609 |
> |
finally |
1610 |
> |
if inMetadata <> nil then |
1611 |
> |
inMetadata.release; |
1612 |
> |
if outMetadata <> nil then |
1613 |
> |
outMetadata.release; |
1614 |
> |
end; |
1615 |
|
|
1616 |
|
if FCollectStatistics then |
1617 |
|
begin |
1635 |
|
Inc(FChangeSeqNo); |
1636 |
|
end; |
1637 |
|
|
1638 |
+ |
procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; |
1639 |
+ |
var processedSQL: AnsiString); |
1640 |
+ |
begin |
1641 |
+ |
FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL); |
1642 |
+ |
end; |
1643 |
+ |
|
1644 |
|
procedure TFB30Statement.FreeHandle; |
1645 |
|
begin |
1646 |
|
Close; |
1647 |
|
ReleaseInterfaces; |
1648 |
+ |
if FBatch <> nil then |
1649 |
+ |
begin |
1650 |
+ |
FBatch.release; |
1651 |
+ |
FBatch := nil; |
1652 |
+ |
end; |
1653 |
|
if FStatementIntf <> nil then |
1654 |
|
begin |
1655 |
|
FStatementIntf.release; |
1656 |
|
FStatementIntf := nil; |
1657 |
|
FPrepared := false; |
1658 |
|
end; |
1659 |
+ |
FCursor := ''; |
1660 |
|
end; |
1661 |
|
|
1662 |
|
procedure TFB30Statement.InternalClose(Force: boolean); |
1663 |
|
begin |
1664 |
|
if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then |
1665 |
|
try |
1666 |
< |
with Firebird30ClientAPI do |
1666 |
> |
with FFirebird30ClientAPI do |
1667 |
|
begin |
1668 |
|
if FResultSet <> nil then |
1669 |
|
begin |
1687 |
|
Inc(FChangeSeqNo); |
1688 |
|
end; |
1689 |
|
|
1690 |
+ |
function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean; |
1691 |
+ |
begin |
1692 |
+ |
Result := false; |
1693 |
+ |
if FCollectStatistics then |
1694 |
+ |
with FFirebird30ClientAPI do |
1695 |
+ |
begin |
1696 |
+ |
UtilIntf.getPerfCounters(StatusIntf, |
1697 |
+ |
(GetAttachment as TFB30Attachment).AttachmentIntf, |
1698 |
+ |
ISQL_COUNTERS, @Stats); |
1699 |
+ |
Check4DataBaseError; |
1700 |
+ |
Result := true; |
1701 |
+ |
end; |
1702 |
+ |
end; |
1703 |
+ |
|
1704 |
|
constructor TFB30Statement.Create(Attachment: TFB30Attachment; |
1705 |
< |
Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); |
1705 |
> |
Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; |
1706 |
> |
CursorName: AnsiString); |
1707 |
|
begin |
1708 |
|
inherited Create(Attachment,Transaction,sql,aSQLDialect); |
1709 |
+ |
FFirebird30ClientAPI := Attachment.Firebird30ClientAPI; |
1710 |
|
FSQLParams := TIBXINPUTSQLDA.Create(self); |
1711 |
|
FSQLRecord := TIBXOUTPUTSQLDA.Create(self); |
1712 |
< |
InternalPrepare; |
1712 |
> |
InternalPrepare(CursorName); |
1713 |
|
end; |
1714 |
|
|
1715 |
|
constructor TFB30Statement.CreateWithParameterNames( |
1716 |
|
Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString; |
1717 |
< |
aSQLDialect: integer; GenerateParamNames: boolean); |
1717 |
> |
aSQLDialect: integer; GenerateParamNames: boolean; |
1718 |
> |
CaseSensitiveParams: boolean; CursorName: AnsiString); |
1719 |
|
begin |
1720 |
|
inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames); |
1721 |
+ |
FFirebird30ClientAPI := Attachment.Firebird30ClientAPI; |
1722 |
|
FSQLParams := TIBXINPUTSQLDA.Create(self); |
1723 |
+ |
FSQLParams.CaseSensitiveParams := CaseSensitiveParams; |
1724 |
|
FSQLRecord := TIBXOUTPUTSQLDA.Create(self); |
1725 |
< |
InternalPrepare; |
1725 |
> |
InternalPrepare(CursorName); |
1726 |
|
end; |
1727 |
|
|
1728 |
|
destructor TFB30Statement.Destroy; |
1732 |
|
if assigned(FSQLRecord) then FSQLRecord.Free; |
1733 |
|
end; |
1734 |
|
|
1735 |
< |
function TFB30Statement.FetchNext: boolean; |
1735 |
> |
function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer |
1736 |
> |
): boolean; |
1737 |
|
var fetchResult: integer; |
1738 |
|
begin |
1739 |
< |
result := false; |
1739 |
> |
result := false; |
1740 |
|
if not FOpen then |
1741 |
|
IBError(ibxeSQLClosed, [nil]); |
1259 |
– |
if FEOF then |
1260 |
– |
IBError(ibxeEOF,[nil]); |
1742 |
|
|
1743 |
< |
with Firebird30ClientAPI do |
1743 |
> |
with FFirebird30ClientAPI do |
1744 |
|
begin |
1745 |
< |
{ Go to the next record... } |
1746 |
< |
fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer); |
1747 |
< |
if fetchResult = Firebird.IStatus.RESULT_NO_DATA then |
1748 |
< |
begin |
1749 |
< |
FBOF := false; |
1750 |
< |
FEOF := true; |
1751 |
< |
Exit; {End of File} |
1752 |
< |
end |
1753 |
< |
else |
1754 |
< |
if fetchResult <> Firebird.IStatus.RESULT_OK then |
1755 |
< |
begin |
1756 |
< |
try |
1757 |
< |
IBDataBaseError; |
1277 |
< |
except |
1278 |
< |
Close; |
1279 |
< |
raise; |
1745 |
> |
case FetchType of |
1746 |
> |
ftNext: |
1747 |
> |
begin |
1748 |
> |
if FEOF then |
1749 |
> |
IBError(ibxeEOF,[nil]); |
1750 |
> |
{ Go to the next record... } |
1751 |
> |
fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer); |
1752 |
> |
if fetchResult = Firebird.IStatus.RESULT_NO_DATA then |
1753 |
> |
begin |
1754 |
> |
FBOF := false; |
1755 |
> |
FEOF := true; |
1756 |
> |
Exit; {End of File} |
1757 |
> |
end |
1758 |
|
end; |
1759 |
< |
end |
1760 |
< |
else |
1759 |
> |
|
1760 |
> |
ftPrior: |
1761 |
> |
begin |
1762 |
> |
if FBOF then |
1763 |
> |
IBError(ibxeBOF,[nil]); |
1764 |
> |
{ Go to the next record... } |
1765 |
> |
fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer); |
1766 |
> |
if fetchResult = Firebird.IStatus.RESULT_NO_DATA then |
1767 |
> |
begin |
1768 |
> |
FBOF := true; |
1769 |
> |
FEOF := false; |
1770 |
> |
Exit; {Top of File} |
1771 |
> |
end |
1772 |
> |
end; |
1773 |
> |
|
1774 |
> |
ftFirst: |
1775 |
> |
fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer); |
1776 |
> |
|
1777 |
> |
ftLast: |
1778 |
> |
fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer); |
1779 |
> |
|
1780 |
> |
ftAbsolute: |
1781 |
> |
fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer); |
1782 |
> |
|
1783 |
> |
ftRelative: |
1784 |
> |
fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer); |
1785 |
> |
end; |
1786 |
> |
|
1787 |
> |
Check4DataBaseError; |
1788 |
> |
if fetchResult <> Firebird.IStatus.RESULT_OK then |
1789 |
> |
exit; {result = false} |
1790 |
> |
|
1791 |
> |
{Result OK} |
1792 |
> |
FBOF := false; |
1793 |
> |
FEOF := false; |
1794 |
> |
result := true; |
1795 |
> |
|
1796 |
> |
if FCollectStatistics then |
1797 |
|
begin |
1798 |
< |
FBOF := false; |
1799 |
< |
result := true; |
1798 |
> |
UtilIntf.getPerfCounters(StatusIntf, |
1799 |
> |
(GetAttachment as TFB30Attachment).AttachmentIntf, |
1800 |
> |
ISQL_COUNTERS,@FAfterStats); |
1801 |
> |
Check4DataBaseError; |
1802 |
> |
FStatisticsAvailable := true; |
1803 |
|
end; |
1804 |
|
end; |
1805 |
|
FSQLRecord.RowChange; |
1832 |
|
SQLUpdate, SQLDelete])) then |
1833 |
|
result := '' |
1834 |
|
else |
1835 |
< |
with Firebird30ClientAPI do |
1835 |
> |
with FFirebird30ClientAPI do |
1836 |
|
begin |
1837 |
|
Result := FStatementIntf.getPlan(StatusIntf,true); |
1838 |
|
Check4DataBaseError; |
1866 |
|
TSQLParams(GetInterface(0)).RetainInterfaces := aValue; |
1867 |
|
end; |
1868 |
|
|
1869 |
+ |
function TFB30Statement.IsInBatchMode: boolean; |
1870 |
+ |
begin |
1871 |
+ |
Result := FBatch <> nil; |
1872 |
+ |
end; |
1873 |
+ |
|
1874 |
+ |
function TFB30Statement.HasBatchMode: boolean; |
1875 |
+ |
begin |
1876 |
+ |
Result := GetAttachment.HasBatchMode; |
1877 |
+ |
end; |
1878 |
+ |
|
1879 |
+ |
procedure TFB30Statement.AddToBatch; |
1880 |
+ |
var BatchPB: TXPBParameterBlock; |
1881 |
+ |
inMetadata: Firebird.IMessageMetadata; |
1882 |
+ |
|
1883 |
+ |
const SixteenMB = 16 * 1024 * 1024; |
1884 |
+ |
MB256 = 256* 1024 *1024; |
1885 |
+ |
begin |
1886 |
+ |
FBatchCompletion := nil; |
1887 |
+ |
if not FPrepared then |
1888 |
+ |
InternalPrepare; |
1889 |
+ |
CheckHandle; |
1890 |
+ |
CheckBatchModeAvailable; |
1891 |
+ |
inMetadata := FSQLParams.GetMetaData; |
1892 |
+ |
try |
1893 |
+ |
with FFirebird30ClientAPI do |
1894 |
+ |
begin |
1895 |
+ |
if FBatch = nil then |
1896 |
+ |
begin |
1897 |
+ |
{Start Batch} |
1898 |
+ |
BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH); |
1899 |
+ |
with FFirebird30ClientAPI do |
1900 |
+ |
try |
1901 |
+ |
if FBatchRowLimit = maxint then |
1902 |
+ |
FBatchBufferSize := MB256 |
1903 |
+ |
else |
1904 |
+ |
begin |
1905 |
+ |
FBatchBufferSize := FBatchRowLimit * inMetadata.getAlignedLength(StatusIntf); |
1906 |
+ |
Check4DatabaseError; |
1907 |
+ |
if FBatchBufferSize < SixteenMB then |
1908 |
+ |
FBatchBufferSize := SixteenMB; |
1909 |
+ |
if FBatchBufferSize > MB256 {assumed limit} then |
1910 |
+ |
IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]); |
1911 |
+ |
end; |
1912 |
+ |
BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1); |
1913 |
+ |
BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize); |
1914 |
+ |
FBatch := FStatementIntf.createBatch(StatusIntf, |
1915 |
+ |
inMetadata, |
1916 |
+ |
BatchPB.getDataLength, |
1917 |
+ |
BatchPB.getBuffer); |
1918 |
+ |
Check4DataBaseError; |
1919 |
+ |
|
1920 |
+ |
finally |
1921 |
+ |
BatchPB.Free; |
1922 |
+ |
end; |
1923 |
+ |
FBatchRowCount := 0; |
1924 |
+ |
FBatchBufferUsed := 0; |
1925 |
+ |
end; |
1926 |
+ |
|
1927 |
+ |
Inc(FBatchRowCount); |
1928 |
+ |
Inc(FBatchBufferUsed,inMetadata.getAlignedLength(StatusIntf)); |
1929 |
+ |
Check4DataBaseError; |
1930 |
+ |
if FBatchBufferUsed > FBatchBufferSize then |
1931 |
+ |
raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow), |
1932 |
+ |
Format(GetErrorMessage(ibxeBatchRowBufferOverflow), |
1933 |
+ |
[FBatchRowCount,FBatchBufferSize])); |
1934 |
+ |
|
1935 |
+ |
FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer); |
1936 |
+ |
Check4DataBaseError |
1937 |
+ |
end; |
1938 |
+ |
finally |
1939 |
+ |
if inMetadata <> nil then |
1940 |
+ |
inMetadata.release; |
1941 |
+ |
end; |
1942 |
+ |
end; |
1943 |
+ |
|
1944 |
+ |
function TFB30Statement.ExecuteBatch(aTransaction: ITransaction |
1945 |
+ |
): IBatchCompletion; |
1946 |
+ |
|
1947 |
+ |
procedure Check4BatchCompletionError(bc: IBatchCompletion); |
1948 |
+ |
var status: IStatus; |
1949 |
+ |
RowNo: integer; |
1950 |
+ |
begin |
1951 |
+ |
status := nil; |
1952 |
+ |
{Raise an exception if there was an error reported in the BatchCompletion} |
1953 |
+ |
if (bc <> nil) and bc.getErrorStatus(RowNo,status) then |
1954 |
+ |
raise EIBInterbaseError.Create(status); |
1955 |
+ |
end; |
1956 |
+ |
|
1957 |
+ |
var cs: Firebird.IBatchCompletionState; |
1958 |
+ |
|
1959 |
+ |
begin |
1960 |
+ |
Result := nil; |
1961 |
+ |
if FBatch = nil then |
1962 |
+ |
IBError(ibxeNotInBatchMode,[]); |
1963 |
+ |
|
1964 |
+ |
with FFirebird30ClientAPI do |
1965 |
+ |
begin |
1966 |
+ |
SavePerfStats(FBeforeStats); |
1967 |
+ |
if aTransaction = nil then |
1968 |
+ |
cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf) |
1969 |
+ |
else |
1970 |
+ |
cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf); |
1971 |
+ |
Check4DataBaseError; |
1972 |
+ |
FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs); |
1973 |
+ |
FStatisticsAvailable := SavePerfStats(FAfterStats); |
1974 |
+ |
FBatch.release; |
1975 |
+ |
FBatch := nil; |
1976 |
+ |
Check4BatchCompletionError(FBatchCompletion); |
1977 |
+ |
Result := FBatchCompletion; |
1978 |
+ |
end; |
1979 |
+ |
end; |
1980 |
+ |
|
1981 |
+ |
procedure TFB30Statement.CancelBatch; |
1982 |
+ |
begin |
1983 |
+ |
if FBatch = nil then |
1984 |
+ |
IBError(ibxeNotInBatchMode,[]); |
1985 |
+ |
FBatch.release; |
1986 |
+ |
FBatch := nil; |
1987 |
+ |
end; |
1988 |
+ |
|
1989 |
+ |
function TFB30Statement.GetBatchCompletion: IBatchCompletion; |
1990 |
+ |
begin |
1991 |
+ |
Result := FBatchCompletion; |
1992 |
+ |
end; |
1993 |
+ |
|
1994 |
|
function TFB30Statement.IsPrepared: boolean; |
1995 |
|
begin |
1996 |
|
Result := FStatementIntf <> nil; |
1997 |
|
end; |
1998 |
|
|
1999 |
+ |
function TFB30Statement.GetFlags: TStatementFlags; |
2000 |
+ |
var flags: cardinal; |
2001 |
+ |
begin |
2002 |
+ |
CheckHandle; |
2003 |
+ |
Result := []; |
2004 |
+ |
with FFirebird30ClientAPI do |
2005 |
+ |
begin |
2006 |
+ |
flags := FStatementIntf.getFlags(StatusIntf); |
2007 |
+ |
Check4DataBaseError; |
2008 |
+ |
end; |
2009 |
+ |
if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then |
2010 |
+ |
Result := Result + [stHasCursor]; |
2011 |
+ |
if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then |
2012 |
+ |
Result := Result + [stRepeatExecute]; |
2013 |
+ |
if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then |
2014 |
+ |
Result := Result + [stScrollable]; |
2015 |
+ |
end; |
2016 |
+ |
|
2017 |
|
end. |
2018 |
|
|