ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/2.5/FB25Statement.pas
(Generate patch)

Comparing:
ibx/trunk/fbintf/client/2.5/FB25Statement.pas (file contents), Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
ibx/branches/journaling/fbintf/client/2.5/FB25Statement.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC

# Line 121 | Line 121 | type
121    TIBXSQLVAR = class(TSQLVarData)
122    private
123      FStatement: TFB25Statement;
124 +    FFirebird25ClientAPI: TFB25ClientAPI;
125      FBlob: IBlob;             {Cache references}
126      FArray: IArray;
127      FNullIndicator: short;
128      FOwnsSQLData: boolean;
129      FBlobMetaData: IBlobMetaData;
130      FArrayMetaData: IArrayMetaData;
131 +    FMetadataSize: short; {size of field from metadata}
132      FXSQLVAR: PXSQLVAR;       { Points to the PXSQLVAR in the owner object }
133    protected
134      function GetSQLType: cardinal; override;
# Line 138 | Line 140 | type
140      function GetScale: integer; override;
141      function GetCharSetID: cardinal; override;
142      function GetCodePage: TSystemCodePage; override;
143 +    function GetCharSetWidth: integer; override;
144      function GetIsNull: Boolean;   override;
145      function GetIsNullable: boolean; override;
146      function GetSQLData: PByte;  override;
147      function GetDataLength: cardinal; override;
148 +    function GetSize: cardinal; override;
149 +    function GetAttachment: IAttachment; override;
150 +    function GetDefaultTextSQLType: cardinal; override;
151      procedure SetIsNull(Value: Boolean); override;
152      procedure SetIsNullable(Value: Boolean);  override;
153      procedure SetSQLData(AValue: PByte; len: cardinal); override;
# Line 161 | Line 167 | type
167      procedure Initialize; override;
168  
169      property Statement: TFB25Statement read FStatement;
170 +    property SQLType: cardinal read GetSQLType write SetSQLType;
171    end;
172  
173    TIBXINPUTSQLDA = class;
# Line 177 | Line 184 | type
184      function GetXSQLDA: PXSQLDA;
185    protected
186      FStatement: TFB25Statement;
187 +    FFirebird25ClientAPI: TFB25ClientAPI;
188      function GetTransactionSeqNo: integer; override;
189      procedure FreeXSQLDA;
190      function GetStatement: IStatement; override;
# Line 228 | Line 236 | type
236      constructor Create(aResults: TIBXOUTPUTSQLDA);
237      destructor Destroy; override;
238      {IResultSet}
239 <    function FetchNext: boolean;
239 >    function FetchNext: boolean; {fetch next record}
240 >    function FetchPrior: boolean; {fetch previous record}
241 >    function FetchFirst:boolean; {fetch first record}
242 >    function FetchLast: boolean; {fetch last record}
243 >    function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
244 >    function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
245      function GetCursorName: AnsiString;
246      function GetTransaction: ITransaction; override;
247      function IsEof: boolean;
248 +    function IsBof: boolean;
249      procedure Close;
250    end;
251  
# Line 241 | Line 255 | type
255    private
256      FDBHandle: TISC_DB_HANDLE;
257      FHandle: TISC_STMT_HANDLE;
258 +    FFirebird25ClientAPI: TFB25ClientAPI;
259      FSQLParams: TIBXINPUTSQLDA;
260      FSQLRecord: TIBXOUTPUTSQLDA;
261      FCursor: AnsiString;               { Cursor name...}
# Line 249 | Line 264 | type
264    protected
265      procedure CheckHandle; override;
266      procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); override;
267 <    procedure InternalPrepare; override;
267 >    procedure InternalPrepare(CursorName: AnsiString=''); override;
268      function InternalExecute(aTransaction: ITransaction): IResults; override;
269 <    function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
269 >    function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean): IResultSet; override;
270 >    procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
271      procedure FreeHandle; override;
272      procedure InternalClose(Force: boolean); override;
273    public
274      constructor Create(Attachment: TFB25Attachment; Transaction: ITransaction;
275 <      sql: AnsiString; aSQLDialect: integer);
275 >      sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString='');
276      constructor CreateWithParameterNames(Attachment: TFB25Attachment;
277 <      Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean);
277 >      Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
278 >      CaseSensitiveParams: boolean=false; CursorName: AnsiString='');
279      destructor Destroy; override;
280      function FetchNext: boolean;
281  
# Line 350 | Line 367 | begin
367       CharSetID2CodePage(GetCharSetID,result);
368   end;
369  
370 + function TIBXSQLVAR.GetCharSetWidth: integer;
371 + begin
372 +  result := 1;
373 +  with Statement.GetAttachment DO
374 +    CharSetWidth(GetCharSetID,result);
375 + end;
376 +
377   function TIBXSQLVAR.GetIsNull: Boolean;
378   begin
379    result := IsNullable and (FNullIndicator = -1);
# Line 370 | Line 394 | begin
394    Result := FXSQLVAR^.sqllen;
395   end;
396  
397 + function TIBXSQLVAR.GetSize: cardinal;
398 + begin
399 +  Result := FMetadataSize;
400 + end;
401 +
402 + function TIBXSQLVAR.GetAttachment: IAttachment;
403 + begin
404 +  Result := FStatement.GetAttachment;
405 + end;
406 +
407   function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
408   begin
409    if GetSQLType <> SQL_ARRAY then
# Line 441 | Line 475 | procedure TIBXSQLVAR.Initialize;
475   begin
476    inherited Initialize;
477    FOwnsSQLData := true;
478 <  with FirebirdClientAPI, FXSQLVar^ do
478 >  with FFirebird25ClientAPI, FXSQLVar^ do
479    begin
480 +    FMetadataSize := sqllen;
481      case sqltype and (not 1) of
482        SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
483        SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
# Line 468 | Line 503 | begin
503      else
504        sqlInd :=  nil;
505    end;
506 +  SaveMetaData;
507   end;
508  
509   procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
# Line 502 | Line 538 | begin
538        FXSQLVAR^.sqlind := nil;
539      end;
540    end;
541 +  Changed;
542   end;
543  
544   procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
# Line 511 | Line 548 | begin
548    FXSQLVAR^.sqldata := AValue;
549    FXSQLVAR^.sqllen := len;
550    FOwnsSQLData := false;
551 +  Changed;
552   end;
553  
554   procedure TIBXSQLVAR.SetScale(aValue: integer);
555   begin
556    FXSQLVAR^.sqlscale := aValue;
557 +  Changed;
558   end;
559  
560   procedure TIBXSQLVAR.SetDataLength(len: cardinal);
# Line 523 | Line 562 | begin
562    if not FOwnsSQLData then
563      FXSQLVAR^.sqldata := nil;
564    FXSQLVAR^.sqllen := len;
565 <  with FirebirdClientAPI do
565 >  with FFirebird25ClientAPI do
566      IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
567    FOwnsSQLData := true;
568 +  Changed;
569   end;
570  
571   procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
572   begin
573    FXSQLVAR^.sqltype := aValue or (FXSQLVAR^.sqltype and 1);
574 +  Changed;
575   end;
576  
577   procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
578   begin
579    if aValue <> GetCharSetID then
580 <  case SQLType of
581 <  SQL_VARYING, SQL_TEXT:
582 <      FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
583 <
584 <  SQL_BLOB,
585 <  SQL_ARRAY:
586 <    IBError(ibxeInvalidDataConversion,[nil]);
580 >  begin
581 >    case SQLType of
582 >    SQL_VARYING, SQL_TEXT:
583 >        FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
584 >
585 >    SQL_BLOB,
586 >    SQL_ARRAY:
587 >      IBError(ibxeInvalidDataConversion,[nil]);
588 >    end;
589 >  Changed;
590    end;
591   end;
592  
593 + function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
594 + begin
595 +  Result := SQL_TEXT;
596 + end;
597 +
598   constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
599   begin
600    inherited Create(aParent,aIndex);
601    FStatement := aParent.Statement;
602 +  FFirebird25ClientAPI := aParent.FFirebird25ClientAPI;
603   end;
604  
605   procedure TIBXSQLVAR.FreeSQLData;
# Line 593 | Line 643 | begin
643        FResults.Column[i].RowChange;
644   end;
645  
646 + function TResultSet.FetchPrior: boolean;
647 + begin
648 +  IBError(ibxeNoScrollableCursors,[]);
649 + end;
650 +
651 + function TResultSet.FetchFirst: boolean;
652 + begin
653 +  IBError(ibxeNoScrollableCursors,[]);
654 + end;
655 +
656 + function TResultSet.FetchLast: boolean;
657 + begin
658 +  IBError(ibxeNoScrollableCursors,[]);
659 + end;
660 +
661 + function TResultSet.FetchAbsolute(position: Integer): boolean;
662 + begin
663 +  IBError(ibxeNoScrollableCursors,[]);
664 + end;
665 +
666 + function TResultSet.FetchRelative(offset: Integer): boolean;
667 + begin
668 +  IBError(ibxeNoScrollableCursors,[]);
669 + end;
670 +
671   function TResultSet.GetCursorName: AnsiString;
672   begin
673    Result := FResults.FStatement.FCursor;
# Line 608 | Line 683 | begin
683    Result := FResults.FStatement.FEof;
684   end;
685  
686 + function TResultSet.IsBof: boolean;
687 + begin
688 +  Result := FResults.FStatement.FBof;
689 + end;
690 +
691   procedure TResultSet.Close;
692   begin
693    if FCursorSeqNo = FResults.FStatement.FCursorSeqNo then
# Line 620 | Line 700 | procedure TIBXINPUTSQLDA.Bind;
700   begin
701    if Count = 0 then
702      Count := 1;
703 <  with Firebird25ClientAPI do
703 >  with FFirebird25ClientAPI do
704    begin
705      if (FXSQLDA <> nil) then
706         if isc_dsql_describe_bind(StatusVector, @(FStatement.Handle), FStatement.SQLDialect,
# Line 652 | Line 732 | procedure TIBXOUTPUTSQLDA.Bind;
732   begin
733    { Allocate an initial output descriptor (with one column) }
734    Count := 1;
735 <  with Firebird25ClientAPI do
735 >  with FFirebird25ClientAPI do
736    begin
737      { Using isc_dsql_describe, get the right size for the columns... }
738      if isc_dsql_describe(StatusVector, @(FStatement.Handle), FStatement.SQLDialect, FXSQLDA) > 0 then
# Line 687 | Line 767 | begin
767      len := sqllen;
768      if not IsNull and ((sqltype and (not 1)) = SQL_VARYING) then
769      begin
770 <      with FirebirdClientAPI do
770 >      with FFirebird25ClientAPI do
771          len := DecodeInteger(data,2);
772        Inc(data,2);
773      end;
# Line 704 | Line 784 | constructor TIBXSQLDA.Create(aStatement:
784   begin
785    inherited Create;
786    FStatement := aStatement;
787 +  FFirebird25ClientAPI := aStatement.FFirebird25ClientAPI;
788    FSize := 0;
789   //  writeln('Creating ',ClassName);
790   end;
# Line 790 | Line 871 | begin
871        OldSize := 0;
872      if Count > FSize then
873      begin
874 <      Firebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
874 >      FFirebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
875        SetLength(FColumnList, FCount);
876        FXSQLDA^.version := SQLDA_VERSION1;
877        p := @FXSQLDA^.sqlvar[0];
# Line 888 | Line 969 | end;
969   procedure TFB25Statement.GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults
970    );
971   begin
972 <  with Firebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
972 >  with FFirebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
973    if isc_dsql_sql_info(StatusVector, @(FHandle), 1, @info_request,
974                       GetBufSize, Buffer) > 0 then
975      IBDatabaseError;
976   end;
977  
978 < procedure TFB25Statement.InternalPrepare;
978 > procedure TFB25Statement.InternalPrepare(CursorName: AnsiString);
979   var
980 +  GUID: TGUID;
981    RB: ISQLInfoResults;
982    TRHandle: TISC_TR_HANDLE;
983   begin
984    if FPrepared then
985      Exit;
986 +
987    if (FSQL = '') then
988      IBError(ibxeEmptyQuery, [nil]);
989 +
990 +  FCursor := CursorName;
991 +  if FCursor = '' then
992 +  begin
993 +    CreateGuid(GUID);
994 +    FCursor := GUIDToString(GUID);
995 +  end;
996 +
997    try
998      CheckTransaction(FTransactionIntf);
999 <    with Firebird25ClientAPI do
999 >    with FFirebird25ClientAPI do
1000      begin
1001        Call(isc_dsql_alloc_statement2(StatusVector, @(FDBHandle),
1002                                        @FHandle), True);
# Line 913 | Line 1004 | begin
1004        if FHasParamNames then
1005        begin
1006          if FProcessedSQL = '' then
1007 <          FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1007 >          ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1008          Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
1009                   PAnsiChar(FProcessedSQL), FSQLDialect, nil), True);
1010        end
# Line 921 | Line 1012 | begin
1012          Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
1013                   PAnsiChar(FSQL), FSQLDialect, nil), True);
1014      end;
1015 +
1016      { After preparing the statement, query the stmt type and possibly
1017        create a FSQLRecord "holder" }
1018      { Get the type of the statement }
# Line 930 | Line 1022 | begin
1022      else
1023        FSQLStatementType := SQLUnknown;
1024  
1025 +    if FSQLStatementType = SQLSelect then
1026 +    with FFirebird25ClientAPI do
1027 +      Call(
1028 +        isc_dsql_set_cursor_name(StatusVector, @FHandle, PAnsiChar(FCursor), 0),
1029 +        True);
1030 +
1031      case FSQLStatementType of
1032        SQLGetSegment,
1033        SQLPutSegment,
# Line 957 | Line 1055 | begin
1055        if (FHandle <> nil) then
1056          FreeHandle;
1057        if E is EIBInterBaseError then
1058 <        raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1059 <                                       EIBInterBaseError(E).IBErrorCode,
962 <                                       EIBInterBaseError(E).Message +
963 <                                       sSQLErrorSeparator + FSQL)
964 <      else
965 <        raise;
1058 >        E.Message := E.Message + sSQLErrorSeparator + FSQL;
1059 >      raise;
1060      end;
1061    end;
1062    FPrepared := true;
# Line 994 | Line 1088 | begin
1088    CheckHandle;
1089    if aTransaction <> FTransactionIntf then
1090      AddMonitor(aTransaction as TFB25Transaction);
1091 <  if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1091 >  if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1092      IBError(ibxeInterfaceOutofDate,[nil]);
1093  
1094    try
1095      TRHandle := (aTransaction as TFB25Transaction).Handle;
1096 <    with Firebird25ClientAPI do
1096 >    with FFirebird25ClientAPI do
1097      begin
1098        if FCollectStatistics then
1099          GetPerfCounters(FBeforeStats);
# Line 1038 | Line 1132 | begin
1132         RemoveMonitor(aTransaction as TFB25Transaction);
1133    end;
1134    FExecTransactionIntf := aTransaction;
1135 +  FSQLRecord.FTransaction := aTransaction as TFB25Transaction;
1136 +  FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1137    Inc(FChangeSeqNo);
1138   end;
1139  
1140 < function TFB25Statement.InternalOpenCursor(aTransaction: ITransaction
1141 <  ): IResultSet;
1140 > function TFB25Statement.InternalOpenCursor(aTransaction: ITransaction;
1141 >  Scrollable: boolean): IResultSet;
1142   var TRHandle: TISC_TR_HANDLE;
1047    GUID : TGUID;
1143   begin
1144    if FSQLStatementType <> SQLSelect then
1145     IBError(ibxeIsASelectStatement,[]);
1146  
1147 +  if Scrollable then
1148 +    IBError(ibxeNoScrollableCursors,[]);
1149 +
1150   CheckTransaction(aTransaction);
1151    if not FPrepared then
1152      InternalPrepare;
1153    CheckHandle;
1154    if aTransaction <> FTransactionIntf then
1155      AddMonitor(aTransaction as TFB25Transaction);
1156 <  if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1156 >  if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1157      IBError(ibxeInterfaceOutofDate,[nil]);
1158  
1159 < with Firebird25ClientAPI do
1159 > with FFirebird25ClientAPI do
1160   begin
1161     if FCollectStatistics then
1162       GetPerfCounters(FBeforeStats);
# Line 1070 | Line 1168 | begin
1168                         SQLDialect,
1169                         FSQLParams.AsXSQLDA,
1170                         nil), True);
1073   if FCursor = '' then
1074   begin
1075     CreateGuid(GUID);
1076     FCursor := GUIDToString(GUID);
1077     Call(
1078       isc_dsql_set_cursor_name(StatusVector, @FHandle, PAnsiChar(FCursor), 0),
1079       True);
1080   end;
1171  
1172     if FCollectStatistics then
1173     begin
# Line 1097 | Line 1187 | begin
1187   Inc(FChangeSeqNo);
1188   end;
1189  
1190 + procedure TFB25Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1191 +  var processedSQL: AnsiString);
1192 + begin
1193 +  FSQLParams.PreprocessSQL(sql,GenerateParamNames, processedSQL);
1194 + end;
1195 +
1196   procedure TFB25Statement.FreeHandle;
1197   var
1198    isc_res: ISC_STATUS;
# Line 1105 | Line 1201 | begin
1201    ReleaseInterfaces;
1202    try
1203      if FHandle <> nil then
1204 <    with Firebird25ClientAPI do
1204 >    with FFirebird25ClientAPI do
1205      begin
1206        isc_res :=
1207          Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop), False);
# Line 1125 | Line 1221 | var
1221   begin
1222    if (FHandle <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1223    try
1224 <    with Firebird25ClientAPI do
1224 >    with FFirebird25ClientAPI do
1225      begin
1226        isc_res := Call(
1227                     isc_dsql_free_statement(StatusVector, @FHandle, DSQL_close),
# Line 1146 | Line 1242 | begin
1242   end;
1243  
1244   constructor TFB25Statement.Create(Attachment: TFB25Attachment;
1245 <  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1245 >  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1246 >  CursorName: AnsiString);
1247   begin
1248    inherited Create(Attachment,Transaction,sql,aSQLDialect);
1249    FDBHandle := Attachment.Handle;
1250 +  FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1251 +  OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1252    FSQLParams := TIBXINPUTSQLDA.Create(self);
1253    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1254 <  InternalPrepare;
1254 >  InternalPrepare(CursorName);
1255   end;
1256  
1257 < constructor TFB25Statement.CreateWithParameterNames(Attachment: TFB25Attachment;
1258 <  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1259 <  GenerateParamNames: boolean);
1257 > constructor TFB25Statement.CreateWithParameterNames(
1258 >  Attachment: TFB25Attachment; Transaction: ITransaction; sql: AnsiString;
1259 >  aSQLDialect: integer; GenerateParamNames: boolean;
1260 >  CaseSensitiveParams: boolean; CursorName: AnsiString);
1261   begin
1262    inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1263    FDBHandle := Attachment.Handle;
1264 +  FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1265 +  OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1266    FSQLParams := TIBXINPUTSQLDA.Create(self);
1267 +  FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1268    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1269 <  InternalPrepare;
1269 >  InternalPrepare(CursorName);
1270   end;
1271  
1272   destructor TFB25Statement.Destroy;
# Line 1183 | Line 1286 | begin
1286    if FEOF then
1287      IBError(ibxeEOF,[nil]);
1288  
1289 <  with Firebird25ClientAPI do
1289 >  with FFirebird25ClientAPI do
1290    begin
1291      { Go to the next record... }
1292      fetch_res :=
# Line 1209 | Line 1312 | begin
1312        FBOF := false;
1313        result := true;
1314      end;
1315 +    if FCollectStatistics then
1316 +    begin
1317 +      GetPerfCounters(FAfterStats);
1318 +      FStatisticsAvailable := true;
1319 +    end;
1320    end;
1321    FSQLRecord.RowChange;
1322    if FEOF then
# Line 1241 | Line 1349 | begin
1349      result := ''
1350    else
1351    begin
1352 <    RB := TSQLInfoResultsBuffer.Create(4*4096);
1352 >    RB := TSQLInfoResultsBuffer.Create(FFirebird25ClientAPI,4*4096);
1353      GetDsqlInfo(isc_info_sql_get_plan,RB);
1354       if RB.Count > 0 then
1355       Result := RB[0].GetAsString;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines