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/trunk/fbintf/client/3.0/FB30Statement.pas (file contents):
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 270 by tony, Fri Jan 18 11:10:37 2019 UTC

# Line 87 | Line 87 | type
87    TIBXSQLVAR = class(TSQLVarData)
88    private
89      FStatement: TFB30Statement;
90 +    FFirebird30ClientAPI: TFB30ClientAPI;
91      FBlob: IBlob;             {Cache references}
92      FArray: IArray;
93      FNullIndicator: short;
# Line 148 | Line 149 | type
149      FSize: Integer;  {Number of TIBXSQLVARs in column list}
150      FMetaData: Firebird.IMessageMetadata;
151      FTransactionSeqNo: integer;
152 <  protected
152 > protected
153      FStatement: TFB30Statement;
154 +    FFirebird30ClientAPI: TFB30ClientAPI;
155      function GetTransactionSeqNo: integer; override;
156      procedure FreeXSQLDA; virtual;
157      function GetStatement: IStatement; override;
# Line 181 | Line 183 | type
183      function GetMetaData: Firebird.IMessageMetadata;
184      function GetModified: Boolean;
185      function GetMsgLength: integer;
186 +    procedure BuildMetadata;
187      procedure PackBuffer;
188    protected
189      procedure FreeXSQLDA; override;
# Line 235 | Line 238 | type
238    TFB30Statement = class(TFBStatement,IStatement)
239    private
240      FStatementIntf: Firebird.IStatement;
241 +    FFirebird30ClientAPI: TFB30ClientAPI;
242      FSQLParams: TIBXINPUTSQLDA;
243      FSQLRecord: TIBXOUTPUTSQLDA;
244      FResultSet: Firebird.IResultSet;
# Line 245 | Line 249 | type
249      procedure InternalPrepare; override;
250      function InternalExecute(aTransaction: ITransaction): IResults; override;
251      function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
252 +    procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
253      procedure FreeHandle; override;
254      procedure InternalClose(Force: boolean); override;
255    public
256      constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
257        sql: AnsiString; aSQLDialect: integer);
258      constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
259 <      sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false);
259 >      sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false;
260 >      CaseSensitiveParams: boolean=false);
261      destructor Destroy; override;
262      function FetchNext: boolean;
263      property StatementIntf: Firebird.IStatement read FStatementIntf;
# Line 270 | Line 276 | end;
276  
277   implementation
278  
279 < uses IBUtils, FBMessages, FBBLob, FB30Blob, variants,  FBArray, FB30Array;
279 > uses IBUtils, FBMessages, FBBlob, FB30Blob, variants,  FBArray, FB30Array;
280  
281   const
282    ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
# Line 295 | Line 301 | end;
301  
302   function TIBXSQLVAR.GetAliasName: AnsiString;
303   begin
304 <  with Firebird30ClientAPI do
304 >  with FFirebird30ClientAPI do
305    begin
306      result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
307      Check4DataBaseError;
# Line 309 | Line 315 | end;
315  
316   function TIBXSQLVAR.GetOwnerName: AnsiString;
317   begin
318 <  with Firebird30ClientAPI do
318 >  with FFirebird30ClientAPI do
319    begin
320      result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
321      Check4DataBaseError;
# Line 343 | Line 349 | begin
349      else
350        result := FCharSetID;
351    end;
352 +  result := result;
353   end;
354  
355   function TIBXSQLVAR.GetCodePage: TSystemCodePage;
356   begin
357    result := CP_NONE;
358 <  with Firebird30ClientAPI do
358 >  with Statement.GetAttachment do
359       CharSetID2CodePage(GetCharSetID,result);
360   end;
361  
# Line 421 | Line 428 | begin
428    end
429    else
430      FSQLNullIndicator := nil;
431 +  Changed;
432   end;
433  
434   procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
# Line 430 | Line 438 | begin
438    FSQLData := AValue;
439    FDataLength := len;
440    FOwnsSQLData := false;
441 +  Changed;
442   end;
443  
444   procedure TIBXSQLVAR.SetScale(aValue: integer);
445   begin
446    FScale := aValue;
447 +  Changed;
448   end;
449  
450   procedure TIBXSQLVAR.SetDataLength(len: cardinal);
# Line 442 | Line 452 | begin
452    if not FOwnsSQLData then
453      FSQLData := nil;
454    FDataLength := len;
455 <  with Firebird30ClientAPI do
455 >  with FFirebird30ClientAPI do
456      IBAlloc(FSQLData, 0, FDataLength);
457    FOwnsSQLData := true;
458 +  Changed;
459   end;
460  
461   procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
462   begin
463    FSQLType := aValue;
464 +  Changed;
465   end;
466  
467   procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
468   begin
469    FCharSetID := aValue;
470 +  Changed;
471   end;
472  
473   constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
474   begin
475    inherited Create(aParent,aIndex);
476    FStatement := aParent.Statement;
477 +  FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
478   end;
479  
480   procedure TIBXSQLVAR.RowChange;
# Line 606 | Line 620 | end;
620  
621   function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
622   begin
623 <  PackBuffer;
623 >  BuildMetadata;
624    Result := FCurMetaData;
625   end;
626  
# Line 616 | Line 630 | begin
630    Result := FMsgLength;
631   end;
632  
633 < procedure TIBXINPUTSQLDA.PackBuffer;
633 > procedure TIBXINPUTSQLDA.BuildMetadata;
634   var Builder: Firebird.IMetadataBuilder;
635      i: integer;
636   begin
637 <  if FMsgLength > 0 then Exit;
638 <
625 <  with Firebird30ClientAPI do
637 >  if FCurMetaData = nil then
638 >  with FFirebird30ClientAPI do
639    begin
640      Builder := inherited MetaData.getBuilder(StatusIntf);
641      Check4DataBaseError;
# Line 646 | Line 659 | begin
659      finally
660        Builder.release;
661      end;
662 +  end;
663 + end;
664  
665 + procedure TIBXINPUTSQLDA.PackBuffer;
666 + var i: integer;
667 + begin
668 +  BuildMetadata;
669 +
670 +  if FMsgLength = 0 then
671 +  with FFirebird30ClientAPI do
672 +  begin
673      FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
674      Check4DataBaseError;
675  
# Line 655 | Line 678 | begin
678      for i := 0 to Count - 1 do
679      with TIBXSQLVar(Column[i]) do
680      begin
681 +      if not Modified then
682 +        IBError(ibxeUninitializedInputParameter,[i,Name]);
683 +
684        if IsNull then
685          FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
686        else
687 +      if FSQLData <> nil then
688          Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
689        Check4DataBaseError;
690        if IsNullable then
# Line 691 | Line 718 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
718   var i: integer;
719   begin
720    FMetaData := aMetaData;
721 <  with Firebird30ClientAPI do
721 >  with FFirebird30ClientAPI do
722    begin
723      Count := metadata.getCount(StatusIntf);
724      Check4DataBaseError;
# Line 738 | Line 765 | begin
765          FSQLNullIndicator := nil;
766        FScale := aMetaData.getScale(StatusIntf,i);
767        Check4DataBaseError;
768 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
768 >      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
769        Check4DataBaseError;
770      end;
771    end;
# Line 769 | Line 796 | procedure TIBXOUTPUTSQLDA.Bind(aMetaData
796   var i: integer;
797   begin
798    FMetaData := aMetaData;
799 <  with Firebird30ClientAPI do
799 >  with FFirebird30ClientAPI do
800    begin
801      Count := metadata.getCount(StatusIntf);
802      Check4DataBaseError;
# Line 812 | Line 839 | begin
839          FSQLNullIndicator := nil;
840        FScale := aMetaData.getScale(StatusIntf,i);
841        Check4DataBaseError;
842 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
842 >      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
843        Check4DataBaseError;
844      end;
845    end;
# Line 829 | Line 856 | begin
856      len := FDataLength;
857      if not IsNull and (FSQLType = SQL_VARYING) then
858      begin
859 <      with Firebird30ClientAPI do
859 >      with FFirebird30ClientAPI do
860          len := DecodeInteger(data,2);
861        Inc(Data,2);
862      end;
# Line 846 | Line 873 | constructor TIBXSQLDA.Create(aStatement:
873   begin
874    inherited Create;
875    FStatement := aStatement;
876 +  FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
877    FSize := 0;
878   //  writeln('Creating ',ClassName);
879   end;
# Line 962 | Line 990 | end;
990   procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
991    );
992   begin
993 <  with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
993 >  with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
994    begin
995      StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
996                       GetBufSize, BytePtr(Buffer));
# Line 978 | Line 1006 | begin
1006      IBError(ibxeEmptyQuery, [nil]);
1007    try
1008      CheckTransaction(FTransactionIntf);
1009 <    with Firebird30ClientAPI do
1009 >    with FFirebird30ClientAPI do
1010      begin
1011        if FHasParamNames then
1012        begin
1013          if FProcessedSQL = '' then
1014 <          FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1014 >          ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1015          FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1016                              (FTransactionIntf as TFB30Transaction).TransactionIntf,
1017                              Length(FProcessedSQL),
# Line 1075 | Line 1103 | begin
1103      IBError(ibxeInterfaceOutofDate,[nil]);
1104  
1105    try
1106 <    with Firebird30ClientAPI do
1106 >    with FFirebird30ClientAPI do
1107      begin
1108        if FCollectStatistics then
1109        begin
# Line 1125 | Line 1153 | begin
1153         RemoveMonitor(aTransaction as TFB30Transaction);
1154    end;
1155    FExecTransactionIntf := aTransaction;
1156 +  FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1157 +  FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1158    SignalActivity;
1159    Inc(FChangeSeqNo);
1160   end;
# Line 1144 | Line 1174 | begin
1174    if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1175      IBError(ibxeInterfaceOutofDate,[nil]);
1176  
1177 < with Firebird30ClientAPI do
1177 > with FFirebird30ClientAPI do
1178   begin
1179     if FCollectStatistics then
1180     begin
# Line 1184 | Line 1214 | begin
1214   Inc(FChangeSeqNo);
1215   end;
1216  
1217 + procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1218 +  var processedSQL: AnsiString);
1219 + begin
1220 +  FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1221 + end;
1222 +
1223   procedure TFB30Statement.FreeHandle;
1224   begin
1225    Close;
# Line 1200 | Line 1236 | procedure TFB30Statement.InternalClose(F
1236   begin
1237    if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1238    try
1239 <    with Firebird30ClientAPI do
1239 >    with FFirebird30ClientAPI do
1240      begin
1241        if FResultSet <> nil then
1242        begin
# Line 1228 | Line 1264 | constructor TFB30Statement.Create(Attach
1264    Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1265   begin
1266    inherited Create(Attachment,Transaction,sql,aSQLDialect);
1267 +  FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1268    FSQLParams := TIBXINPUTSQLDA.Create(self);
1269    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1270    InternalPrepare;
# Line 1235 | Line 1272 | end;
1272  
1273   constructor TFB30Statement.CreateWithParameterNames(
1274    Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1275 <  aSQLDialect: integer; GenerateParamNames: boolean);
1275 >  aSQLDialect: integer; GenerateParamNames: boolean;
1276 >  CaseSensitiveParams: boolean);
1277   begin
1278    inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1279 +  FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1280    FSQLParams := TIBXINPUTSQLDA.Create(self);
1281 +  FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1282    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1283    InternalPrepare;
1284   end;
# Line 1259 | Line 1299 | begin
1299    if FEOF then
1300      IBError(ibxeEOF,[nil]);
1301  
1302 <  with Firebird30ClientAPI do
1302 >  with FFirebird30ClientAPI do
1303    begin
1304      { Go to the next record... }
1305      fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
# Line 1284 | Line 1324 | begin
1324        FBOF := false;
1325        result := true;
1326      end;
1327 +    if FCollectStatistics then
1328 +    begin
1329 +      UtilIntf.getPerfCounters(StatusIntf,
1330 +                              (GetAttachment as TFB30Attachment).AttachmentIntf,
1331 +                              ISQL_COUNTERS,@FAfterStats);
1332 +      Check4DataBaseError;
1333 +      FStatisticsAvailable := true;
1334 +    end;
1335    end;
1336    FSQLRecord.RowChange;
1337    SignalActivity;
# Line 1315 | Line 1363 | begin
1363         SQLUpdate, SQLDelete])) then
1364      result := ''
1365    else
1366 <  with Firebird30ClientAPI do
1366 >  with FFirebird30ClientAPI do
1367    begin
1368      Result := FStatementIntf.getPlan(StatusIntf,true);
1369      Check4DataBaseError;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines