ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/3.0/FB30Statement.pas
(Generate patch)

Comparing:
ibx/branches/journaling/fbintf/client/3.0/FB30Statement.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (file contents), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

# Line 98 | 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;
102 <    FMetadataSize: integer;
101 >    FDataLength: cardinal;
102 >    FMetadataSize: cardinal;
103      FNullable: boolean;
104      FScale: integer;
105      FCharSetID: cardinal;
# Line 116 | Line 116 | type
116       function GetRelationName: AnsiString;  override;
117       function GetScale: integer; override;
118       function GetCharSetID: cardinal; override;
119     function GetCodePage: TSystemCodePage; override;
120     function GetCharSetWidth: integer; override;
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;
126     function GetAttachment: IAttachment; 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;
133 <     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       procedure SetMetaSize(aValue: cardinal); override;
132    public
# Line 145 | Line 141 | type
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 158 | Line 155 | type
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      function CanChangeMetaData: boolean; override;
176    property MetaData: Firebird.IMessageMetadata read FMetaData;
178      property Count: Integer read FCount write SetCount;
179      property Statement: TFB30Statement read FStatement;
180    end;
# Line 182 | Line 183 | type
183  
184    TIBXINPUTSQLDA = class(TIBXSQLDA)
185    private
185    FMessageBuffer: PByte; {Message Buffer}
186    FMsgLength: integer; {Message Buffer length}
186      FCurMetaData: Firebird.IMessageMetadata;
188    procedure FreeMessageBuffer;
187      procedure FreeCurMetaData;
188      function GetMessageBuffer: PByte;
191    function GetMetaData: Firebird.IMessageMetadata;
189      function GetModified: Boolean;
190      function GetMsgLength: integer;
191      procedure BuildMetadata;
195    procedure PackBuffer;
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;
205    property MetaData: Firebird.IMessageMetadata read GetMetaData;
204      property MessageBuffer: PByte read GetMessageBuffer;
205      property MsgLength: integer read GetMsgLength;
206    end;
# Line 212 | Line 210 | type
210    TIBXOUTPUTSQLDA = class(TIBXSQLDA)
211    private
212      FTransaction: TFB30Transaction; {transaction used to execute the statement}
215    FMessageBuffer: PByte; {Message Buffer}
216    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 243 | Line 239 | type
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;
246    function GetTransaction: ITransaction; override;
242      function IsBof: boolean;
243      function IsEof: boolean;
244      procedure Close;
# Line 307 | Line 302 | type
302      destructor Destroy; override;
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 431 | Line 428 | begin
428      status := MasterIntf.getStatus;
429      FCompletionState.getStatus(StatusIntf,status,updateNo);
430      Check4DataBaseError;
431 <    Result := FormatFBStatus(status);
431 >    Result := FormatStatus(status);
432    end;
433   end;
434  
# Line 537 | Line 534 | begin
534   end;
535  
536   function TIBXSQLVAR.GetAliasName: AnsiString;
537 + var metadata: Firebird.IMessageMetadata;
538   begin
539 <  with FFirebird30ClientAPI 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 551 | Line 554 | begin
554   end;
555  
556   function TIBXSQLVAR.GetOwnerName: AnsiString;
557 + var metadata: Firebird.IMessageMetadata;
558   begin
559 <  with FFirebird30ClientAPI 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 590 | Line 599 | begin
599    end;
600   end;
601  
593 function TIBXSQLVAR.GetCodePage: TSystemCodePage;
594 begin
595  result := CP_NONE;
596  with Statement.GetAttachment do
597     CharSetID2CodePage(GetCharSetID,result);
598 end;
599
600 function TIBXSQLVAR.GetCharSetWidth: integer;
601 begin
602  result := 1;
603  with Statement.GetAttachment DO
604    CharSetWidth(GetCharSetID,result);
605 end;
606
602   function TIBXSQLVAR.GetIsNull: Boolean;
603   begin
604    Result := IsNullable and (FSQLNullIndicator^ = -1);
# Line 629 | Line 624 | begin
624    Result := FMetadataSize;
625   end;
626  
632 function TIBXSQLVAR.GetAttachment: IAttachment;
633 begin
634  Result := FStatement.GetAttachment;
635 end;
636
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 652 | 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 696 | Line 686 | begin
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;
# Line 713 | Line 703 | begin
703    Changed;
704   end;
705  
706 < procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
706 > procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
707   begin
718  if (FSQLType <> aValue) and not CanChangeSQLType then
719    IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
708    FSQLType := aValue;
709    Changed;
710   end;
# Line 770 | Line 758 | begin
758    else
759    begin
760      if FArrayIntf = nil then
761 <      FArrayIntf := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
762 <                                TIBXSQLDA(Parent).GetTransaction,
761 >      FArrayIntf := TFB30Array.Create(GetAttachment as TFB30Attachment,
762 >                                GetTransaction as TFB30Transaction,
763                                  GetArrayMetaData,PISC_QUAD(SQLData)^);
764      Result := FArrayIntf;
765    end;
# Line 788 | 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 798 | 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  
# Line 878 | Line 866 | begin
866    Result := FResults.FStatement.FCursor;
867   end;
868  
881 function TResultSet.GetTransaction: ITransaction;
882 begin
883  Result := FResults.FTransaction;
884 end;
885
869   function TResultSet.IsBof: boolean;
870   begin
871    Result := FResults.FStatement.FBof;
# Line 914 | Line 897 | begin
897      end;
898   end;
899  
917 procedure TIBXINPUTSQLDA.FreeMessageBuffer;
918 begin
919  if FMessageBuffer <> nil then
920  begin
921    FreeMem(FMessageBuffer);
922    FMessageBuffer := nil;
923  end;
924  FMsgLength := 0;
925 end;
926
900   procedure TIBXINPUTSQLDA.FreeCurMetaData;
901   begin
902    if FCurMetaData <> nil then
# Line 943 | Line 916 | function TIBXINPUTSQLDA.GetMetaData: Fir
916   begin
917    BuildMetadata;
918    Result := FCurMetaData;
919 +  if Result <> nil then
920 +    Result.addRef;
921   end;
922  
923   function TIBXINPUTSQLDA.GetMsgLength: integer;
# Line 954 | Line 929 | end;
929   procedure TIBXINPUTSQLDA.BuildMetadata;
930   var Builder: Firebird.IMetadataBuilder;
931      i: integer;
932 +    version: NativeInt;
933   begin
934    if (FCurMetaData = nil) and (Count > 0) then
935    with FFirebird30ClientAPI do
# Line 964 | Line 940 | begin
940        for i := 0 to Count - 1 do
941        with TIBXSQLVar(Column[i]) do
942        begin
943 <        Builder.setType(StatusIntf,i,FSQLType+1);
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;
# Line 996 | Line 981 | end;
981   procedure TIBXINPUTSQLDA.PackBuffer;
982   var i: integer;
983      P: PByte;
984 +    MsgLen: cardinal;
985   begin
986    BuildMetadata;
987  
988    if (FMsgLength = 0) and (FCurMetaData <> nil) then
989    with FFirebird30ClientAPI do
990    begin
991 <    FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
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
# Line 1045 | Line 1031 | procedure TIBXINPUTSQLDA.FreeXSQLDA;
1031   begin
1032    inherited FreeXSQLDA;
1033    FreeCurMetaData;
1048  FreeMessageBuffer;
1034   end;
1035  
1036   constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
# Line 1054 | 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    FreeXSQLDA;
# Line 1064 | Line 1055 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1055   var i: integer;
1056   begin
1057    FMetaData := aMetaData;
1058 +  FMetaData.AddRef;
1059    with FFirebird30ClientAPI do
1060    begin
1061      Count := aMetadata.getCount(StatusIntf);
# Line 1106 | 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 +  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        InitColumnMetaData(aMetaData);
1129 <      FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1129 >      FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i);
1130        Check4DataBaseError;
1131        if FNullable then
1132        begin
# Line 1180 | Line 1174 | begin
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 1195 | 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 1218 | Line 1221 | begin
1221    Result := FCount;
1222   end;
1223  
1221 function TIBXSQLDA.GetTransaction: TFB30Transaction;
1222 begin
1223  Result := FStatement.GetTransaction as TFB30Transaction;
1224 end;
1225
1224   procedure TIBXSQLDA.Initialize;
1225   begin
1226    if FMetaData <> nil then
# Line 1231 | 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;
# Line 1257 | 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 1275 | Line 1297 | begin
1297    FCount := 0;
1298    SetLength(FColumnList,0);
1299    FSize := 0;
1300 +  FreeMessageBuffer;
1301   end;
1302  
1303   function TIBXSQLDA.GetStatement: IStatement;
# Line 1284 | 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 }
# Line 1331 | Line 1357 | end;
1357  
1358   procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1359   var GUID : TGUID;
1360 +    metadata: Firebird.IMessageMetadata;
1361   begin
1362    if FPrepared then
1363      Exit;
# Line 1391 | 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 1432 | Line 1471 | end;
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 <      FStatementIntf.execute(StatusIntf,
1480 <                             (aTransaction as TFB30Transaction).TransactionIntf,
1481 <                             FSQLParams.MetaData,
1482 <                             FSQLParams.MessageBuffer,
1483 <                             outMetaData,
1484 <                             outBuffer);
1485 <      Check4DataBaseError;
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;
# Line 1484 | Line 1531 | begin
1531  
1532        SQLExecProcedure:
1533        begin
1534 <        ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1535 <        Result := TResults.Create(FSQLRecord);
1536 <        FSingleResults := true;
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  
1545        else
# Line 1507 | Line 1560 | end;
1560   function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1561    Scrollable: boolean): IResultSet;
1562   var flags: cardinal;
1563 +    inMetadata,
1564 +    outMetadata: Firebird.IMessageMetadata;
1565   begin
1566    flags := 0;
1567    if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
# Line 1535 | 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,
1600 >                          outMetaData,
1601                            flags);
1602 <   Check4DataBaseError;
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 1666 | Line 1730 | function TFB30Statement.Fetch(FetchType:
1730    ): boolean;
1731   var fetchResult: integer;
1732   begin
1733 <  result := false;
1733 >    result := false;
1734    if not FOpen then
1735      IBError(ibxeSQLClosed, [nil]);
1736  
# Line 1808 | Line 1872 | 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 <  with FFirebird30ClientAPI do
1886 <  begin
1887 <    if FBatch = nil then
1885 >  inMetadata := FSQLParams.GetMetaData;
1886 >  try
1887 >    with FFirebird30ClientAPI do
1888      begin
1889 <      {Start Batch}
1890 <      BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1891 <      with FFirebird30ClientAPI do
1892 <      try
1893 <        FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1894 <        Check4DatabaseError;
1895 <        if FBatchBufferSize < SixteenMB then
1896 <          FBatchBufferSize := SixteenMB;
1897 <        if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1898 <          IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1899 <
1900 <        BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1901 <        BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1902 <        FBatch := FStatementIntf.createBatch(StatusIntf,
1903 <                                             FSQLParams.MetaData,
1904 <                                             BatchPB.getDataLength,
1905 <                                             BatchPB.getBuffer);
1906 <        Check4DataBaseError;
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;
1914 >        finally
1915 >          BatchPB.Free;
1916 >        end;
1917 >        FBatchRowCount := 0;
1918 >        FBatchBufferUsed := 0;
1919        end;
1845      FBatchRowCount := 0;
1846      FBatchBufferUsed := 0;
1847    end;
1920  
1921 <    Inc(FBatchRowCount);
1922 <    Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1923 <    Check4DataBaseError;
1924 <    if FBatchBufferUsed > FBatchBufferSize then
1925 <      raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1926 <                              Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1927 <                              [FBatchRowCount,FBatchBufferSize]));
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
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  

Comparing:
ibx/branches/journaling/fbintf/client/3.0/FB30Statement.pas (property svn:eol-style), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (property svn:eol-style), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines