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