# | 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} | |
91 | FArray: IArray; | |
92 | FNullIndicator: short; | |
# | Line 94 | Line 97 | type | |
97 | {SQL Var Type Data} | |
98 | FSQLType: cardinal; | |
99 | FSQLSubType: integer; | |
100 | < | FSQLData: PChar; {Address of SQL Data in Message Buffer} |
100 | > | FSQLData: PByte; {Address of SQL Data in Message Buffer} |
101 | FSQLNullIndicator: PShort; {Address of null indicator} | |
102 | FDataLength: integer; | |
103 | + | FMetadataSize: integer; |
104 | FNullable: boolean; | |
105 | FScale: integer; | |
106 | FCharSetID: cardinal; | |
107 | < | FRelationName: string; |
108 | < | FFieldName: string; |
107 | > | FRelationName: AnsiString; |
108 | > | FFieldName: AnsiString; |
109 | ||
110 | protected | |
111 | + | function CanChangeSQLType: boolean; |
112 | function GetSQLType: cardinal; override; | |
113 | function GetSubtype: integer; override; | |
114 | < | function GetAliasName: string; override; |
115 | < | function GetFieldName: string; override; |
116 | < | function GetOwnerName: string; override; |
117 | < | function GetRelationName: string; override; |
114 | > | function GetAliasName: AnsiString; override; |
115 | > | function GetFieldName: AnsiString; override; |
116 | > | function GetOwnerName: AnsiString; override; |
117 | > | function GetRelationName: AnsiString; override; |
118 | function GetScale: integer; override; | |
119 | function GetCharSetID: cardinal; override; | |
120 | function GetCodePage: TSystemCodePage; override; | |
121 | + | function GetCharSetWidth: integer; override; |
122 | function GetIsNull: Boolean; override; | |
123 | function GetIsNullable: boolean; override; | |
124 | < | function GetSQLData: PChar; override; |
124 | > | function GetSQLData: PByte; override; |
125 | function GetDataLength: cardinal; override; | |
126 | + | function GetSize: cardinal; override; |
127 | + | function GetAttachment: IAttachment; override; |
128 | + | function GetDefaultTextSQLType: cardinal; override; |
129 | procedure SetIsNull(Value: Boolean); override; | |
130 | procedure SetIsNullable(Value: Boolean); override; | |
131 | < | procedure SetSQLData(AValue: PChar; len: cardinal); override; |
131 | > | procedure SetSQLData(AValue: PByte; len: cardinal); override; |
132 | procedure SetScale(aValue: integer); override; | |
133 | procedure SetDataLength(len: cardinal); override; | |
134 | procedure SetSQLType(aValue: cardinal); override; | |
135 | procedure SetCharSetID(aValue: cardinal); override; | |
136 | < | |
136 | > | procedure SetMetaSize(aValue: cardinal); override; |
137 | public | |
138 | constructor Create(aParent: TIBXSQLDA; aIndex: integer); | |
139 | procedure Changed; override; | |
140 | + | procedure ColumnSQLDataInit; |
141 | procedure RowChange; override; | |
142 | procedure FreeSQLData; | |
143 | function GetAsArray(Array_ID: TISC_QUAD): IArray; 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 221 | Line 236 | type | |
236 | destructor Destroy; override; | |
237 | {IResultSet} | |
238 | function FetchNext: boolean; | |
239 | < | function GetCursorName: string; |
239 | > | function GetCursorName: AnsiString; |
240 | function GetTransaction: ITransaction; override; | |
241 | function IsEof: boolean; | |
242 | procedure Close; | |
243 | end; | |
244 | ||
245 | + | { TBatchCompletion } |
246 | + | |
247 | + | TBatchCompletion = class(TInterfaceOwner,IBatchCompletion) |
248 | + | private |
249 | + | FCompletionState: Firebird.IBatchCompletionState; |
250 | + | FFirebird30ClientAPI: TFB30ClientAPI; |
251 | + | public |
252 | + | constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState); |
253 | + | destructor Destroy; override; |
254 | + | {IBatchCompletion} |
255 | + | function getErrorStatus(var RowNo: integer; var status: IStatus): boolean; |
256 | + | function getTotalProcessed: cardinal; |
257 | + | function getState(updateNo: cardinal): TBatchCompletionState; |
258 | + | function getStatusMessage(updateNo: cardinal): AnsiString; |
259 | + | function getUpdated: integer; |
260 | + | end; |
261 | + | |
262 | { TFB30Statement } | |
263 | ||
264 | TFB30Statement = class(TFBStatement,IStatement) | |
265 | private | |
266 | FStatementIntf: Firebird.IStatement; | |
267 | + | FFirebird30ClientAPI: TFB30ClientAPI; |
268 | FSQLParams: TIBXINPUTSQLDA; | |
269 | FSQLRecord: TIBXOUTPUTSQLDA; | |
270 | FResultSet: Firebird.IResultSet; | |
271 | FCursorSeqNo: integer; | |
272 | + | FBatch: Firebird.IBatch; |
273 | + | FBatchCompletion: IBatchCompletion; |
274 | + | FBatchRowCount: integer; |
275 | + | FBatchBufferSize: integer; |
276 | + | FBatchBufferUsed: integer; |
277 | protected | |
278 | + | procedure CheckChangeBatchRowLimit; override; |
279 | procedure CheckHandle; override; | |
280 | + | procedure CheckBatchModeAvailable; |
281 | procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override; | |
282 | procedure InternalPrepare; override; | |
283 | function InternalExecute(aTransaction: ITransaction): IResults; override; | |
284 | function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override; | |
285 | + | procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override; |
286 | procedure FreeHandle; override; | |
287 | procedure InternalClose(Force: boolean); override; | |
288 | + | function SavePerfStats(var Stats: TPerfStatistics): boolean; |
289 | public | |
290 | constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction; | |
291 | < | sql: string; aSQLDialect: integer); |
291 | > | sql: AnsiString; aSQLDialect: integer); |
292 | constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction; | |
293 | < | sql: string; aSQLDialect: integer; GenerateParamNames: boolean =false); |
293 | > | sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean =false; |
294 | > | CaseSensitiveParams: boolean=false); |
295 | destructor Destroy; override; | |
296 | function FetchNext: boolean; | |
297 | property StatementIntf: Firebird.IStatement read FStatementIntf; | |
# | Line 257 | Line 300 | type | |
300 | {IStatement} | |
301 | function GetSQLParams: ISQLParams; override; | |
302 | function GetMetaData: IMetaData; override; | |
303 | < | function GetPlan: String; |
303 | > | function GetPlan: AnsiString; |
304 | function IsPrepared: boolean; | |
305 | function CreateBlob(column: TColumnMetaData): IBlob; override; | |
306 | function CreateArray(column: TColumnMetaData): IArray; override; | |
307 | procedure SetRetainInterfaces(aValue: boolean); override; | |
308 | < | |
308 | > | function IsInBatchMode: boolean; override; |
309 | > | function HasBatchMode: boolean; override; |
310 | > | procedure AddToBatch; override; |
311 | > | function ExecuteBatch(aTransaction: ITransaction |
312 | > | ): IBatchCompletion; override; |
313 | > | procedure CancelBatch; override; |
314 | > | function GetBatchCompletion: IBatchCompletion; override; |
315 | end; | |
316 | ||
317 | implementation | |
318 | ||
319 | < | uses IBUtils, FBMessages, FBBLob, FB30Blob, variants, FBArray, FB30Array; |
319 | > | uses IBUtils, FBMessages, FBBlob, FB30Blob, variants, FBArray, FB30Array; |
320 | ||
321 | const | |
322 | ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches'; | |
323 | ||
324 | + | { EIBBatchCompletionError } |
325 | + | |
326 | + | { TBatchCompletion } |
327 | + | |
328 | + | constructor TBatchCompletion.Create(api: TFB30ClientAPI; |
329 | + | cs: IBatchCompletionState); |
330 | + | begin |
331 | + | inherited Create; |
332 | + | FFirebird30ClientAPI := api; |
333 | + | FCompletionState := cs; |
334 | + | end; |
335 | + | |
336 | + | destructor TBatchCompletion.Destroy; |
337 | + | begin |
338 | + | if FCompletionState <> nil then |
339 | + | begin |
340 | + | FCompletionState.dispose; |
341 | + | FCompletionState := nil; |
342 | + | end; |
343 | + | inherited Destroy; |
344 | + | end; |
345 | + | |
346 | + | function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus |
347 | + | ): boolean; |
348 | + | var i: integer; |
349 | + | upcount: cardinal; |
350 | + | state: integer; |
351 | + | FBStatus: Firebird.IStatus; |
352 | + | begin |
353 | + | Result := false; |
354 | + | RowNo := -1; |
355 | + | FBStatus := nil; |
356 | + | with FFirebird30ClientAPI do |
357 | + | begin |
358 | + | upcount := FCompletionState.getSize(StatusIntf); |
359 | + | Check4DataBaseError; |
360 | + | for i := 0 to upcount - 1 do |
361 | + | begin |
362 | + | state := FCompletionState.getState(StatusIntf,i); |
363 | + | if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then |
364 | + | begin |
365 | + | RowNo := i+1; |
366 | + | FBStatus := MasterIntf.getStatus; |
367 | + | try |
368 | + | FCompletionState.getStatus(StatusIntf,FBStatus,i); |
369 | + | Check4DataBaseError; |
370 | + | except |
371 | + | FBStatus.dispose; |
372 | + | raise |
373 | + | end; |
374 | + | status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus, |
375 | + | Format(SBatchCompletionError,[RowNo])); |
376 | + | status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages); |
377 | + | Result := true; |
378 | + | break; |
379 | + | end; |
380 | + | end; |
381 | + | end; |
382 | + | end; |
383 | + | |
384 | + | function TBatchCompletion.getTotalProcessed: cardinal; |
385 | + | begin |
386 | + | with FFirebird30ClientAPI do |
387 | + | begin |
388 | + | Result := FCompletionState.getsize(StatusIntf); |
389 | + | Check4DataBaseError; |
390 | + | end; |
391 | + | end; |
392 | + | |
393 | + | function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState; |
394 | + | var state: integer; |
395 | + | begin |
396 | + | with FFirebird30ClientAPI do |
397 | + | begin |
398 | + | state := FCompletionState.getState(StatusIntf,updateNo); |
399 | + | Check4DataBaseError; |
400 | + | case state of |
401 | + | Firebird.IBatchCompletionState.EXECUTE_FAILED: |
402 | + | Result := bcExecuteFailed; |
403 | + | |
404 | + | Firebird.IBatchCompletionState.SUCCESS_NO_INFO: |
405 | + | Result := bcSuccessNoInfo; |
406 | + | |
407 | + | else |
408 | + | Result := bcNoMoreErrors; |
409 | + | end; |
410 | + | end; |
411 | + | end; |
412 | + | |
413 | + | function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString; |
414 | + | var status: Firebird.IStatus; |
415 | + | begin |
416 | + | with FFirebird30ClientAPI do |
417 | + | begin |
418 | + | status := MasterIntf.getStatus; |
419 | + | FCompletionState.getStatus(StatusIntf,status,updateNo); |
420 | + | Check4DataBaseError; |
421 | + | Result := FormatFBStatus(status); |
422 | + | end; |
423 | + | end; |
424 | + | |
425 | + | function TBatchCompletion.getUpdated: integer; |
426 | + | var i: integer; |
427 | + | upcount: cardinal; |
428 | + | state: integer; |
429 | + | begin |
430 | + | Result := 0; |
431 | + | with FFirebird30ClientAPI do |
432 | + | begin |
433 | + | upcount := FCompletionState.getSize(StatusIntf); |
434 | + | Check4DataBaseError; |
435 | + | for i := 0 to upcount -1 do |
436 | + | begin |
437 | + | state := FCompletionState.getState(StatusIntf,i); |
438 | + | if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then |
439 | + | break; |
440 | + | Inc(Result); |
441 | + | end; |
442 | + | end; |
443 | + | end; |
444 | + | |
445 | { TIBXSQLVAR } | |
446 | ||
447 | procedure TIBXSQLVAR.Changed; | |
# | Line 280 | Line 450 | begin | |
450 | TIBXSQLDA(Parent).Changed; | |
451 | end; | |
452 | ||
453 | + | procedure TIBXSQLVAR.ColumnSQLDataInit; |
454 | + | begin |
455 | + | FreeSQLData; |
456 | + | with FFirebird30ClientAPI do |
457 | + | begin |
458 | + | case SQLType of |
459 | + | SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP, |
460 | + | SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN, |
461 | + | SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, |
462 | + | SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34, |
463 | + | SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX: |
464 | + | begin |
465 | + | if (FDataLength = 0) then |
466 | + | { Make sure you get a valid pointer anyway |
467 | + | select '' from foo } |
468 | + | IBAlloc(FSQLData, 0, 1) |
469 | + | else |
470 | + | IBAlloc(FSQLData, 0, FDataLength) |
471 | + | end; |
472 | + | SQL_VARYING: |
473 | + | IBAlloc(FSQLData, 0, FDataLength + 2); |
474 | + | else |
475 | + | IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)]) |
476 | + | end; |
477 | + | FOwnsSQLData := true; |
478 | + | FNullIndicator := -1; |
479 | + | end; |
480 | + | end; |
481 | + | |
482 | + | function TIBXSQLVAR.CanChangeSQLType: boolean; |
483 | + | begin |
484 | + | Result := Parent.CanChangeMetaData; |
485 | + | end; |
486 | + | |
487 | function TIBXSQLVAR.GetSQLType: cardinal; | |
488 | begin | |
489 | Result := FSQLType; | |
# | Line 290 | Line 494 | begin | |
494 | Result := FSQLSubType; | |
495 | end; | |
496 | ||
497 | < | function TIBXSQLVAR.GetAliasName: string; |
497 | > | function TIBXSQLVAR.GetAliasName: AnsiString; |
498 | begin | |
499 | < | with Firebird30ClientAPI do |
499 | > | with FFirebird30ClientAPI do |
500 | begin | |
501 | result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index)); | |
502 | Check4DataBaseError; | |
503 | end; | |
504 | end; | |
505 | ||
506 | < | function TIBXSQLVAR.GetFieldName: string; |
506 | > | function TIBXSQLVAR.GetFieldName: AnsiString; |
507 | begin | |
508 | Result := FFieldName; | |
509 | end; | |
510 | ||
511 | < | function TIBXSQLVAR.GetOwnerName: string; |
511 | > | function TIBXSQLVAR.GetOwnerName: AnsiString; |
512 | begin | |
513 | < | with Firebird30ClientAPI do |
513 | > | with FFirebird30ClientAPI do |
514 | begin | |
515 | result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index)); | |
516 | Check4DataBaseError; | |
517 | end; | |
518 | end; | |
519 | ||
520 | < | function TIBXSQLVAR.GetRelationName: string; |
520 | > | function TIBXSQLVAR.GetRelationName: AnsiString; |
521 | begin | |
522 | Result := FRelationName; | |
523 | end; | |
# | Line 325 | Line 529 | end; | |
529 | ||
530 | function TIBXSQLVAR.GetCharSetID: cardinal; | |
531 | begin | |
532 | < | result := 0; |
532 | > | result := 0; {NONE} |
533 | case SQLType of | |
534 | SQL_VARYING, SQL_TEXT: | |
535 | result := FCharSetID; | |
536 | ||
537 | SQL_BLOB: | |
538 | if (SQLSubType = 1) then | |
539 | < | result := FCharSetID; |
539 | > | result := FCharSetID |
540 | > | else |
541 | > | result := 1; {OCTETS} |
542 | ||
543 | SQL_ARRAY: | |
544 | if (FRelationName <> '') and (FFieldName <> '') then | |
# | Line 345 | Line 551 | end; | |
551 | function TIBXSQLVAR.GetCodePage: TSystemCodePage; | |
552 | begin | |
553 | result := CP_NONE; | |
554 | < | with Firebird30ClientAPI do |
554 | > | with Statement.GetAttachment do |
555 | CharSetID2CodePage(GetCharSetID,result); | |
556 | end; | |
557 | ||
558 | + | function TIBXSQLVAR.GetCharSetWidth: integer; |
559 | + | begin |
560 | + | result := 1; |
561 | + | with Statement.GetAttachment DO |
562 | + | CharSetWidth(GetCharSetID,result); |
563 | + | end; |
564 | + | |
565 | function TIBXSQLVAR.GetIsNull: Boolean; | |
566 | begin | |
567 | Result := IsNullable and (FSQLNullIndicator^ = -1); | |
# | Line 359 | Line 572 | begin | |
572 | Result := FSQLNullIndicator <> nil; | |
573 | end; | |
574 | ||
575 | < | function TIBXSQLVAR.GetSQLData: PChar; |
575 | > | function TIBXSQLVAR.GetSQLData: PByte; |
576 | begin | |
577 | Result := FSQLData; | |
578 | end; | |
# | Line 369 | Line 582 | begin | |
582 | Result := FDataLength; | |
583 | end; | |
584 | ||
585 | + | function TIBXSQLVAR.GetSize: cardinal; |
586 | + | begin |
587 | + | Result := FMetadataSize; |
588 | + | end; |
589 | + | |
590 | + | function TIBXSQLVAR.GetAttachment: IAttachment; |
591 | + | begin |
592 | + | Result := FStatement.GetAttachment; |
593 | + | end; |
594 | + | |
595 | function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData; | |
596 | begin | |
597 | if GetSQLType <> SQL_ARRAY then | |
# | Line 418 | Line 641 | begin | |
641 | end | |
642 | else | |
643 | FSQLNullIndicator := nil; | |
644 | + | Changed; |
645 | end; | |
646 | ||
647 | < | procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal); |
647 | > | procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal); |
648 | begin | |
649 | if FOwnsSQLData then | |
650 | FreeMem(FSQLData); | |
651 | FSQLData := AValue; | |
652 | FDataLength := len; | |
653 | FOwnsSQLData := false; | |
654 | + | Changed; |
655 | end; | |
656 | ||
657 | procedure TIBXSQLVAR.SetScale(aValue: integer); | |
658 | begin | |
659 | FScale := aValue; | |
660 | + | Changed; |
661 | end; | |
662 | ||
663 | procedure TIBXSQLVAR.SetDataLength(len: cardinal); | |
# | Line 439 | Line 665 | begin | |
665 | if not FOwnsSQLData then | |
666 | FSQLData := nil; | |
667 | FDataLength := len; | |
668 | < | with Firebird30ClientAPI do |
668 | > | with FFirebird30ClientAPI do |
669 | IBAlloc(FSQLData, 0, FDataLength); | |
670 | FOwnsSQLData := true; | |
671 | + | Changed; |
672 | end; | |
673 | ||
674 | procedure TIBXSQLVAR.SetSQLType(aValue: cardinal); | |
675 | begin | |
676 | + | if (FSQLType <> aValue) and not CanChangeSQLType then |
677 | + | IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]); |
678 | FSQLType := aValue; | |
679 | + | Changed; |
680 | end; | |
681 | ||
682 | procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal); | |
683 | begin | |
684 | FCharSetID := aValue; | |
685 | + | Changed; |
686 | + | end; |
687 | + | |
688 | + | procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal); |
689 | + | begin |
690 | + | if (aValue > FMetaDataSize) and not CanChangeSQLType then |
691 | + | IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]); |
692 | + | FMetaDataSize := aValue; |
693 | + | end; |
694 | + | |
695 | + | function TIBXSQLVAR.GetDefaultTextSQLType: cardinal; |
696 | + | begin |
697 | + | Result := SQL_VARYING; |
698 | end; | |
699 | ||
700 | constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer); | |
701 | begin | |
702 | inherited Create(aParent,aIndex); | |
703 | FStatement := aParent.Statement; | |
704 | + | FFirebird30ClientAPI := aParent.FFirebird30ClientAPI; |
705 | end; | |
706 | ||
707 | procedure TIBXSQLVAR.RowChange; | |
# | Line 543 | Line 787 | begin | |
787 | FResults.Column[i].RowChange; | |
788 | end; | |
789 | ||
790 | < | function TResultSet.GetCursorName: string; |
790 | > | function TResultSet.GetCursorName: AnsiString; |
791 | begin | |
792 | IBError(ibxeNotSupported,[nil]); | |
793 | Result := ''; | |
# | Line 582 | Line 826 | end; | |
826 | ||
827 | procedure TIBXINPUTSQLDA.FreeMessageBuffer; | |
828 | begin | |
585 | – | if FCurMetaData <> nil then |
586 | – | begin |
587 | – | FCurMetaData.release; |
588 | – | FCurMetaData := nil; |
589 | – | end; |
829 | if FMessageBuffer <> nil then | |
830 | begin | |
831 | FreeMem(FMessageBuffer); | |
# | Line 595 | Line 834 | begin | |
834 | FMsgLength := 0; | |
835 | end; | |
836 | ||
837 | < | function TIBXINPUTSQLDA.GetMessageBuffer: PChar; |
837 | > | procedure TIBXINPUTSQLDA.FreeCurMetaData; |
838 | > | begin |
839 | > | if FCurMetaData <> nil then |
840 | > | begin |
841 | > | FCurMetaData.release; |
842 | > | FCurMetaData := nil; |
843 | > | end; |
844 | > | end; |
845 | > | |
846 | > | function TIBXINPUTSQLDA.GetMessageBuffer: PByte; |
847 | begin | |
848 | PackBuffer; | |
849 | Result := FMessageBuffer; | |
# | Line 603 | Line 851 | end; | |
851 | ||
852 | function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata; | |
853 | begin | |
854 | < | PackBuffer; |
854 | > | BuildMetadata; |
855 | Result := FCurMetaData; | |
856 | end; | |
857 | ||
# | Line 613 | Line 861 | begin | |
861 | Result := FMsgLength; | |
862 | end; | |
863 | ||
864 | < | procedure TIBXINPUTSQLDA.PackBuffer; |
864 | > | procedure TIBXINPUTSQLDA.BuildMetadata; |
865 | var Builder: Firebird.IMetadataBuilder; | |
866 | i: integer; | |
867 | begin | |
868 | < | if FMsgLength > 0 then Exit; |
869 | < | |
622 | < | with Firebird30ClientAPI do |
868 | > | if (FCurMetaData = nil) and (Count > 0) then |
869 | > | with FFirebird30ClientAPI do |
870 | begin | |
871 | < | Builder := inherited MetaData.getBuilder(StatusIntf); |
871 | > | Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count); |
872 | Check4DataBaseError; | |
873 | try | |
874 | for i := 0 to Count - 1 do | |
875 | with TIBXSQLVar(Column[i]) do | |
876 | begin | |
877 | < | Builder.setType(StatusIntf,i,FSQLType); |
877 | > | Builder.setType(StatusIntf,i,FSQLType+1); |
878 | Check4DataBaseError; | |
879 | Builder.setSubType(StatusIntf,i,FSQLSubType); | |
880 | Check4DataBaseError; | |
881 | < | Builder.setLength(StatusIntf,i,FDataLength); |
881 | > | // writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength); |
882 | > | if FSQLType = SQL_VARYING then |
883 | > | begin |
884 | > | {The datalength can be greater than the metadata size when SQLType has been overridden to text} |
885 | > | if (GetDataLength > GetSize) and CanChangeMetaData then |
886 | > | Builder.setLength(StatusIntf,i,GetDataLength) |
887 | > | else |
888 | > | Builder.setLength(StatusIntf,i,GetSize) |
889 | > | end |
890 | > | else |
891 | > | Builder.setLength(StatusIntf,i,GetDataLength); |
892 | Check4DataBaseError; | |
893 | Builder.setCharSet(StatusIntf,i,GetCharSetID); | |
894 | Check4DataBaseError; | |
# | Line 643 | Line 900 | begin | |
900 | finally | |
901 | Builder.release; | |
902 | end; | |
903 | + | end; |
904 | + | end; |
905 | + | |
906 | + | procedure TIBXINPUTSQLDA.PackBuffer; |
907 | + | var i: integer; |
908 | + | P: PByte; |
909 | + | begin |
910 | + | BuildMetadata; |
911 | ||
912 | + | if (FMsgLength = 0) and (FCurMetaData <> nil) then |
913 | + | with FFirebird30ClientAPI do |
914 | + | begin |
915 | FMsgLength := FCurMetaData.getMessageLength(StatusIntf); | |
916 | Check4DataBaseError; | |
917 | ||
# | Line 652 | Line 920 | begin | |
920 | for i := 0 to Count - 1 do | |
921 | with TIBXSQLVar(Column[i]) do | |
922 | begin | |
923 | + | P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i); |
924 | + | // writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength); |
925 | + | if not Modified then |
926 | + | IBError(ibxeUninitializedInputParameter,[i,Name]); |
927 | if IsNull then | |
928 | < | FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0) |
928 | > | FillChar(P^,FDataLength,0) |
929 | else | |
930 | < | Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength); |
931 | < | Check4DataBaseError; |
930 | > | if FSQLData <> nil then |
931 | > | begin |
932 | > | if SQLType = SQL_VARYING then |
933 | > | begin |
934 | > | EncodeInteger(FDataLength,2,P); |
935 | > | Inc(P,2); |
936 | > | end |
937 | > | else |
938 | > | if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then |
939 | > | begin |
940 | > | FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData)); |
941 | > | Check4DatabaseError; |
942 | > | end; |
943 | > | Move(FSQLData^,P^,FDataLength); |
944 | > | end; |
945 | if IsNullable then | |
946 | begin | |
947 | Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator)); | |
# | Line 669 | Line 954 | end; | |
954 | procedure TIBXINPUTSQLDA.FreeXSQLDA; | |
955 | begin | |
956 | inherited FreeXSQLDA; | |
957 | + | FreeCurMetaData; |
958 | FreeMessageBuffer; | |
959 | end; | |
960 | ||
# | Line 680 | Line 966 | end; | |
966 | ||
967 | destructor TIBXINPUTSQLDA.Destroy; | |
968 | begin | |
969 | < | FreeMessageBuffer; |
969 | > | FreeXSQLDA; |
970 | inherited Destroy; | |
971 | end; | |
972 | ||
# | Line 688 | Line 974 | procedure TIBXINPUTSQLDA.Bind(aMetaData: | |
974 | var i: integer; | |
975 | begin | |
976 | FMetaData := aMetaData; | |
977 | < | with Firebird30ClientAPI do |
977 | > | with FFirebird30ClientAPI do |
978 | begin | |
979 | < | Count := metadata.getCount(StatusIntf); |
979 | > | Count := aMetadata.getCount(StatusIntf); |
980 | Check4DataBaseError; | |
981 | Initialize; | |
982 | ||
# | Line 708 | Line 994 | begin | |
994 | FSQLSubType := 0; | |
995 | FDataLength := aMetaData.getLength(StatusIntf,i); | |
996 | Check4DataBaseError; | |
997 | < | 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; |
997 | > | FMetadataSize := FDataLength; |
998 | FNullable := aMetaData.isNullable(StatusIntf,i); | |
729 | – | FOwnsSQLData := true; |
999 | Check4DataBaseError; | |
731 | – | FNullIndicator := -1; |
1000 | if FNullable then | |
1001 | FSQLNullIndicator := @FNullIndicator | |
1002 | else | |
1003 | FSQLNullIndicator := nil; | |
1004 | FScale := aMetaData.getScale(StatusIntf,i); | |
1005 | Check4DataBaseError; | |
1006 | < | FCharSetID := aMetaData.getCharSet(StatusIntf,i); |
1006 | > | FCharSetID := aMetaData.getCharSet(StatusIntf,i) and $FF; |
1007 | Check4DataBaseError; | |
1008 | + | ColumnSQLDataInit; |
1009 | end; | |
1010 | end; | |
1011 | end; | |
# | Line 744 | Line 1013 | end; | |
1013 | procedure TIBXINPUTSQLDA.Changed; | |
1014 | begin | |
1015 | inherited Changed; | |
1016 | + | FreeCurMetaData; |
1017 | FreeMessageBuffer; | |
1018 | end; | |
1019 | ||
1020 | + | procedure TIBXINPUTSQLDA.ReInitialise; |
1021 | + | var i: integer; |
1022 | + | begin |
1023 | + | FreeMessageBuffer; |
1024 | + | for i := 0 to Count - 1 do |
1025 | + | TIBXSQLVar(Column[i]).ColumnSQLDataInit; |
1026 | + | end; |
1027 | + | |
1028 | function TIBXINPUTSQLDA.IsInputDataArea: boolean; | |
1029 | begin | |
1030 | Result := true; | |
# | Line 766 | Line 1044 | procedure TIBXOUTPUTSQLDA.Bind(aMetaData | |
1044 | var i: integer; | |
1045 | begin | |
1046 | FMetaData := aMetaData; | |
1047 | < | with Firebird30ClientAPI do |
1047 | > | with FFirebird30ClientAPI do |
1048 | begin | |
1049 | Count := metadata.getCount(StatusIntf); | |
1050 | Check4DataBaseError; | |
# | Line 794 | Line 1072 | begin | |
1072 | Check4DataBaseError; | |
1073 | FDataLength := aMetaData.getLength(StatusIntf,i); | |
1074 | Check4DataBaseError; | |
1075 | + | FMetadataSize := FDataLength; |
1076 | FRelationName := strpas(aMetaData.getRelation(StatusIntf,i)); | |
1077 | Check4DataBaseError; | |
1078 | FFieldName := strpas(aMetaData.getField(StatusIntf,i)); | |
# | Line 809 | Line 1088 | begin | |
1088 | FSQLNullIndicator := nil; | |
1089 | FScale := aMetaData.getScale(StatusIntf,i); | |
1090 | Check4DataBaseError; | |
1091 | < | FCharSetID := aMetaData.getCharSet(StatusIntf,i); |
1091 | > | FCharSetID := aMetaData.getCharSet(StatusIntf,i) and $FF; |
1092 | Check4DataBaseError; | |
1093 | end; | |
1094 | end; | |
# | Line 817 | Line 1096 | begin | |
1096 | end; | |
1097 | ||
1098 | procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull: boolean; | |
1099 | < | var len: short; var data: PChar); |
1099 | > | var len: short; var data: PByte); |
1100 | begin | |
1101 | with TIBXSQLVAR(Column[index]) do | |
1102 | begin | |
# | Line 826 | Line 1105 | begin | |
1105 | len := FDataLength; | |
1106 | if not IsNull and (FSQLType = SQL_VARYING) then | |
1107 | begin | |
1108 | < | with Firebird30ClientAPI do |
1108 | > | with FFirebird30ClientAPI do |
1109 | len := DecodeInteger(data,2); | |
1110 | Inc(Data,2); | |
1111 | end; | |
# | Line 843 | Line 1122 | constructor TIBXSQLDA.Create(aStatement: | |
1122 | begin | |
1123 | inherited Create; | |
1124 | FStatement := aStatement; | |
1125 | + | FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI; |
1126 | FSize := 0; | |
1127 | // writeln('Creating ',ClassName); | |
1128 | end; | |
# | Line 903 | Line 1183 | begin | |
1183 | ChangeSeqNo := FStatement.ChangeSeqNo; | |
1184 | end; | |
1185 | ||
1186 | + | function TIBXSQLDA.CanChangeMetaData: boolean; |
1187 | + | begin |
1188 | + | Result := FStatement.FBatch = nil; |
1189 | + | end; |
1190 | + | |
1191 | procedure TIBXSQLDA.SetCount(Value: Integer); | |
1192 | var | |
1193 | i: Integer; | |
# | Line 934 | Line 1219 | begin | |
1219 | TIBXSQLVAR(Column[i]).FreeSQLData; | |
1220 | for i := 0 to FSize - 1 do | |
1221 | TIBXSQLVAR(Column[i]).Free; | |
1222 | + | FCount := 0; |
1223 | SetLength(FColumnList,0); | |
1224 | FSize := 0; | |
1225 | end; | |
# | Line 950 | Line 1236 | end; | |
1236 | ||
1237 | { TFB30Statement } | |
1238 | ||
1239 | + | procedure TFB30Statement.CheckChangeBatchRowLimit; |
1240 | + | begin |
1241 | + | if IsInBatchMode then |
1242 | + | IBError(ibxeInBatchMode,[nil]); |
1243 | + | end; |
1244 | + | |
1245 | procedure TFB30Statement.CheckHandle; | |
1246 | begin | |
1247 | if FStatementIntf = nil then | |
1248 | IBError(ibxeInvalidStatementHandle,[nil]); | |
1249 | end; | |
1250 | ||
1251 | + | procedure TFB30Statement.CheckBatchModeAvailable; |
1252 | + | begin |
1253 | + | if not HasBatchMode then |
1254 | + | IBError(ibxeBatchModeNotSupported,[nil]); |
1255 | + | case SQLStatementType of |
1256 | + | SQLInsert, |
1257 | + | SQLUpdate: {OK}; |
1258 | + | else |
1259 | + | IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]); |
1260 | + | end; |
1261 | + | end; |
1262 | + | |
1263 | procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults | |
1264 | ); | |
1265 | begin | |
1266 | < | with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do |
1266 | > | with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do |
1267 | begin | |
1268 | StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request), | |
1269 | GetBufSize, BytePtr(Buffer)); | |
# | Line 975 | Line 1279 | begin | |
1279 | IBError(ibxeEmptyQuery, [nil]); | |
1280 | try | |
1281 | CheckTransaction(FTransactionIntf); | |
1282 | < | with Firebird30ClientAPI do |
1282 | > | with FFirebird30ClientAPI do |
1283 | begin | |
1284 | if FHasParamNames then | |
1285 | begin | |
1286 | if FProcessedSQL = '' then | |
1287 | < | FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL); |
1287 | > | ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL); |
1288 | FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf, | |
1289 | (FTransactionIntf as TFB30Transaction).TransactionIntf, | |
1290 | Length(FProcessedSQL), | |
1291 | < | PChar(FProcessedSQL), |
1291 | > | PAnsiChar(FProcessedSQL), |
1292 | FSQLDialect, | |
1293 | Firebird.IStatement.PREPARE_PREFETCH_METADATA); | |
1294 | end | |
# | Line 992 | Line 1296 | begin | |
1296 | FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf, | |
1297 | (FTransactionIntf as TFB30Transaction).TransactionIntf, | |
1298 | Length(FSQL), | |
1299 | < | PChar(FSQL), |
1299 | > | PAnsiChar(FSQL), |
1300 | FSQLDialect, | |
1301 | Firebird.IStatement.PREPARE_PREFETCH_METADATA); | |
1302 | Check4DataBaseError; | |
# | Line 1031 | Line 1335 | begin | |
1335 | if (FStatementIntf <> nil) then | |
1336 | FreeHandle; | |
1337 | if E is EIBInterBaseError then | |
1338 | < | raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode, |
1339 | < | EIBInterBaseError(E).IBErrorCode, |
1036 | < | EIBInterBaseError(E).Message + |
1037 | < | sSQLErrorSeparator + FSQL) |
1038 | < | else |
1039 | < | raise; |
1338 | > | E.Message := E.Message + sSQLErrorSeparator + FSQL; |
1339 | > | raise; |
1340 | end; | |
1341 | end; | |
1342 | FPrepared := true; | |
# | Line 1057 | Line 1357 | begin | |
1357 | end; | |
1358 | ||
1359 | function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults; | |
1360 | + | |
1361 | + | procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil); |
1362 | + | begin |
1363 | + | with FFirebird30ClientAPI do |
1364 | + | begin |
1365 | + | SavePerfStats(FBeforeStats); |
1366 | + | FStatementIntf.execute(StatusIntf, |
1367 | + | (aTransaction as TFB30Transaction).TransactionIntf, |
1368 | + | FSQLParams.MetaData, |
1369 | + | FSQLParams.MessageBuffer, |
1370 | + | outMetaData, |
1371 | + | outBuffer); |
1372 | + | Check4DataBaseError; |
1373 | + | FStatisticsAvailable := SavePerfStats(FAfterStats); |
1374 | + | end; |
1375 | + | end; |
1376 | + | |
1377 | + | |
1378 | begin | |
1379 | Result := nil; | |
1380 | + | FBatchCompletion := nil; |
1381 | FBOF := false; | |
1382 | FEOF := false; | |
1383 | FSingleResults := false; | |
1384 | + | FStatisticsAvailable := false; |
1385 | + | if IsInBatchMode then |
1386 | + | IBerror(ibxeInBatchMode,[]); |
1387 | CheckTransaction(aTransaction); | |
1388 | if not FPrepared then | |
1389 | InternalPrepare; | |
# | Line 1071 | Line 1393 | begin | |
1393 | if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then | |
1394 | IBError(ibxeInterfaceOutofDate,[nil]); | |
1395 | ||
1396 | + | |
1397 | try | |
1398 | < | with Firebird30ClientAPI do |
1398 | > | with FFirebird30ClientAPI do |
1399 | 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 | – | |
1400 | case FSQLStatementType of | |
1401 | SQLSelect: | |
1402 | IBError(ibxeIsAExecuteProcedure,[]); | |
1403 | ||
1404 | SQLExecProcedure: | |
1405 | begin | |
1406 | < | FStatementIntf.execute(StatusIntf, |
1092 | < | (aTransaction as TFB30Transaction).TransactionIntf, |
1093 | < | FSQLParams.MetaData, |
1094 | < | FSQLParams.MessageBuffer, |
1095 | < | FSQLRecord.MetaData, |
1096 | < | FSQLRecord.MessageBuffer); |
1097 | < | Check4DataBaseError; |
1098 | < | |
1406 | > | ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer); |
1407 | Result := TResults.Create(FSQLRecord); | |
1408 | 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; |
1409 | end; | |
1410 | < | if FCollectStatistics then |
1411 | < | begin |
1412 | < | UtilIntf.getPerfCounters(StatusIntf, |
1114 | < | (GetAttachment as TFB30Attachment).AttachmentIntf, |
1115 | < | ISQL_COUNTERS, @FAfterStats); |
1116 | < | Check4DataBaseError; |
1117 | < | FStatisticsAvailable := true; |
1410 | > | |
1411 | > | else |
1412 | > | ExecuteQuery; |
1413 | end; | |
1414 | end; | |
1415 | finally | |
# | Line 1122 | Line 1417 | begin | |
1417 | RemoveMonitor(aTransaction as TFB30Transaction); | |
1418 | end; | |
1419 | FExecTransactionIntf := aTransaction; | |
1420 | + | FSQLRecord.FTransaction := (aTransaction as TFB30Transaction); |
1421 | + | FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo; |
1422 | SignalActivity; | |
1423 | Inc(FChangeSeqNo); | |
1424 | end; | |
# | Line 1132 | Line 1429 | begin | |
1429 | if FSQLStatementType <> SQLSelect then | |
1430 | IBError(ibxeIsASelectStatement,[]); | |
1431 | ||
1432 | < | CheckTransaction(aTransaction); |
1432 | > | FBatchCompletion := nil; |
1433 | > | CheckTransaction(aTransaction); |
1434 | if not FPrepared then | |
1435 | InternalPrepare; | |
1436 | CheckHandle; | |
# | Line 1141 | Line 1439 | begin | |
1439 | if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then | |
1440 | IBError(ibxeInterfaceOutofDate,[nil]); | |
1441 | ||
1442 | < | with Firebird30ClientAPI do |
1442 | > | with FFirebird30ClientAPI do |
1443 | begin | |
1444 | if FCollectStatistics then | |
1445 | begin | |
# | Line 1181 | Line 1479 | begin | |
1479 | Inc(FChangeSeqNo); | |
1480 | end; | |
1481 | ||
1482 | + | procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; |
1483 | + | var processedSQL: AnsiString); |
1484 | + | begin |
1485 | + | FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL); |
1486 | + | end; |
1487 | + | |
1488 | procedure TFB30Statement.FreeHandle; | |
1489 | begin | |
1490 | Close; | |
1491 | ReleaseInterfaces; | |
1492 | + | if FBatch <> nil then |
1493 | + | begin |
1494 | + | FBatch.release; |
1495 | + | FBatch := nil; |
1496 | + | end; |
1497 | if FStatementIntf <> nil then | |
1498 | begin | |
1499 | FStatementIntf.release; | |
# | Line 1197 | Line 1506 | procedure TFB30Statement.InternalClose(F | |
1506 | begin | |
1507 | if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then | |
1508 | try | |
1509 | < | with Firebird30ClientAPI do |
1509 | > | with FFirebird30ClientAPI do |
1510 | begin | |
1511 | if FResultSet <> nil then | |
1512 | begin | |
# | Line 1211 | Line 1520 | begin | |
1520 | if not Force then Check4DataBaseError; | |
1521 | end; | |
1522 | finally | |
1523 | < | if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then |
1523 | > | if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB30Transaction)) then |
1524 | RemoveMonitor(FSQLRecord.FTransaction); | |
1525 | FOpen := False; | |
1526 | FExecTransactionIntf := nil; | |
# | Line 1221 | Line 1530 | begin | |
1530 | Inc(FChangeSeqNo); | |
1531 | end; | |
1532 | ||
1533 | + | function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean; |
1534 | + | begin |
1535 | + | Result := false; |
1536 | + | if FCollectStatistics then |
1537 | + | with FFirebird30ClientAPI do |
1538 | + | begin |
1539 | + | UtilIntf.getPerfCounters(StatusIntf, |
1540 | + | (GetAttachment as TFB30Attachment).AttachmentIntf, |
1541 | + | ISQL_COUNTERS, @Stats); |
1542 | + | Check4DataBaseError; |
1543 | + | Result := true; |
1544 | + | end; |
1545 | + | end; |
1546 | + | |
1547 | constructor TFB30Statement.Create(Attachment: TFB30Attachment; | |
1548 | < | Transaction: ITransaction; sql: string; aSQLDialect: integer); |
1548 | > | Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); |
1549 | begin | |
1550 | inherited Create(Attachment,Transaction,sql,aSQLDialect); | |
1551 | + | FFirebird30ClientAPI := Attachment.Firebird30ClientAPI; |
1552 | FSQLParams := TIBXINPUTSQLDA.Create(self); | |
1553 | FSQLRecord := TIBXOUTPUTSQLDA.Create(self); | |
1554 | InternalPrepare; | |
1555 | end; | |
1556 | ||
1557 | constructor TFB30Statement.CreateWithParameterNames( | |
1558 | < | Attachment: TFB30Attachment; Transaction: ITransaction; sql: string; |
1559 | < | aSQLDialect: integer; GenerateParamNames: boolean); |
1558 | > | Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString; |
1559 | > | aSQLDialect: integer; GenerateParamNames: boolean; |
1560 | > | CaseSensitiveParams: boolean); |
1561 | begin | |
1562 | inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames); | |
1563 | + | FFirebird30ClientAPI := Attachment.Firebird30ClientAPI; |
1564 | FSQLParams := TIBXINPUTSQLDA.Create(self); | |
1565 | + | FSQLParams.CaseSensitiveParams := CaseSensitiveParams; |
1566 | FSQLRecord := TIBXOUTPUTSQLDA.Create(self); | |
1567 | InternalPrepare; | |
1568 | end; | |
# | Line 1256 | Line 1583 | begin | |
1583 | if FEOF then | |
1584 | IBError(ibxeEOF,[nil]); | |
1585 | ||
1586 | < | with Firebird30ClientAPI do |
1586 | > | with FFirebird30ClientAPI do |
1587 | begin | |
1588 | { Go to the next record... } | |
1589 | fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer); | |
# | Line 1281 | Line 1608 | begin | |
1608 | FBOF := false; | |
1609 | result := true; | |
1610 | end; | |
1611 | + | if FCollectStatistics then |
1612 | + | begin |
1613 | + | UtilIntf.getPerfCounters(StatusIntf, |
1614 | + | (GetAttachment as TFB30Attachment).AttachmentIntf, |
1615 | + | ISQL_COUNTERS,@FAfterStats); |
1616 | + | Check4DataBaseError; |
1617 | + | FStatisticsAvailable := true; |
1618 | + | end; |
1619 | end; | |
1620 | FSQLRecord.RowChange; | |
1621 | SignalActivity; | |
# | Line 1304 | Line 1639 | begin | |
1639 | Result := TMetaData(GetInterface(1)); | |
1640 | end; | |
1641 | ||
1642 | < | function TFB30Statement.GetPlan: String; |
1642 | > | function TFB30Statement.GetPlan: AnsiString; |
1643 | begin | |
1644 | CheckHandle; | |
1645 | if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate, | |
# | Line 1312 | Line 1647 | begin | |
1647 | SQLUpdate, SQLDelete])) then | |
1648 | result := '' | |
1649 | else | |
1650 | < | with Firebird30ClientAPI do |
1650 | > | with FFirebird30ClientAPI do |
1651 | begin | |
1652 | Result := FStatementIntf.getPlan(StatusIntf,true); | |
1653 | Check4DataBaseError; | |
# | Line 1346 | Line 1681 | begin | |
1681 | TSQLParams(GetInterface(0)).RetainInterfaces := aValue; | |
1682 | end; | |
1683 | ||
1684 | + | function TFB30Statement.IsInBatchMode: boolean; |
1685 | + | begin |
1686 | + | Result := FBatch <> nil; |
1687 | + | end; |
1688 | + | |
1689 | + | function TFB30Statement.HasBatchMode: boolean; |
1690 | + | begin |
1691 | + | Result := GetAttachment.HasBatchMode; |
1692 | + | end; |
1693 | + | |
1694 | + | procedure TFB30Statement.AddToBatch; |
1695 | + | var BatchPB: TXPBParameterBlock; |
1696 | + | |
1697 | + | const SixteenMB = 16 * 1024 * 1024; |
1698 | + | begin |
1699 | + | FBatchCompletion := nil; |
1700 | + | if not FPrepared then |
1701 | + | InternalPrepare; |
1702 | + | CheckHandle; |
1703 | + | CheckBatchModeAvailable; |
1704 | + | with FFirebird30ClientAPI do |
1705 | + | begin |
1706 | + | if FBatch = nil then |
1707 | + | begin |
1708 | + | {Start Batch} |
1709 | + | BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH); |
1710 | + | with FFirebird30ClientAPI do |
1711 | + | try |
1712 | + | FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf); |
1713 | + | Check4DatabaseError; |
1714 | + | if FBatchBufferSize < SixteenMB then |
1715 | + | FBatchBufferSize := SixteenMB; |
1716 | + | if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then |
1717 | + | IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]); |
1718 | + | |
1719 | + | BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1); |
1720 | + | BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize); |
1721 | + | FBatch := FStatementIntf.createBatch(StatusIntf, |
1722 | + | FSQLParams.MetaData, |
1723 | + | BatchPB.getDataLength, |
1724 | + | BatchPB.getBuffer); |
1725 | + | Check4DataBaseError; |
1726 | + | |
1727 | + | finally |
1728 | + | BatchPB.Free; |
1729 | + | end; |
1730 | + | FBatchRowCount := 0; |
1731 | + | FBatchBufferUsed := 0; |
1732 | + | end; |
1733 | + | |
1734 | + | Inc(FBatchRowCount); |
1735 | + | Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf)); |
1736 | + | Check4DataBaseError; |
1737 | + | if FBatchBufferUsed > FBatchBufferSize then |
1738 | + | raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow), |
1739 | + | Format(GetErrorMessage(ibxeBatchRowBufferOverflow), |
1740 | + | [FBatchRowCount,FBatchBufferSize])); |
1741 | + | |
1742 | + | FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer); |
1743 | + | Check4DataBaseError |
1744 | + | end; |
1745 | + | end; |
1746 | + | |
1747 | + | function TFB30Statement.ExecuteBatch(aTransaction: ITransaction |
1748 | + | ): IBatchCompletion; |
1749 | + | |
1750 | + | procedure Check4BatchCompletionError(bc: IBatchCompletion); |
1751 | + | var status: IStatus; |
1752 | + | RowNo: integer; |
1753 | + | begin |
1754 | + | status := nil; |
1755 | + | {Raise an exception if there was an error reported in the BatchCompletion} |
1756 | + | if (bc <> nil) and bc.getErrorStatus(RowNo,status) then |
1757 | + | raise EIBInterbaseError.Create(status); |
1758 | + | end; |
1759 | + | |
1760 | + | var cs: Firebird.IBatchCompletionState; |
1761 | + | |
1762 | + | begin |
1763 | + | Result := nil; |
1764 | + | if FBatch = nil then |
1765 | + | IBError(ibxeNotInBatchMode,[]); |
1766 | + | |
1767 | + | with FFirebird30ClientAPI do |
1768 | + | begin |
1769 | + | SavePerfStats(FBeforeStats); |
1770 | + | if aTransaction = nil then |
1771 | + | cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf) |
1772 | + | else |
1773 | + | cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf); |
1774 | + | Check4DataBaseError; |
1775 | + | FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs); |
1776 | + | FStatisticsAvailable := SavePerfStats(FAfterStats); |
1777 | + | FBatch.release; |
1778 | + | FBatch := nil; |
1779 | + | Check4BatchCompletionError(FBatchCompletion); |
1780 | + | Result := FBatchCompletion; |
1781 | + | end; |
1782 | + | end; |
1783 | + | |
1784 | + | procedure TFB30Statement.CancelBatch; |
1785 | + | begin |
1786 | + | if FBatch = nil then |
1787 | + | IBError(ibxeNotInBatchMode,[]); |
1788 | + | FBatch.release; |
1789 | + | FBatch := nil; |
1790 | + | end; |
1791 | + | |
1792 | + | function TFB30Statement.GetBatchCompletion: IBatchCompletion; |
1793 | + | begin |
1794 | + | Result := FBatchCompletion; |
1795 | + | end; |
1796 | + | |
1797 | function TFB30Statement.IsPrepared: boolean; | |
1798 | begin | |
1799 | Result := FStatementIntf <> nil; |
– | Removed lines |
+ | Added lines |
< | Changed lines |
> | Changed lines |