# | Line 25 | Line 25 | |
---|---|---|
25 | * | |
26 | *) | |
27 | unit FB30Statement; | |
28 | + | {$IFDEF MSWINDOWS} |
29 | + | {$DEFINE WINDOWS} |
30 | + | {$ENDIF} |
31 | ||
32 | {$IFDEF FPC} | |
33 | < | {$mode objfpc}{$H+} |
33 | > | {$mode delphi} |
34 | {$codepage UTF8} | |
35 | {$interfaces COM} | |
36 | {$ENDIF} | |
# | Line 75 | Line 78 | uses | |
78 | FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor; | |
79 | ||
80 | type | |
78 | – | |
81 | TFB30Statement = class; | |
82 | TIBXSQLDA = class; | |
83 | ||
# | Line 84 | Line 86 | type | |
86 | TIBXSQLVAR = class(TSQLVarData) | |
87 | private | |
88 | FStatement: TFB30Statement; | |
89 | + | FFirebird30ClientAPI: TFB30ClientAPI; |
90 | FBlob: IBlob; {Cache references} | |
88 | – | FArray: IArray; |
91 | FNullIndicator: short; | |
92 | FOwnsSQLData: boolean; | |
93 | FBlobMetaData: IBlobMetaData; | |
# | Line 94 | Line 96 | type | |
96 | {SQL Var Type Data} | |
97 | FSQLType: cardinal; | |
98 | FSQLSubType: integer; | |
99 | < | FSQLData: PChar; {Address of SQL Data in Message Buffer} |
99 | > | FSQLData: PByte; {Address of SQL Data in Message Buffer} |
100 | FSQLNullIndicator: PShort; {Address of null indicator} | |
101 | FDataLength: integer; | |
102 | + | FMetadataSize: integer; |
103 | FNullable: boolean; | |
104 | FScale: integer; | |
105 | FCharSetID: cardinal; | |
106 | < | FRelationName: string; |
107 | < | FFieldName: string; |
106 | > | FRelationName: AnsiString; |
107 | > | FFieldName: AnsiString; |
108 | ||
109 | protected | |
110 | + | function CanChangeSQLType: boolean; |
111 | function GetSQLType: cardinal; override; | |
112 | function GetSubtype: integer; override; | |
113 | < | function GetAliasName: string; override; |
114 | < | function GetFieldName: string; override; |
115 | < | function GetOwnerName: string; override; |
116 | < | function GetRelationName: string; override; |
113 | > | function GetAliasName: AnsiString; override; |
114 | > | function GetFieldName: AnsiString; override; |
115 | > | function GetOwnerName: AnsiString; override; |
116 | > | function GetRelationName: AnsiString; override; |
117 | function GetScale: integer; override; | |
118 | function GetCharSetID: cardinal; override; | |
119 | function GetCodePage: TSystemCodePage; override; | |
120 | + | function GetCharSetWidth: integer; override; |
121 | function GetIsNull: Boolean; override; | |
122 | function GetIsNullable: boolean; override; | |
123 | < | function GetSQLData: PChar; override; |
123 | > | function GetSQLData: PByte; override; |
124 | function GetDataLength: cardinal; override; | |
125 | + | function GetSize: cardinal; override; |
126 | + | function GetAttachment: IAttachment; override; |
127 | + | function GetDefaultTextSQLType: cardinal; override; |
128 | procedure SetIsNull(Value: Boolean); override; | |
129 | procedure SetIsNullable(Value: Boolean); override; | |
130 | < | procedure SetSQLData(AValue: PChar; len: cardinal); override; |
130 | > | procedure SetSQLData(AValue: PByte; len: cardinal); override; |
131 | procedure SetScale(aValue: integer); override; | |
132 | procedure SetDataLength(len: cardinal); override; | |
133 | procedure SetSQLType(aValue: cardinal); override; | |
134 | procedure SetCharSetID(aValue: cardinal); override; | |
135 | < | |
135 | > | procedure SetMetaSize(aValue: cardinal); override; |
136 | public | |
137 | constructor Create(aParent: TIBXSQLDA; aIndex: integer); | |
138 | procedure Changed; override; | |
139 | + | procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata); |
140 | + | procedure ColumnSQLDataInit; |
141 | procedure RowChange; override; | |
142 | procedure FreeSQLData; | |
143 | < | function GetAsArray(Array_ID: TISC_QUAD): IArray; override; |
143 | > | function GetAsArray: IArray; override; |
144 | function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override; | |
145 | function GetArrayMetaData: IArrayMetaData; override; | |
146 | function GetBlobMetaData: IBlobMetaData; override; | |
# | Line 145 | Line 155 | type | |
155 | FSize: Integer; {Number of TIBXSQLVARs in column list} | |
156 | FMetaData: Firebird.IMessageMetadata; | |
157 | FTransactionSeqNo: integer; | |
158 | < | protected |
158 | > | protected |
159 | FStatement: TFB30Statement; | |
160 | + | FFirebird30ClientAPI: TFB30ClientAPI; |
161 | function GetTransactionSeqNo: integer; override; | |
162 | procedure FreeXSQLDA; virtual; | |
163 | function GetStatement: IStatement; override; | |
# | Line 161 | Line 172 | type | |
172 | function GetTransaction: TFB30Transaction; virtual; | |
173 | procedure Initialize; override; | |
174 | function StateChanged(var ChangeSeqNo: integer): boolean; override; | |
175 | + | function CanChangeMetaData: boolean; override; |
176 | property MetaData: Firebird.IMessageMetadata read FMetaData; | |
177 | property Count: Integer read FCount write SetCount; | |
178 | property Statement: TFB30Statement read FStatement; | |
# | Line 170 | Line 182 | type | |
182 | ||
183 | TIBXINPUTSQLDA = class(TIBXSQLDA) | |
184 | private | |
185 | < | FMessageBuffer: PChar; {Message Buffer} |
185 | > | FMessageBuffer: PByte; {Message Buffer} |
186 | FMsgLength: integer; {Message Buffer length} | |
187 | FCurMetaData: Firebird.IMessageMetadata; | |
188 | procedure FreeMessageBuffer; | |
189 | < | function GetMessageBuffer: PChar; |
189 | > | procedure FreeCurMetaData; |
190 | > | function GetMessageBuffer: PByte; |
191 | function GetMetaData: Firebird.IMessageMetadata; | |
192 | function GetModified: Boolean; | |
193 | function GetMsgLength: integer; | |
194 | + | procedure BuildMetadata; |
195 | procedure PackBuffer; | |
196 | protected | |
197 | procedure FreeXSQLDA; override; | |
# | Line 186 | Line 200 | type | |
200 | destructor Destroy; override; | |
201 | procedure Bind(aMetaData: Firebird.IMessageMetadata); | |
202 | procedure Changed; override; | |
203 | + | procedure ReInitialise; |
204 | function IsInputDataArea: boolean; override; | |
205 | property MetaData: Firebird.IMessageMetadata read GetMetaData; | |
206 | < | property MessageBuffer: PChar read GetMessageBuffer; |
206 | > | property MessageBuffer: PByte read GetMessageBuffer; |
207 | property MsgLength: integer read GetMsgLength; | |
208 | end; | |
209 | ||
# | Line 197 | Line 212 | type | |
212 | TIBXOUTPUTSQLDA = class(TIBXSQLDA) | |
213 | private | |
214 | FTransaction: TFB30Transaction; {transaction used to execute the statement} | |
215 | < | FMessageBuffer: PChar; {Message Buffer} |
215 | > | FMessageBuffer: PByte; {Message Buffer} |
216 | FMsgLength: integer; {Message Buffer length} | |
217 | protected | |
218 | procedure FreeXSQLDA; override; | |
219 | public | |
220 | procedure Bind(aMetaData: Firebird.IMessageMetadata); | |
221 | procedure GetData(index: integer; var aIsNull: boolean; var len: short; | |
222 | < | var data: PChar); override; |
222 | > | var data: PByte); override; |
223 | function IsInputDataArea: boolean; override; | |
224 | < | property MessageBuffer: PChar read FMessageBuffer; |
224 | > | property MessageBuffer: PByte read FMessageBuffer; |
225 | property MsgLength: integer read FMsgLength; | |
226 | end; | |
227 | ||
# | Line 216 | Line 231 | type | |
231 | private | |
232 | FResults: TIBXOUTPUTSQLDA; | |
233 | FCursorSeqNo: integer; | |
234 | + | procedure RowChange; |
235 | public | |
236 | constructor Create(aResults: TIBXOUTPUTSQLDA); | |
237 | destructor Destroy; override; | |
238 | {IResultSet} | |
239 | < | function FetchNext: boolean; |
240 | < | function GetCursorName: string; |
239 | > | function FetchNext: boolean; {fetch next record} |
240 | > | function FetchPrior: boolean; {fetch previous record} |
241 | > | function FetchFirst:boolean; {fetch first record} |
242 | > | function FetchLast: boolean; {fetch last record} |
243 | > | function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set} |
244 | > | function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current} |
245 | > | function GetCursorName: AnsiString; |
246 | function GetTransaction: ITransaction; override; | |
247 | + | function IsBof: boolean; |
248 | function IsEof: boolean; | |
249 | procedure Close; | |
250 | end; | |
251 | ||
252 | + | { TBatchCompletion } |
253 | + | |
254 | + | TBatchCompletion = class(TInterfaceOwner,IBatchCompletion) |
255 | + | private |
256 | + | FCompletionState: Firebird.IBatchCompletionState; |
257 | + | FFirebird30ClientAPI: TFB30ClientAPI; |
258 | + | public |
259 | + | constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState); |
260 | + | destructor Destroy; override; |
261 | + | {IBatchCompletion} |
262 | + | function getErrorStatus(var RowNo: integer; var status: IStatus): boolean; |
263 | + | function getTotalProcessed: cardinal; |
264 | + | function getState(updateNo: cardinal): TBatchCompletionState; |
265 | + | function getStatusMessage(updateNo: cardinal): AnsiString; |
266 | + | function getUpdated: integer; |
267 | + | end; |
268 | + | |
269 | + | TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative); |
270 | + | |
271 | { TFB30Statement } | |
272 | ||
273 | TFB30Statement = class(TFBStatement,IStatement) | |
274 | private | |
275 | FStatementIntf: Firebird.IStatement; | |
276 | + | FFirebird30ClientAPI: TFB30ClientAPI; |
277 | FSQLParams: TIBXINPUTSQLDA; | |
278 | FSQLRecord: TIBXOUTPUTSQLDA; | |
279 | FResultSet: Firebird.IResultSet; | |
280 | FCursorSeqNo: integer; | |
281 | + | FCursor: AnsiString; |
282 | + | FBatch: Firebird.IBatch; |
283 | + | FBatchCompletion: IBatchCompletion; |
284 | + | FBatchRowCount: integer; |
285 | + | FBatchBufferSize: integer; |
286 | + | FBatchBufferUsed: integer; |
287 | protected | |
288 | + | procedure CheckChangeBatchRowLimit; override; |
289 | procedure CheckHandle; override; | |
290 | + | procedure CheckBatchModeAvailable; |
291 | procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override; | |
292 | < | procedure InternalPrepare; override; |
292 | > | function GetStatementIntf: IStatement; override; |
293 | > | procedure InternalPrepare(CursorName: AnsiString=''); override; |
294 | function InternalExecute(aTransaction: ITransaction): IResults; override; | |
295 | < | function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override; |
295 | > | function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean |
296 | > | ): IResultSet; override; |
297 | > | procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override; |
298 | procedure FreeHandle; override; | |
299 | procedure InternalClose(Force: boolean); override; | |
300 | + | function SavePerfStats(var Stats: TPerfStatistics): boolean; |
301 | public | |
302 | constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction; | |
303 | < | sql: string; aSQLDialect: integer); |
303 | > | sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''); |
304 | constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction; | |
305 | < | sql: string; aSQLDialect: integer; GenerateParamNames: boolean =false); |
305 | > | sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean =false; |
306 | > | CaseSensitiveParams: boolean=false; CursorName: AnsiString=''); |
307 | destructor Destroy; override; | |
308 | < | function FetchNext: boolean; |
308 | > | function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean; |
309 | property StatementIntf: Firebird.IStatement read FStatementIntf; | |
310 | ||
311 | public | |
312 | {IStatement} | |
313 | function GetSQLParams: ISQLParams; override; | |
314 | function GetMetaData: IMetaData; override; | |
315 | < | function GetPlan: String; |
315 | > | function GetPlan: AnsiString; |
316 | function IsPrepared: boolean; | |
317 | + | function GetFlags: TStatementFlags; override; |
318 | function CreateBlob(column: TColumnMetaData): IBlob; override; | |
319 | function CreateArray(column: TColumnMetaData): IArray; override; | |
320 | procedure SetRetainInterfaces(aValue: boolean); override; | |
321 | < | |
321 | > | function IsInBatchMode: boolean; override; |
322 | > | function HasBatchMode: boolean; override; |
323 | > | procedure AddToBatch; override; |
324 | > | function ExecuteBatch(aTransaction: ITransaction |
325 | > | ): IBatchCompletion; override; |
326 | > | procedure CancelBatch; override; |
327 | > | function GetBatchCompletion: IBatchCompletion; override; |
328 | end; | |
329 | ||
330 | implementation | |
331 | ||
332 | < | uses IBUtils, FBMessages, FBBLob, FB30Blob, variants, FBArray, FB30Array; |
332 | > | uses IBUtils, FBMessages, FBBlob, FB30Blob, variants, FBArray, FB30Array; |
333 | ||
334 | const | |
335 | ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches'; | |
336 | ||
337 | + | { EIBBatchCompletionError } |
338 | + | |
339 | + | { TBatchCompletion } |
340 | + | |
341 | + | constructor TBatchCompletion.Create(api: TFB30ClientAPI; |
342 | + | cs: IBatchCompletionState); |
343 | + | begin |
344 | + | inherited Create; |
345 | + | FFirebird30ClientAPI := api; |
346 | + | FCompletionState := cs; |
347 | + | end; |
348 | + | |
349 | + | destructor TBatchCompletion.Destroy; |
350 | + | begin |
351 | + | if FCompletionState <> nil then |
352 | + | begin |
353 | + | FCompletionState.dispose; |
354 | + | FCompletionState := nil; |
355 | + | end; |
356 | + | inherited Destroy; |
357 | + | end; |
358 | + | |
359 | + | function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus |
360 | + | ): boolean; |
361 | + | var i: integer; |
362 | + | upcount: cardinal; |
363 | + | state: integer; |
364 | + | FBStatus: Firebird.IStatus; |
365 | + | begin |
366 | + | Result := false; |
367 | + | RowNo := -1; |
368 | + | FBStatus := nil; |
369 | + | with FFirebird30ClientAPI do |
370 | + | begin |
371 | + | upcount := FCompletionState.getSize(StatusIntf); |
372 | + | Check4DataBaseError; |
373 | + | for i := 0 to upcount - 1 do |
374 | + | begin |
375 | + | state := FCompletionState.getState(StatusIntf,i); |
376 | + | if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then |
377 | + | begin |
378 | + | RowNo := i+1; |
379 | + | FBStatus := MasterIntf.getStatus; |
380 | + | try |
381 | + | FCompletionState.getStatus(StatusIntf,FBStatus,i); |
382 | + | Check4DataBaseError; |
383 | + | except |
384 | + | FBStatus.dispose; |
385 | + | raise |
386 | + | end; |
387 | + | status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus, |
388 | + | Format(SBatchCompletionError,[RowNo])); |
389 | + | status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages); |
390 | + | Result := true; |
391 | + | break; |
392 | + | end; |
393 | + | end; |
394 | + | end; |
395 | + | end; |
396 | + | |
397 | + | function TBatchCompletion.getTotalProcessed: cardinal; |
398 | + | begin |
399 | + | with FFirebird30ClientAPI do |
400 | + | begin |
401 | + | Result := FCompletionState.getsize(StatusIntf); |
402 | + | Check4DataBaseError; |
403 | + | end; |
404 | + | end; |
405 | + | |
406 | + | function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState; |
407 | + | var state: integer; |
408 | + | begin |
409 | + | with FFirebird30ClientAPI do |
410 | + | begin |
411 | + | state := FCompletionState.getState(StatusIntf,updateNo); |
412 | + | Check4DataBaseError; |
413 | + | case state of |
414 | + | Firebird.IBatchCompletionState.EXECUTE_FAILED: |
415 | + | Result := bcExecuteFailed; |
416 | + | |
417 | + | Firebird.IBatchCompletionState.SUCCESS_NO_INFO: |
418 | + | Result := bcSuccessNoInfo; |
419 | + | |
420 | + | else |
421 | + | Result := bcNoMoreErrors; |
422 | + | end; |
423 | + | end; |
424 | + | end; |
425 | + | |
426 | + | function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString; |
427 | + | var status: Firebird.IStatus; |
428 | + | begin |
429 | + | with FFirebird30ClientAPI do |
430 | + | begin |
431 | + | status := MasterIntf.getStatus; |
432 | + | FCompletionState.getStatus(StatusIntf,status,updateNo); |
433 | + | Check4DataBaseError; |
434 | + | Result := FormatFBStatus(status); |
435 | + | end; |
436 | + | end; |
437 | + | |
438 | + | function TBatchCompletion.getUpdated: integer; |
439 | + | var i: integer; |
440 | + | upcount: cardinal; |
441 | + | state: integer; |
442 | + | begin |
443 | + | Result := 0; |
444 | + | with FFirebird30ClientAPI do |
445 | + | begin |
446 | + | upcount := FCompletionState.getSize(StatusIntf); |
447 | + | Check4DataBaseError; |
448 | + | for i := 0 to upcount -1 do |
449 | + | begin |
450 | + | state := FCompletionState.getState(StatusIntf,i); |
451 | + | if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then |
452 | + | break; |
453 | + | Inc(Result); |
454 | + | end; |
455 | + | end; |
456 | + | end; |
457 | + | |
458 | { TIBXSQLVAR } | |
459 | ||
460 | procedure TIBXSQLVAR.Changed; | |
# | Line 280 | Line 463 | begin | |
463 | TIBXSQLDA(Parent).Changed; | |
464 | end; | |
465 | ||
466 | + | procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata); |
467 | + | begin |
468 | + | with FFirebird30ClientAPI do |
469 | + | begin |
470 | + | FSQLType := aMetaData.getType(StatusIntf,Index); |
471 | + | Check4DataBaseError; |
472 | + | if FSQLType = SQL_BLOB then |
473 | + | begin |
474 | + | FSQLSubType := aMetaData.getSubType(StatusIntf,Index); |
475 | + | Check4DataBaseError; |
476 | + | end |
477 | + | else |
478 | + | FSQLSubType := 0; |
479 | + | FDataLength := aMetaData.getLength(StatusIntf,Index); |
480 | + | Check4DataBaseError; |
481 | + | FMetadataSize := FDataLength; |
482 | + | FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index)); |
483 | + | Check4DataBaseError; |
484 | + | FFieldName := strpas(aMetaData.getField(StatusIntf,Index)); |
485 | + | Check4DataBaseError; |
486 | + | FNullable := aMetaData.isNullable(StatusIntf,Index); |
487 | + | Check4DataBaseError; |
488 | + | FScale := aMetaData.getScale(StatusIntf,Index); |
489 | + | Check4DataBaseError; |
490 | + | FCharSetID := aMetaData.getCharSet(StatusIntf,Index) and $FF; |
491 | + | Check4DataBaseError; |
492 | + | end; |
493 | + | end; |
494 | + | |
495 | + | procedure TIBXSQLVAR.ColumnSQLDataInit; |
496 | + | begin |
497 | + | FreeSQLData; |
498 | + | with FFirebird30ClientAPI do |
499 | + | begin |
500 | + | case SQLType of |
501 | + | SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP, |
502 | + | SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN, |
503 | + | SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, |
504 | + | SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34, |
505 | + | SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX: |
506 | + | begin |
507 | + | if (FDataLength = 0) then |
508 | + | { Make sure you get a valid pointer anyway |
509 | + | select '' from foo } |
510 | + | IBAlloc(FSQLData, 0, 1) |
511 | + | else |
512 | + | IBAlloc(FSQLData, 0, FDataLength) |
513 | + | end; |
514 | + | SQL_VARYING: |
515 | + | IBAlloc(FSQLData, 0, FDataLength + 2); |
516 | + | else |
517 | + | IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)]) |
518 | + | end; |
519 | + | FOwnsSQLData := true; |
520 | + | FNullIndicator := -1; |
521 | + | end; |
522 | + | end; |
523 | + | |
524 | + | function TIBXSQLVAR.CanChangeSQLType: boolean; |
525 | + | begin |
526 | + | Result := Parent.CanChangeMetaData; |
527 | + | end; |
528 | + | |
529 | function TIBXSQLVAR.GetSQLType: cardinal; | |
530 | begin | |
531 | Result := FSQLType; | |
# | Line 290 | Line 536 | begin | |
536 | Result := FSQLSubType; | |
537 | end; | |
538 | ||
539 | < | function TIBXSQLVAR.GetAliasName: string; |
539 | > | function TIBXSQLVAR.GetAliasName: AnsiString; |
540 | begin | |
541 | < | with Firebird30ClientAPI do |
541 | > | with FFirebird30ClientAPI do |
542 | begin | |
543 | result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index)); | |
544 | Check4DataBaseError; | |
545 | end; | |
546 | end; | |
547 | ||
548 | < | function TIBXSQLVAR.GetFieldName: string; |
548 | > | function TIBXSQLVAR.GetFieldName: AnsiString; |
549 | begin | |
550 | Result := FFieldName; | |
551 | end; | |
552 | ||
553 | < | function TIBXSQLVAR.GetOwnerName: string; |
553 | > | function TIBXSQLVAR.GetOwnerName: AnsiString; |
554 | begin | |
555 | < | with Firebird30ClientAPI do |
555 | > | with FFirebird30ClientAPI do |
556 | begin | |
557 | result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index)); | |
558 | Check4DataBaseError; | |
559 | end; | |
560 | end; | |
561 | ||
562 | < | function TIBXSQLVAR.GetRelationName: string; |
562 | > | function TIBXSQLVAR.GetRelationName: AnsiString; |
563 | begin | |
564 | Result := FRelationName; | |
565 | end; | |
# | Line 325 | Line 571 | end; | |
571 | ||
572 | function TIBXSQLVAR.GetCharSetID: cardinal; | |
573 | begin | |
574 | < | result := 0; |
574 | > | result := 0; {NONE} |
575 | case SQLType of | |
576 | SQL_VARYING, SQL_TEXT: | |
577 | result := FCharSetID; | |
578 | ||
579 | SQL_BLOB: | |
580 | if (SQLSubType = 1) then | |
581 | < | result := FCharSetID; |
581 | > | result := FCharSetID |
582 | > | else |
583 | > | result := 1; {OCTETS} |
584 | ||
585 | SQL_ARRAY: | |
586 | if (FRelationName <> '') and (FFieldName <> '') then | |
# | Line 345 | Line 593 | end; | |
593 | function TIBXSQLVAR.GetCodePage: TSystemCodePage; | |
594 | begin | |
595 | result := CP_NONE; | |
596 | < | with Firebird30ClientAPI do |
596 | > | with Statement.GetAttachment do |
597 | CharSetID2CodePage(GetCharSetID,result); | |
598 | end; | |
599 | ||
600 | + | function TIBXSQLVAR.GetCharSetWidth: integer; |
601 | + | begin |
602 | + | result := 1; |
603 | + | with Statement.GetAttachment DO |
604 | + | CharSetWidth(GetCharSetID,result); |
605 | + | end; |
606 | + | |
607 | function TIBXSQLVAR.GetIsNull: Boolean; | |
608 | begin | |
609 | Result := IsNullable and (FSQLNullIndicator^ = -1); | |
# | Line 359 | Line 614 | begin | |
614 | Result := FSQLNullIndicator <> nil; | |
615 | end; | |
616 | ||
617 | < | function TIBXSQLVAR.GetSQLData: PChar; |
617 | > | function TIBXSQLVAR.GetSQLData: PByte; |
618 | begin | |
619 | Result := FSQLData; | |
620 | end; | |
# | Line 369 | Line 624 | begin | |
624 | Result := FDataLength; | |
625 | end; | |
626 | ||
627 | + | function TIBXSQLVAR.GetSize: cardinal; |
628 | + | begin |
629 | + | Result := FMetadataSize; |
630 | + | end; |
631 | + | |
632 | + | function TIBXSQLVAR.GetAttachment: IAttachment; |
633 | + | begin |
634 | + | Result := FStatement.GetAttachment; |
635 | + | end; |
636 | + | |
637 | function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData; | |
638 | begin | |
639 | if GetSQLType <> SQL_ARRAY then | |
# | Line 418 | Line 683 | begin | |
683 | end | |
684 | else | |
685 | FSQLNullIndicator := nil; | |
686 | + | Changed; |
687 | end; | |
688 | ||
689 | < | procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal); |
689 | > | procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal); |
690 | begin | |
691 | if FOwnsSQLData then | |
692 | FreeMem(FSQLData); | |
693 | FSQLData := AValue; | |
694 | FDataLength := len; | |
695 | FOwnsSQLData := false; | |
696 | + | Changed; |
697 | end; | |
698 | ||
699 | procedure TIBXSQLVAR.SetScale(aValue: integer); | |
700 | begin | |
701 | FScale := aValue; | |
702 | + | Changed; |
703 | end; | |
704 | ||
705 | procedure TIBXSQLVAR.SetDataLength(len: cardinal); | |
# | Line 439 | Line 707 | begin | |
707 | if not FOwnsSQLData then | |
708 | FSQLData := nil; | |
709 | FDataLength := len; | |
710 | < | with Firebird30ClientAPI do |
710 | > | with FFirebird30ClientAPI do |
711 | IBAlloc(FSQLData, 0, FDataLength); | |
712 | FOwnsSQLData := true; | |
713 | + | Changed; |
714 | end; | |
715 | ||
716 | procedure TIBXSQLVAR.SetSQLType(aValue: cardinal); | |
717 | begin | |
718 | + | if (FSQLType <> aValue) and not CanChangeSQLType then |
719 | + | IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]); |
720 | FSQLType := aValue; | |
721 | + | Changed; |
722 | end; | |
723 | ||
724 | procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal); | |
725 | begin | |
726 | FCharSetID := aValue; | |
727 | + | Changed; |
728 | + | end; |
729 | + | |
730 | + | procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal); |
731 | + | begin |
732 | + | if (aValue > FMetaDataSize) and not CanChangeSQLType then |
733 | + | IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]); |
734 | + | FMetaDataSize := aValue; |
735 | + | end; |
736 | + | |
737 | + | function TIBXSQLVAR.GetDefaultTextSQLType: cardinal; |
738 | + | begin |
739 | + | Result := SQL_VARYING; |
740 | end; | |
741 | ||
742 | constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer); | |
743 | begin | |
744 | inherited Create(aParent,aIndex); | |
745 | FStatement := aParent.Statement; | |
746 | + | FFirebird30ClientAPI := aParent.FFirebird30ClientAPI; |
747 | end; | |
748 | ||
749 | procedure TIBXSQLVAR.RowChange; | |
750 | begin | |
751 | inherited; | |
752 | FBlob := nil; | |
467 | – | FArray := nil; |
753 | end; | |
754 | ||
755 | procedure TIBXSQLVAR.FreeSQLData; | |
# | Line 475 | Line 760 | begin | |
760 | FOwnsSQLData := true; | |
761 | end; | |
762 | ||
763 | < | function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray; |
763 | > | function TIBXSQLVAR.GetAsArray: IArray; |
764 | begin | |
765 | if SQLType <> SQL_ARRAY then | |
766 | IBError(ibxeInvalidDataConversion,[nil]); | |
# | Line 484 | Line 769 | begin | |
769 | Result := nil | |
770 | else | |
771 | begin | |
772 | < | if FArray = nil then |
773 | < | FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment, |
772 | > | if FArrayIntf = nil then |
773 | > | FArrayIntf := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment, |
774 | TIBXSQLDA(Parent).GetTransaction, | |
775 | < | GetArrayMetaData,Array_ID); |
776 | < | Result := FArray; |
775 | > | GetArrayMetaData,PISC_QUAD(SQLData)^); |
776 | > | Result := FArrayIntf; |
777 | end; | |
778 | end; | |
779 | ||
# | Line 520 | Line 805 | end; | |
805 | ||
806 | { TResultSet } | |
807 | ||
808 | + | procedure TResultSet.RowChange; |
809 | + | var i: integer; |
810 | + | begin |
811 | + | for i := 0 to getCount - 1 do |
812 | + | FResults.Column[i].RowChange; |
813 | + | end; |
814 | + | |
815 | constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA); | |
816 | begin | |
817 | inherited Create(aResults); | |
# | Line 534 | Line 826 | begin | |
826 | end; | |
827 | ||
828 | function TResultSet.FetchNext: boolean; | |
537 | – | var i: integer; |
829 | begin | |
830 | CheckActive; | |
831 | < | Result := FResults.FStatement.FetchNext; |
831 | > | Result := FResults.FStatement.Fetch(ftNext); |
832 | > | if Result then |
833 | > | RowChange; |
834 | > | end; |
835 | > | |
836 | > | function TResultSet.FetchPrior: boolean; |
837 | > | begin |
838 | > | CheckActive; |
839 | > | Result := FResults.FStatement.Fetch(ftPrior); |
840 | > | if Result then |
841 | > | RowChange; |
842 | > | end; |
843 | > | |
844 | > | function TResultSet.FetchFirst: boolean; |
845 | > | begin |
846 | > | CheckActive; |
847 | > | Result := FResults.FStatement.Fetch(ftFirst); |
848 | if Result then | |
849 | < | for i := 0 to getCount - 1 do |
543 | < | FResults.Column[i].RowChange; |
849 | > | RowChange; |
850 | end; | |
851 | ||
852 | < | function TResultSet.GetCursorName: string; |
852 | > | function TResultSet.FetchLast: boolean; |
853 | begin | |
854 | < | IBError(ibxeNotSupported,[nil]); |
855 | < | Result := ''; |
854 | > | CheckActive; |
855 | > | Result := FResults.FStatement.Fetch(ftLast); |
856 | > | if Result then |
857 | > | RowChange; |
858 | > | end; |
859 | > | |
860 | > | function TResultSet.FetchAbsolute(position: Integer): boolean; |
861 | > | begin |
862 | > | CheckActive; |
863 | > | Result := FResults.FStatement.Fetch(ftAbsolute,position); |
864 | > | if Result then |
865 | > | RowChange; |
866 | > | end; |
867 | > | |
868 | > | function TResultSet.FetchRelative(offset: Integer): boolean; |
869 | > | begin |
870 | > | CheckActive; |
871 | > | Result := FResults.FStatement.Fetch(ftRelative,offset); |
872 | > | if Result then |
873 | > | RowChange; |
874 | > | end; |
875 | > | |
876 | > | function TResultSet.GetCursorName: AnsiString; |
877 | > | begin |
878 | > | Result := FResults.FStatement.FCursor; |
879 | end; | |
880 | ||
881 | function TResultSet.GetTransaction: ITransaction; | |
# | Line 554 | Line 883 | begin | |
883 | Result := FResults.FTransaction; | |
884 | end; | |
885 | ||
886 | + | function TResultSet.IsBof: boolean; |
887 | + | begin |
888 | + | Result := FResults.FStatement.FBof; |
889 | + | end; |
890 | + | |
891 | function TResultSet.IsEof: boolean; | |
892 | begin | |
893 | Result := FResults.FStatement.FEof; | |
# | Line 582 | Line 916 | end; | |
916 | ||
917 | procedure TIBXINPUTSQLDA.FreeMessageBuffer; | |
918 | begin | |
585 | – | if FCurMetaData <> nil then |
586 | – | begin |
587 | – | FCurMetaData.release; |
588 | – | FCurMetaData := nil; |
589 | – | end; |
919 | if FMessageBuffer <> nil then | |
920 | begin | |
921 | FreeMem(FMessageBuffer); | |
# | Line 595 | Line 924 | begin | |
924 | FMsgLength := 0; | |
925 | end; | |
926 | ||
927 | < | function TIBXINPUTSQLDA.GetMessageBuffer: PChar; |
927 | > | procedure TIBXINPUTSQLDA.FreeCurMetaData; |
928 | > | begin |
929 | > | if FCurMetaData <> nil then |
930 | > | begin |
931 | > | FCurMetaData.release; |
932 | > | FCurMetaData := nil; |
933 | > | end; |
934 | > | end; |
935 | > | |
936 | > | function TIBXINPUTSQLDA.GetMessageBuffer: PByte; |
937 | begin | |
938 | PackBuffer; | |
939 | Result := FMessageBuffer; | |
# | Line 603 | Line 941 | end; | |
941 | ||
942 | function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata; | |
943 | begin | |
944 | < | PackBuffer; |
944 | > | BuildMetadata; |
945 | Result := FCurMetaData; | |
946 | end; | |
947 | ||
# | Line 613 | Line 951 | begin | |
951 | Result := FMsgLength; | |
952 | end; | |
953 | ||
954 | < | procedure TIBXINPUTSQLDA.PackBuffer; |
954 | > | procedure TIBXINPUTSQLDA.BuildMetadata; |
955 | var Builder: Firebird.IMetadataBuilder; | |
956 | i: integer; | |
957 | begin | |
958 | < | if FMsgLength > 0 then Exit; |
959 | < | |
622 | < | with Firebird30ClientAPI do |
958 | > | if (FCurMetaData = nil) and (Count > 0) then |
959 | > | with FFirebird30ClientAPI do |
960 | begin | |
961 | < | Builder := inherited MetaData.getBuilder(StatusIntf); |
961 | > | Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count); |
962 | Check4DataBaseError; | |
963 | try | |
964 | for i := 0 to Count - 1 do | |
965 | with TIBXSQLVar(Column[i]) do | |
966 | begin | |
967 | < | Builder.setType(StatusIntf,i,FSQLType); |
967 | > | Builder.setType(StatusIntf,i,FSQLType+1); |
968 | Check4DataBaseError; | |
969 | Builder.setSubType(StatusIntf,i,FSQLSubType); | |
970 | Check4DataBaseError; | |
971 | < | Builder.setLength(StatusIntf,i,FDataLength); |
971 | > | // writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength); |
972 | > | if FSQLType = SQL_VARYING then |
973 | > | begin |
974 | > | {The datalength can be greater than the metadata size when SQLType has been overridden to text} |
975 | > | if (GetDataLength > GetSize) and CanChangeMetaData then |
976 | > | Builder.setLength(StatusIntf,i,GetDataLength) |
977 | > | else |
978 | > | Builder.setLength(StatusIntf,i,GetSize) |
979 | > | end |
980 | > | else |
981 | > | Builder.setLength(StatusIntf,i,GetDataLength); |
982 | Check4DataBaseError; | |
983 | Builder.setCharSet(StatusIntf,i,GetCharSetID); | |
984 | Check4DataBaseError; | |
# | Line 643 | Line 990 | begin | |
990 | finally | |
991 | Builder.release; | |
992 | end; | |
993 | + | end; |
994 | + | end; |
995 | ||
996 | + | procedure TIBXINPUTSQLDA.PackBuffer; |
997 | + | var i: integer; |
998 | + | P: PByte; |
999 | + | begin |
1000 | + | BuildMetadata; |
1001 | + | |
1002 | + | if (FMsgLength = 0) and (FCurMetaData <> nil) then |
1003 | + | with FFirebird30ClientAPI do |
1004 | + | begin |
1005 | FMsgLength := FCurMetaData.getMessageLength(StatusIntf); | |
1006 | Check4DataBaseError; | |
1007 | ||
# | Line 652 | Line 1010 | begin | |
1010 | for i := 0 to Count - 1 do | |
1011 | with TIBXSQLVar(Column[i]) do | |
1012 | begin | |
1013 | + | P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i); |
1014 | + | // writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength); |
1015 | + | if not Modified then |
1016 | + | IBError(ibxeUninitializedInputParameter,[i,Name]); |
1017 | if IsNull then | |
1018 | < | FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0) |
1018 | > | FillChar(P^,FDataLength,0) |
1019 | else | |
1020 | < | Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength); |
1021 | < | Check4DataBaseError; |
1020 | > | if FSQLData <> nil then |
1021 | > | begin |
1022 | > | if SQLType = SQL_VARYING then |
1023 | > | begin |
1024 | > | EncodeInteger(FDataLength,2,P); |
1025 | > | Inc(P,2); |
1026 | > | end |
1027 | > | else |
1028 | > | if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then |
1029 | > | begin |
1030 | > | FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData)); |
1031 | > | Check4DatabaseError; |
1032 | > | end; |
1033 | > | Move(FSQLData^,P^,FDataLength); |
1034 | > | end; |
1035 | if IsNullable then | |
1036 | begin | |
1037 | Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator)); | |
# | Line 669 | Line 1044 | end; | |
1044 | procedure TIBXINPUTSQLDA.FreeXSQLDA; | |
1045 | begin | |
1046 | inherited FreeXSQLDA; | |
1047 | + | FreeCurMetaData; |
1048 | FreeMessageBuffer; | |
1049 | end; | |
1050 | ||
# | Line 680 | Line 1056 | end; | |
1056 | ||
1057 | destructor TIBXINPUTSQLDA.Destroy; | |
1058 | begin | |
1059 | < | FreeMessageBuffer; |
1059 | > | FreeXSQLDA; |
1060 | inherited Destroy; | |
1061 | end; | |
1062 | ||
# | Line 688 | Line 1064 | procedure TIBXINPUTSQLDA.Bind(aMetaData: | |
1064 | var i: integer; | |
1065 | begin | |
1066 | FMetaData := aMetaData; | |
1067 | < | with Firebird30ClientAPI do |
1067 | > | with FFirebird30ClientAPI do |
1068 | begin | |
1069 | < | Count := metadata.getCount(StatusIntf); |
1069 | > | Count := aMetadata.getCount(StatusIntf); |
1070 | Check4DataBaseError; | |
1071 | Initialize; | |
1072 | ||
1073 | for i := 0 to Count - 1 do | |
1074 | with TIBXSQLVar(Column[i]) do | |
1075 | begin | |
1076 | < | FSQLType := aMetaData.getType(StatusIntf,i); |
1077 | < | Check4DataBaseError; |
702 | < | if FSQLType = SQL_BLOB then |
703 | < | begin |
704 | < | FSQLSubType := aMetaData.getSubType(StatusIntf,i); |
705 | < | Check4DataBaseError; |
706 | < | end |
707 | < | else |
708 | < | FSQLSubType := 0; |
709 | < | FDataLength := aMetaData.getLength(StatusIntf,i); |
710 | < | Check4DataBaseError; |
711 | < | case SQLType of |
712 | < | SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP, |
713 | < | SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN, |
714 | < | SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
715 | < | begin |
716 | < | if (FDataLength = 0) then |
717 | < | { Make sure you get a valid pointer anyway |
718 | < | select '' from foo } |
719 | < | IBAlloc(FSQLData, 0, 1) |
720 | < | else |
721 | < | IBAlloc(FSQLData, 0, FDataLength) |
722 | < | end; |
723 | < | SQL_VARYING: |
724 | < | IBAlloc(FSQLData, 0, FDataLength + 2); |
725 | < | else |
726 | < | IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)]) |
727 | < | end; |
728 | < | FNullable := aMetaData.isNullable(StatusIntf,i); |
729 | < | FOwnsSQLData := true; |
730 | < | Check4DataBaseError; |
731 | < | FNullIndicator := -1; |
1076 | > | InitColumnMetaData(aMetaData); |
1077 | > | SaveMetaData; |
1078 | if FNullable then | |
1079 | FSQLNullIndicator := @FNullIndicator | |
1080 | else | |
1081 | FSQLNullIndicator := nil; | |
1082 | < | FScale := aMetaData.getScale(StatusIntf,i); |
737 | < | Check4DataBaseError; |
738 | < | FCharSetID := aMetaData.getCharSet(StatusIntf,i); |
739 | < | Check4DataBaseError; |
1082 | > | ColumnSQLDataInit; |
1083 | end; | |
1084 | end; | |
1085 | end; | |
# | Line 744 | Line 1087 | end; | |
1087 | procedure TIBXINPUTSQLDA.Changed; | |
1088 | begin | |
1089 | inherited Changed; | |
1090 | + | FreeCurMetaData; |
1091 | FreeMessageBuffer; | |
1092 | end; | |
1093 | ||
1094 | + | procedure TIBXINPUTSQLDA.ReInitialise; |
1095 | + | var i: integer; |
1096 | + | begin |
1097 | + | FreeMessageBuffer; |
1098 | + | for i := 0 to Count - 1 do |
1099 | + | TIBXSQLVar(Column[i]).ColumnSQLDataInit; |
1100 | + | end; |
1101 | + | |
1102 | function TIBXINPUTSQLDA.IsInputDataArea: boolean; | |
1103 | begin | |
1104 | Result := true; | |
# | Line 766 | Line 1118 | procedure TIBXOUTPUTSQLDA.Bind(aMetaData | |
1118 | var i: integer; | |
1119 | begin | |
1120 | FMetaData := aMetaData; | |
1121 | < | with Firebird30ClientAPI do |
1121 | > | with FFirebird30ClientAPI do |
1122 | begin | |
1123 | Count := metadata.getCount(StatusIntf); | |
1124 | Check4DataBaseError; | |
# | Line 779 | Line 1131 | begin | |
1131 | for i := 0 to Count - 1 do | |
1132 | with TIBXSQLVar(Column[i]) do | |
1133 | begin | |
1134 | < | FSQLType := aMetaData.getType(StatusIntf,i); |
783 | < | Check4DataBaseError; |
784 | < | if FSQLType = SQL_BLOB then |
785 | < | begin |
786 | < | FSQLSubType := aMetaData.getSubType(StatusIntf,i); |
787 | < | Check4DataBaseError; |
788 | < | end |
789 | < | else |
790 | < | FSQLSubType := 0; |
791 | < | FBlob := nil; |
792 | < | FArray := nil; |
1134 | > | InitColumnMetaData(aMetaData); |
1135 | FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i); | |
1136 | Check4DataBaseError; | |
795 | – | FDataLength := aMetaData.getLength(StatusIntf,i); |
796 | – | Check4DataBaseError; |
797 | – | FRelationName := strpas(aMetaData.getRelation(StatusIntf,i)); |
798 | – | Check4DataBaseError; |
799 | – | FFieldName := strpas(aMetaData.getField(StatusIntf,i)); |
800 | – | Check4DataBaseError; |
801 | – | FNullable := aMetaData.isNullable(StatusIntf,i); |
802 | – | Check4DataBaseError; |
1137 | if FNullable then | |
1138 | begin | |
1139 | FSQLNullIndicator := PShort(FMessageBuffer + aMetaData.getNullOffset(StatusIntf,i)); | |
# | Line 807 | Line 1141 | begin | |
1141 | end | |
1142 | else | |
1143 | FSQLNullIndicator := nil; | |
1144 | < | FScale := aMetaData.getScale(StatusIntf,i); |
1145 | < | Check4DataBaseError; |
812 | < | FCharSetID := aMetaData.getCharSet(StatusIntf,i); |
813 | < | Check4DataBaseError; |
1144 | > | FBlob := nil; |
1145 | > | FArrayIntf := nil; |
1146 | end; | |
1147 | end; | |
1148 | SetUniqueRelationName; | |
1149 | end; | |
1150 | ||
1151 | procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull: boolean; | |
1152 | < | var len: short; var data: PChar); |
1152 | > | var len: short; var data: PByte); |
1153 | begin | |
1154 | with TIBXSQLVAR(Column[index]) do | |
1155 | begin | |
# | Line 826 | Line 1158 | begin | |
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; | |
# | Line 843 | Line 1175 | constructor TIBXSQLDA.Create(aStatement: | |
1175 | begin | |
1176 | inherited Create; | |
1177 | FStatement := aStatement; | |
1178 | + | FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI; |
1179 | FSize := 0; | |
1180 | // writeln('Creating ',ClassName); | |
1181 | end; | |
# | Line 903 | Line 1236 | begin | |
1236 | ChangeSeqNo := FStatement.ChangeSeqNo; | |
1237 | end; | |
1238 | ||
1239 | + | function TIBXSQLDA.CanChangeMetaData: boolean; |
1240 | + | begin |
1241 | + | Result := FStatement.FBatch = nil; |
1242 | + | end; |
1243 | + | |
1244 | procedure TIBXSQLDA.SetCount(Value: Integer); | |
1245 | var | |
1246 | i: Integer; | |
# | Line 934 | Line 1272 | begin | |
1272 | TIBXSQLVAR(Column[i]).FreeSQLData; | |
1273 | for i := 0 to FSize - 1 do | |
1274 | TIBXSQLVAR(Column[i]).Free; | |
1275 | + | FCount := 0; |
1276 | SetLength(FColumnList,0); | |
1277 | FSize := 0; | |
1278 | end; | |
# | Line 950 | Line 1289 | end; | |
1289 | ||
1290 | { TFB30Statement } | |
1291 | ||
1292 | + | procedure TFB30Statement.CheckChangeBatchRowLimit; |
1293 | + | begin |
1294 | + | if IsInBatchMode then |
1295 | + | IBError(ibxeInBatchMode,[nil]); |
1296 | + | end; |
1297 | + | |
1298 | procedure TFB30Statement.CheckHandle; | |
1299 | begin | |
1300 | if FStatementIntf = nil then | |
1301 | IBError(ibxeInvalidStatementHandle,[nil]); | |
1302 | end; | |
1303 | ||
1304 | + | procedure TFB30Statement.CheckBatchModeAvailable; |
1305 | + | begin |
1306 | + | if not HasBatchMode then |
1307 | + | IBError(ibxeBatchModeNotSupported,[nil]); |
1308 | + | case SQLStatementType of |
1309 | + | SQLInsert, |
1310 | + | SQLUpdate: {OK}; |
1311 | + | else |
1312 | + | IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]); |
1313 | + | end; |
1314 | + | end; |
1315 | + | |
1316 | procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults | |
1317 | ); | |
1318 | begin | |
1319 | < | with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do |
1319 | > | with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do |
1320 | begin | |
1321 | StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request), | |
1322 | GetBufSize, BytePtr(Buffer)); | |
# | Line 967 | Line 1324 | begin | |
1324 | end; | |
1325 | end; | |
1326 | ||
1327 | < | procedure TFB30Statement.InternalPrepare; |
1327 | > | function TFB30Statement.GetStatementIntf: IStatement; |
1328 | > | begin |
1329 | > | Result := self; |
1330 | > | end; |
1331 | > | |
1332 | > | procedure TFB30Statement.InternalPrepare(CursorName: AnsiString); |
1333 | > | var GUID : TGUID; |
1334 | begin | |
1335 | if FPrepared then | |
1336 | Exit; | |
1337 | + | |
1338 | + | FCursor := CursorName; |
1339 | if (FSQL = '') then | |
1340 | IBError(ibxeEmptyQuery, [nil]); | |
1341 | try | |
1342 | CheckTransaction(FTransactionIntf); | |
1343 | < | with Firebird30ClientAPI do |
1343 | > | with FFirebird30ClientAPI do |
1344 | begin | |
1345 | + | if FCursor = '' then |
1346 | + | begin |
1347 | + | CreateGuid(GUID); |
1348 | + | FCursor := GUIDToString(GUID); |
1349 | + | end; |
1350 | + | |
1351 | if FHasParamNames then | |
1352 | begin | |
1353 | if FProcessedSQL = '' then | |
1354 | < | FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL); |
1354 | > | ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL); |
1355 | FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf, | |
1356 | (FTransactionIntf as TFB30Transaction).TransactionIntf, | |
1357 | Length(FProcessedSQL), | |
1358 | < | PChar(FProcessedSQL), |
1358 | > | PAnsiChar(FProcessedSQL), |
1359 | FSQLDialect, | |
1360 | Firebird.IStatement.PREPARE_PREFETCH_METADATA); | |
1361 | end | |
# | Line 992 | Line 1363 | begin | |
1363 | FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf, | |
1364 | (FTransactionIntf as TFB30Transaction).TransactionIntf, | |
1365 | Length(FSQL), | |
1366 | < | PChar(FSQL), |
1366 | > | PAnsiChar(FSQL), |
1367 | FSQLDialect, | |
1368 | Firebird.IStatement.PREPARE_PREFETCH_METADATA); | |
1369 | Check4DataBaseError; | |
1370 | FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf)); | |
1371 | Check4DataBaseError; | |
1372 | ||
1373 | + | if FSQLStatementType = SQLSelect then |
1374 | + | begin |
1375 | + | FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor)); |
1376 | + | Check4DataBaseError; |
1377 | + | end; |
1378 | { Done getting the type } | |
1379 | case FSQLStatementType of | |
1380 | SQLGetSegment, | |
# | Line 1031 | Line 1407 | begin | |
1407 | if (FStatementIntf <> nil) then | |
1408 | FreeHandle; | |
1409 | if E is EIBInterBaseError then | |
1410 | < | raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode, |
1411 | < | EIBInterBaseError(E).IBErrorCode, |
1036 | < | EIBInterBaseError(E).Message + |
1037 | < | sSQLErrorSeparator + FSQL) |
1038 | < | else |
1039 | < | raise; |
1410 | > | E.Message := E.Message + sSQLErrorSeparator + FSQL; |
1411 | > | raise; |
1412 | end; | |
1413 | end; | |
1414 | FPrepared := true; | |
1415 | + | |
1416 | FSingleResults := false; | |
1417 | if RetainInterfaces then | |
1418 | begin | |
# | Line 1057 | Line 1430 | begin | |
1430 | end; | |
1431 | ||
1432 | function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults; | |
1433 | + | |
1434 | + | procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil); |
1435 | + | begin |
1436 | + | with FFirebird30ClientAPI do |
1437 | + | begin |
1438 | + | SavePerfStats(FBeforeStats); |
1439 | + | FStatementIntf.execute(StatusIntf, |
1440 | + | (aTransaction as TFB30Transaction).TransactionIntf, |
1441 | + | FSQLParams.MetaData, |
1442 | + | FSQLParams.MessageBuffer, |
1443 | + | outMetaData, |
1444 | + | outBuffer); |
1445 | + | Check4DataBaseError; |
1446 | + | FStatisticsAvailable := SavePerfStats(FAfterStats); |
1447 | + | end; |
1448 | + | end; |
1449 | + | |
1450 | + | var Cursor: IResultSet; |
1451 | + | |
1452 | begin | |
1453 | Result := nil; | |
1454 | + | FBatchCompletion := nil; |
1455 | FBOF := false; | |
1456 | FEOF := false; | |
1457 | FSingleResults := false; | |
1458 | + | FStatisticsAvailable := false; |
1459 | + | if IsInBatchMode then |
1460 | + | IBerror(ibxeInBatchMode,[]); |
1461 | CheckTransaction(aTransaction); | |
1462 | if not FPrepared then | |
1463 | InternalPrepare; | |
1464 | CheckHandle; | |
1465 | if aTransaction <> FTransactionIntf then | |
1466 | AddMonitor(aTransaction as TFB30Transaction); | |
1467 | < | if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then |
1467 | > | if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then |
1468 | IBError(ibxeInterfaceOutofDate,[nil]); | |
1469 | ||
1470 | + | |
1471 | try | |
1472 | < | with Firebird30ClientAPI do |
1472 | > | with FFirebird30ClientAPI do |
1473 | begin | |
1077 | – | if FCollectStatistics then |
1078 | – | begin |
1079 | – | UtilIntf.getPerfCounters(StatusIntf, |
1080 | – | (GetAttachment as TFB30Attachment).AttachmentIntf, |
1081 | – | ISQL_COUNTERS,@FBeforeStats); |
1082 | – | Check4DataBaseError; |
1083 | – | end; |
1084 | – | |
1474 | case FSQLStatementType of | |
1475 | SQLSelect: | |
1476 | < | IBError(ibxeIsAExecuteProcedure,[]); |
1476 | > | {e.g. Update...returning with a single row in Firebird 5 and later} |
1477 | > | begin |
1478 | > | Cursor := InternalOpenCursor(aTransaction,false); |
1479 | > | if not Cursor.IsEof then |
1480 | > | Cursor.FetchNext; |
1481 | > | Result := Cursor; {note only first row} |
1482 | > | FSingleResults := true; |
1483 | > | end; |
1484 | ||
1485 | SQLExecProcedure: | |
1486 | begin | |
1487 | < | FStatementIntf.execute(StatusIntf, |
1092 | < | (aTransaction as TFB30Transaction).TransactionIntf, |
1093 | < | FSQLParams.MetaData, |
1094 | < | FSQLParams.MessageBuffer, |
1095 | < | FSQLRecord.MetaData, |
1096 | < | FSQLRecord.MessageBuffer); |
1097 | < | Check4DataBaseError; |
1098 | < | |
1487 | > | ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer); |
1488 | Result := TResults.Create(FSQLRecord); | |
1489 | FSingleResults := true; | |
1101 | – | end |
1102 | – | else |
1103 | – | FStatementIntf.execute(StatusIntf, |
1104 | – | (aTransaction as TFB30Transaction).TransactionIntf, |
1105 | – | FSQLParams.MetaData, |
1106 | – | FSQLParams.MessageBuffer, |
1107 | – | nil, |
1108 | – | nil); |
1109 | – | Check4DataBaseError; |
1490 | end; | |
1491 | < | if FCollectStatistics then |
1492 | < | begin |
1493 | < | UtilIntf.getPerfCounters(StatusIntf, |
1114 | < | (GetAttachment as TFB30Attachment).AttachmentIntf, |
1115 | < | ISQL_COUNTERS, @FAfterStats); |
1116 | < | Check4DataBaseError; |
1117 | < | FStatisticsAvailable := true; |
1491 | > | |
1492 | > | else |
1493 | > | ExecuteQuery; |
1494 | end; | |
1495 | end; | |
1496 | finally | |
# | Line 1122 | Line 1498 | begin | |
1498 | RemoveMonitor(aTransaction as TFB30Transaction); | |
1499 | end; | |
1500 | FExecTransactionIntf := aTransaction; | |
1501 | + | FSQLRecord.FTransaction := (aTransaction as TFB30Transaction); |
1502 | + | FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo; |
1503 | SignalActivity; | |
1504 | Inc(FChangeSeqNo); | |
1505 | end; | |
1506 | ||
1507 | < | function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction |
1508 | < | ): IResultSet; |
1507 | > | function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction; |
1508 | > | Scrollable: boolean): IResultSet; |
1509 | > | var flags: cardinal; |
1510 | begin | |
1511 | < | if FSQLStatementType <> SQLSelect then |
1511 | > | flags := 0; |
1512 | > | if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then |
1513 | IBError(ibxeIsASelectStatement,[]); | |
1514 | ||
1515 | < | CheckTransaction(aTransaction); |
1515 | > | FBatchCompletion := nil; |
1516 | > | CheckTransaction(aTransaction); |
1517 | if not FPrepared then | |
1518 | InternalPrepare; | |
1519 | CheckHandle; | |
1520 | if aTransaction <> FTransactionIntf then | |
1521 | AddMonitor(aTransaction as TFB30Transaction); | |
1522 | < | if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then |
1522 | > | if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then |
1523 | IBError(ibxeInterfaceOutofDate,[nil]); | |
1524 | ||
1525 | < | with Firebird30ClientAPI do |
1525 | > | if Scrollable then |
1526 | > | flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE; |
1527 | > | |
1528 | > | with FFirebird30ClientAPI do |
1529 | begin | |
1530 | if FCollectStatistics then | |
1531 | begin | |
# | Line 1156 | Line 1540 | begin | |
1540 | FSQLParams.MetaData, | |
1541 | FSQLParams.MessageBuffer, | |
1542 | FSQLRecord.MetaData, | |
1543 | < | 0); |
1543 | > | flags); |
1544 | Check4DataBaseError; | |
1545 | ||
1546 | if FCollectStatistics then | |
# | Line 1181 | Line 1565 | begin | |
1565 | Inc(FChangeSeqNo); | |
1566 | end; | |
1567 | ||
1568 | + | procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; |
1569 | + | var processedSQL: AnsiString); |
1570 | + | begin |
1571 | + | FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL); |
1572 | + | end; |
1573 | + | |
1574 | procedure TFB30Statement.FreeHandle; | |
1575 | begin | |
1576 | Close; | |
1577 | ReleaseInterfaces; | |
1578 | + | if FBatch <> nil then |
1579 | + | begin |
1580 | + | FBatch.release; |
1581 | + | FBatch := nil; |
1582 | + | end; |
1583 | if FStatementIntf <> nil then | |
1584 | begin | |
1585 | FStatementIntf.release; | |
1586 | FStatementIntf := nil; | |
1587 | FPrepared := false; | |
1588 | end; | |
1589 | + | FCursor := ''; |
1590 | end; | |
1591 | ||
1592 | procedure TFB30Statement.InternalClose(Force: boolean); | |
1593 | begin | |
1594 | if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then | |
1595 | try | |
1596 | < | with Firebird30ClientAPI do |
1596 | > | with FFirebird30ClientAPI do |
1597 | begin | |
1598 | if FResultSet <> nil then | |
1599 | begin | |
# | Line 1211 | Line 1607 | begin | |
1607 | if not Force then Check4DataBaseError; | |
1608 | end; | |
1609 | finally | |
1610 | < | if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then |
1610 | > | if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB30Transaction)) then |
1611 | RemoveMonitor(FSQLRecord.FTransaction); | |
1612 | FOpen := False; | |
1613 | FExecTransactionIntf := nil; | |
# | Line 1221 | Line 1617 | begin | |
1617 | Inc(FChangeSeqNo); | |
1618 | end; | |
1619 | ||
1620 | + | function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean; |
1621 | + | begin |
1622 | + | Result := false; |
1623 | + | if FCollectStatistics then |
1624 | + | with FFirebird30ClientAPI do |
1625 | + | begin |
1626 | + | UtilIntf.getPerfCounters(StatusIntf, |
1627 | + | (GetAttachment as TFB30Attachment).AttachmentIntf, |
1628 | + | ISQL_COUNTERS, @Stats); |
1629 | + | Check4DataBaseError; |
1630 | + | Result := true; |
1631 | + | end; |
1632 | + | end; |
1633 | + | |
1634 | constructor TFB30Statement.Create(Attachment: TFB30Attachment; | |
1635 | < | Transaction: ITransaction; sql: string; aSQLDialect: integer); |
1635 | > | Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; |
1636 | > | CursorName: AnsiString); |
1637 | begin | |
1638 | inherited Create(Attachment,Transaction,sql,aSQLDialect); | |
1639 | + | FFirebird30ClientAPI := Attachment.Firebird30ClientAPI; |
1640 | FSQLParams := TIBXINPUTSQLDA.Create(self); | |
1641 | FSQLRecord := TIBXOUTPUTSQLDA.Create(self); | |
1642 | < | InternalPrepare; |
1642 | > | InternalPrepare(CursorName); |
1643 | end; | |
1644 | ||
1645 | constructor TFB30Statement.CreateWithParameterNames( | |
1646 | < | Attachment: TFB30Attachment; Transaction: ITransaction; sql: string; |
1647 | < | aSQLDialect: integer; GenerateParamNames: boolean); |
1646 | > | Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString; |
1647 | > | aSQLDialect: integer; GenerateParamNames: boolean; |
1648 | > | CaseSensitiveParams: boolean; CursorName: AnsiString); |
1649 | begin | |
1650 | inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames); | |
1651 | + | FFirebird30ClientAPI := Attachment.Firebird30ClientAPI; |
1652 | FSQLParams := TIBXINPUTSQLDA.Create(self); | |
1653 | + | FSQLParams.CaseSensitiveParams := CaseSensitiveParams; |
1654 | FSQLRecord := TIBXOUTPUTSQLDA.Create(self); | |
1655 | < | InternalPrepare; |
1655 | > | InternalPrepare(CursorName); |
1656 | end; | |
1657 | ||
1658 | destructor TFB30Statement.Destroy; | |
# | Line 1247 | Line 1662 | begin | |
1662 | if assigned(FSQLRecord) then FSQLRecord.Free; | |
1663 | end; | |
1664 | ||
1665 | < | function TFB30Statement.FetchNext: boolean; |
1665 | > | function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer |
1666 | > | ): boolean; |
1667 | var fetchResult: integer; | |
1668 | begin | |
1669 | result := false; | |
1670 | if not FOpen then | |
1671 | IBError(ibxeSQLClosed, [nil]); | |
1256 | – | if FEOF then |
1257 | – | IBError(ibxeEOF,[nil]); |
1672 | ||
1673 | < | with Firebird30ClientAPI do |
1673 | > | with FFirebird30ClientAPI do |
1674 | begin | |
1675 | < | { Go to the next record... } |
1676 | < | fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer); |
1677 | < | if fetchResult = Firebird.IStatus.RESULT_NO_DATA then |
1678 | < | begin |
1679 | < | FBOF := false; |
1680 | < | FEOF := true; |
1681 | < | Exit; {End of File} |
1682 | < | end |
1683 | < | else |
1684 | < | if fetchResult <> Firebird.IStatus.RESULT_OK then |
1685 | < | begin |
1686 | < | try |
1687 | < | IBDataBaseError; |
1274 | < | except |
1275 | < | Close; |
1276 | < | raise; |
1675 | > | case FetchType of |
1676 | > | ftNext: |
1677 | > | begin |
1678 | > | if FEOF then |
1679 | > | IBError(ibxeEOF,[nil]); |
1680 | > | { Go to the next record... } |
1681 | > | fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer); |
1682 | > | if fetchResult = Firebird.IStatus.RESULT_NO_DATA then |
1683 | > | begin |
1684 | > | FBOF := false; |
1685 | > | FEOF := true; |
1686 | > | Exit; {End of File} |
1687 | > | end |
1688 | end; | |
1689 | < | end |
1690 | < | else |
1689 | > | |
1690 | > | ftPrior: |
1691 | > | begin |
1692 | > | if FBOF then |
1693 | > | IBError(ibxeBOF,[nil]); |
1694 | > | { Go to the next record... } |
1695 | > | fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer); |
1696 | > | if fetchResult = Firebird.IStatus.RESULT_NO_DATA then |
1697 | > | begin |
1698 | > | FBOF := true; |
1699 | > | FEOF := false; |
1700 | > | Exit; {Top of File} |
1701 | > | end |
1702 | > | end; |
1703 | > | |
1704 | > | ftFirst: |
1705 | > | fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer); |
1706 | > | |
1707 | > | ftLast: |
1708 | > | fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer); |
1709 | > | |
1710 | > | ftAbsolute: |
1711 | > | fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer); |
1712 | > | |
1713 | > | ftRelative: |
1714 | > | fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer); |
1715 | > | end; |
1716 | > | |
1717 | > | Check4DataBaseError; |
1718 | > | if fetchResult <> Firebird.IStatus.RESULT_OK then |
1719 | > | exit; {result = false} |
1720 | > | |
1721 | > | {Result OK} |
1722 | > | FBOF := false; |
1723 | > | FEOF := false; |
1724 | > | result := true; |
1725 | > | |
1726 | > | if FCollectStatistics then |
1727 | begin | |
1728 | < | FBOF := false; |
1729 | < | result := true; |
1728 | > | UtilIntf.getPerfCounters(StatusIntf, |
1729 | > | (GetAttachment as TFB30Attachment).AttachmentIntf, |
1730 | > | ISQL_COUNTERS,@FAfterStats); |
1731 | > | Check4DataBaseError; |
1732 | > | FStatisticsAvailable := true; |
1733 | end; | |
1734 | end; | |
1735 | FSQLRecord.RowChange; | |
# | Line 1304 | Line 1754 | begin | |
1754 | Result := TMetaData(GetInterface(1)); | |
1755 | end; | |
1756 | ||
1757 | < | function TFB30Statement.GetPlan: String; |
1757 | > | function TFB30Statement.GetPlan: AnsiString; |
1758 | begin | |
1759 | CheckHandle; | |
1760 | if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate, | |
# | Line 1312 | Line 1762 | begin | |
1762 | SQLUpdate, SQLDelete])) then | |
1763 | result := '' | |
1764 | else | |
1765 | < | with Firebird30ClientAPI do |
1765 | > | with FFirebird30ClientAPI do |
1766 | begin | |
1767 | Result := FStatementIntf.getPlan(StatusIntf,true); | |
1768 | Check4DataBaseError; | |
# | Line 1346 | Line 1796 | begin | |
1796 | TSQLParams(GetInterface(0)).RetainInterfaces := aValue; | |
1797 | end; | |
1798 | ||
1799 | + | function TFB30Statement.IsInBatchMode: boolean; |
1800 | + | begin |
1801 | + | Result := FBatch <> nil; |
1802 | + | end; |
1803 | + | |
1804 | + | function TFB30Statement.HasBatchMode: boolean; |
1805 | + | begin |
1806 | + | Result := GetAttachment.HasBatchMode; |
1807 | + | end; |
1808 | + | |
1809 | + | procedure TFB30Statement.AddToBatch; |
1810 | + | var BatchPB: TXPBParameterBlock; |
1811 | + | |
1812 | + | const SixteenMB = 16 * 1024 * 1024; |
1813 | + | begin |
1814 | + | FBatchCompletion := nil; |
1815 | + | if not FPrepared then |
1816 | + | InternalPrepare; |
1817 | + | CheckHandle; |
1818 | + | CheckBatchModeAvailable; |
1819 | + | with FFirebird30ClientAPI do |
1820 | + | begin |
1821 | + | if FBatch = nil then |
1822 | + | begin |
1823 | + | {Start Batch} |
1824 | + | BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH); |
1825 | + | with FFirebird30ClientAPI do |
1826 | + | try |
1827 | + | FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf); |
1828 | + | Check4DatabaseError; |
1829 | + | if FBatchBufferSize < SixteenMB then |
1830 | + | FBatchBufferSize := SixteenMB; |
1831 | + | if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then |
1832 | + | IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]); |
1833 | + | |
1834 | + | BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1); |
1835 | + | BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize); |
1836 | + | FBatch := FStatementIntf.createBatch(StatusIntf, |
1837 | + | FSQLParams.MetaData, |
1838 | + | BatchPB.getDataLength, |
1839 | + | BatchPB.getBuffer); |
1840 | + | Check4DataBaseError; |
1841 | + | |
1842 | + | finally |
1843 | + | BatchPB.Free; |
1844 | + | end; |
1845 | + | FBatchRowCount := 0; |
1846 | + | FBatchBufferUsed := 0; |
1847 | + | end; |
1848 | + | |
1849 | + | Inc(FBatchRowCount); |
1850 | + | Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf)); |
1851 | + | Check4DataBaseError; |
1852 | + | if FBatchBufferUsed > FBatchBufferSize then |
1853 | + | raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow), |
1854 | + | Format(GetErrorMessage(ibxeBatchRowBufferOverflow), |
1855 | + | [FBatchRowCount,FBatchBufferSize])); |
1856 | + | |
1857 | + | FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer); |
1858 | + | Check4DataBaseError |
1859 | + | end; |
1860 | + | end; |
1861 | + | |
1862 | + | function TFB30Statement.ExecuteBatch(aTransaction: ITransaction |
1863 | + | ): IBatchCompletion; |
1864 | + | |
1865 | + | procedure Check4BatchCompletionError(bc: IBatchCompletion); |
1866 | + | var status: IStatus; |
1867 | + | RowNo: integer; |
1868 | + | begin |
1869 | + | status := nil; |
1870 | + | {Raise an exception if there was an error reported in the BatchCompletion} |
1871 | + | if (bc <> nil) and bc.getErrorStatus(RowNo,status) then |
1872 | + | raise EIBInterbaseError.Create(status); |
1873 | + | end; |
1874 | + | |
1875 | + | var cs: Firebird.IBatchCompletionState; |
1876 | + | |
1877 | + | begin |
1878 | + | Result := nil; |
1879 | + | if FBatch = nil then |
1880 | + | IBError(ibxeNotInBatchMode,[]); |
1881 | + | |
1882 | + | with FFirebird30ClientAPI do |
1883 | + | begin |
1884 | + | SavePerfStats(FBeforeStats); |
1885 | + | if aTransaction = nil then |
1886 | + | cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf) |
1887 | + | else |
1888 | + | cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf); |
1889 | + | Check4DataBaseError; |
1890 | + | FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs); |
1891 | + | FStatisticsAvailable := SavePerfStats(FAfterStats); |
1892 | + | FBatch.release; |
1893 | + | FBatch := nil; |
1894 | + | Check4BatchCompletionError(FBatchCompletion); |
1895 | + | Result := FBatchCompletion; |
1896 | + | end; |
1897 | + | end; |
1898 | + | |
1899 | + | procedure TFB30Statement.CancelBatch; |
1900 | + | begin |
1901 | + | if FBatch = nil then |
1902 | + | IBError(ibxeNotInBatchMode,[]); |
1903 | + | FBatch.release; |
1904 | + | FBatch := nil; |
1905 | + | end; |
1906 | + | |
1907 | + | function TFB30Statement.GetBatchCompletion: IBatchCompletion; |
1908 | + | begin |
1909 | + | Result := FBatchCompletion; |
1910 | + | end; |
1911 | + | |
1912 | function TFB30Statement.IsPrepared: boolean; | |
1913 | begin | |
1914 | Result := FStatementIntf <> nil; | |
1915 | end; | |
1916 | ||
1917 | + | function TFB30Statement.GetFlags: TStatementFlags; |
1918 | + | var flags: cardinal; |
1919 | + | begin |
1920 | + | CheckHandle; |
1921 | + | Result := []; |
1922 | + | with FFirebird30ClientAPI do |
1923 | + | begin |
1924 | + | flags := FStatementIntf.getFlags(StatusIntf); |
1925 | + | Check4DataBaseError; |
1926 | + | end; |
1927 | + | if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then |
1928 | + | Result := Result + [stHasCursor]; |
1929 | + | if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then |
1930 | + | Result := Result + [stRepeatExecute]; |
1931 | + | if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then |
1932 | + | Result := Result + [stScrollable]; |
1933 | + | end; |
1934 | + | |
1935 | end. | |
1936 |
– | Removed lines |
+ | Added lines |
< | Changed lines |
> | Changed lines |