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

Comparing ibx/trunk/fbintf/client/2.5/FB25Statement.pas (file contents):
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 111 by tony, Thu Jan 18 14:37:53 2018 UTC

# Line 60 | Line 60
60   {                                                                        }
61   {************************************************************************}
62   unit FB25Statement;
63 + {$IFDEF MSWINDOWS}
64 + {$DEFINE WINDOWS}
65 + {$ENDIF}
66  
67   {$IFDEF FPC}
68 < {$mode objfpc}{$H+}
68 > {$mode delphi}
69   {$codepage UTF8}
70   {$interfaces COM}
71   {$ENDIF}
# Line 128 | Line 131 | type
131    protected
132      function GetSQLType: cardinal; override;
133      function GetSubtype: integer; override;
134 <    function GetAliasName: string;  override;
135 <    function GetFieldName: string; override;
136 <    function GetOwnerName: string;  override;
137 <    function GetRelationName: string;  override;
134 >    function GetAliasName: AnsiString;  override;
135 >    function GetFieldName: AnsiString; override;
136 >    function GetOwnerName: AnsiString;  override;
137 >    function GetRelationName: AnsiString;  override;
138      function GetScale: integer; override;
139      function GetCharSetID: cardinal; override;
140      function GetCodePage: TSystemCodePage; override;
141      function GetIsNull: Boolean;   override;
142      function GetIsNullable: boolean; override;
143 <    function GetSQLData: PChar;  override;
143 >    function GetSQLData: PByte;  override;
144      function GetDataLength: cardinal; override;
145      procedure SetIsNull(Value: Boolean); override;
146      procedure SetIsNullable(Value: Boolean);  override;
147 <    procedure SetSQLData(AValue: PChar; len: cardinal); override;
147 >    procedure SetSQLData(AValue: PByte; len: cardinal); override;
148      procedure SetScale(aValue: integer); override;
149      procedure SetDataLength(len: cardinal); override;
150      procedure SetSQLType(aValue: cardinal); override;
# Line 211 | Line 214 | type
214      procedure Bind;
215      function GetTransaction: TFB25Transaction; override;
216      procedure GetData(index: integer; var aIsNull: boolean; var len: short;
217 <      var data: PChar); override;
217 >      var data: PByte); override;
218      function IsInputDataArea: boolean; override;
219    end;
220  
# Line 226 | Line 229 | type
229      destructor Destroy; override;
230      {IResultSet}
231      function FetchNext: boolean;
232 <    function GetCursorName: string;
232 >    function GetCursorName: AnsiString;
233      function GetTransaction: ITransaction; override;
234      function IsEof: boolean;
235      procedure Close;
# Line 240 | Line 243 | type
243      FHandle: TISC_STMT_HANDLE;
244      FSQLParams: TIBXINPUTSQLDA;
245      FSQLRecord: TIBXOUTPUTSQLDA;
246 <    FCursor: String;               { Cursor name...}
246 >    FCursor: AnsiString;               { Cursor name...}
247      FCursorSeqNo: integer;
248      procedure GetPerfCounters(var counters: TPerfStatistics);
249    protected
# Line 253 | Line 256 | type
256      procedure InternalClose(Force: boolean); override;
257    public
258      constructor Create(Attachment: TFB25Attachment; Transaction: ITransaction;
259 <      sql: string; aSQLDialect: integer);
259 >      sql: AnsiString; aSQLDialect: integer);
260      constructor CreateWithParameterNames(Attachment: TFB25Attachment;
261 <      Transaction: ITransaction; sql: string; aSQLDialect: integer; GenerateParamNames: boolean);
261 >      Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean);
262      destructor Destroy; override;
263      function FetchNext: boolean;
264  
# Line 263 | Line 266 | type
266      {IStatement}
267      function GetSQLParams: ISQLParams; override;
268      function GetMetaData: IMetaData; override;
269 <    function GetPlan: String;
269 >    function GetPlan: AnsiString;
270      function IsPrepared: boolean;
271      function CreateBlob(column: TColumnMetaData): IBlob; override;
272      function CreateArray(column: TColumnMetaData): IArray; override;
# Line 293 | Line 296 | begin
296      result := 0;
297   end;
298  
299 < function TIBXSQLVAR.GetAliasName: string;
299 > function TIBXSQLVAR.GetAliasName: AnsiString;
300   begin
301    result := strpas(FXSQLVAR^.aliasname);
302   end;
303  
304 < function TIBXSQLVAR.GetFieldName: string;
304 > function TIBXSQLVAR.GetFieldName: AnsiString;
305   begin
306    result := strpas(FXSQLVAR^.sqlname);
307   end;
308  
309 < function TIBXSQLVAR.GetOwnerName: string;
309 > function TIBXSQLVAR.GetOwnerName: AnsiString;
310   begin
311    result := strpas(FXSQLVAR^.ownname);
312   end;
313  
314 < function TIBXSQLVAR.GetRelationName: string;
314 > function TIBXSQLVAR.GetRelationName: AnsiString;
315   begin
316    result := strpas(FXSQLVAR^.relname);
317   end;
# Line 332 | Line 335 | begin
335    SQL_BLOB:
336      if (SQLSubType = 1)  then
337        {see http://firebirdsql.org/rlsnotesh/rlsnotes210.html}
338 <      result := FXSQLVAR^.sqlscale;
338 >      result := FXSQLVAR^.sqlscale and $FF;
339  
340    SQL_ARRAY:
341      if (GetRelationName <> '') and (GetFieldName <> '') then
# Line 343 | Line 346 | end;
346   function TIBXSQLVAR.GetCodePage: TSystemCodePage;
347   begin
348    result := CP_NONE;
349 <  with FirebirdClientAPI do
349 >  with Statement.GetAttachment do
350       CharSetID2CodePage(GetCharSetID,result);
351   end;
352  
# Line 357 | Line 360 | begin
360    result := (FXSQLVAR^.sqltype and 1 = 1);
361   end;
362  
363 < function TIBXSQLVAR.GetSQLData: PChar;
363 > function TIBXSQLVAR.GetSQLData: PByte;
364   begin
365    Result := FXSQLVAR^.sqldata;
366   end;
# Line 499 | Line 502 | begin
502        FXSQLVAR^.sqlind := nil;
503      end;
504    end;
505 +  Changed;
506   end;
507  
508 < procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal);
508 > procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
509   begin
510    if FOwnsSQLData then
511      FreeMem(FXSQLVAR^.sqldata);
512    FXSQLVAR^.sqldata := AValue;
513    FXSQLVAR^.sqllen := len;
514    FOwnsSQLData := false;
515 +  Changed;
516   end;
517  
518   procedure TIBXSQLVAR.SetScale(aValue: integer);
519   begin
520    FXSQLVAR^.sqlscale := aValue;
521 +  Changed;
522   end;
523  
524   procedure TIBXSQLVAR.SetDataLength(len: cardinal);
# Line 523 | Line 529 | begin
529    with FirebirdClientAPI do
530      IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
531    FOwnsSQLData := true;
532 +  Changed;
533   end;
534  
535   procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
536   begin
537    FXSQLVAR^.sqltype := aValue or (FXSQLVAR^.sqltype and 1);
538 +  Changed;
539   end;
540  
541   procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
542   begin
543    if aValue <> GetCharSetID then
544 <  case SQLType of
545 <  SQL_VARYING, SQL_TEXT:
546 <      FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
547 <
548 <  SQL_BLOB,
549 <  SQL_ARRAY:
550 <    IBError(ibxeInvalidDataConversion,[nil]);
544 >  begin
545 >    case SQLType of
546 >    SQL_VARYING, SQL_TEXT:
547 >        FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
548 >
549 >    SQL_BLOB,
550 >    SQL_ARRAY:
551 >      IBError(ibxeInvalidDataConversion,[nil]);
552 >    end;
553 >  Changed;
554    end;
555   end;
556  
# Line 590 | Line 601 | begin
601        FResults.Column[i].RowChange;
602   end;
603  
604 < function TResultSet.GetCursorName: string;
604 > function TResultSet.GetCursorName: AnsiString;
605   begin
606    Result := FResults.FStatement.FCursor;
607   end;
# Line 675 | Line 686 | begin
686   end;
687  
688   procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull:boolean; var len: short;
689 <  var data: PChar);
689 >  var data: PByte);
690   begin
691    with TIBXSQLVAR(Column[index]), FXSQLVAR^ do
692    begin
# Line 796 | Line 807 | begin
807          if i >= FSize then
808            FColumnList[i] := TIBXSQLVAR.Create(self,i);
809          TIBXSQLVAR(Column[i]).FXSQLVAR := p;
810 <        p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
810 >        p := Pointer(PAnsiChar(p) + sizeof(FXSQLDA^.sqlvar));
811        end;
812        FSize := inherited Count;
813      end;
# Line 850 | Line 861 | begin
861    {$ELSE}
862    counters[psUserTime] := 0;
863    {$ENDIF}
864 <  counters[psRealTime] := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)));
864 >  counters[psRealTime] := TimeStampToMSecs(DateTimeToTimeStamp(Now));
865  
866    DBInfo := GetAttachment.GetDBInformation([isc_info_reads,isc_info_writes,
867           isc_info_fetches, isc_info_num_buffers, isc_info_current_memory,
# Line 912 | Line 923 | begin
923          if FProcessedSQL = '' then
924            FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
925          Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
926 <                 PChar(FProcessedSQL), FSQLDialect, nil), True);
926 >                 PAnsiChar(FProcessedSQL), FSQLDialect, nil), True);
927        end
928        else
929          Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
930 <                 PChar(FSQL), FSQLDialect, nil), True);
930 >                 PAnsiChar(FSQL), FSQLDialect, nil), True);
931      end;
932      { After preparing the statement, query the stmt type and possibly
933        create a FSQLRecord "holder" }
# Line 1035 | Line 1046 | begin
1046         RemoveMonitor(aTransaction as TFB25Transaction);
1047    end;
1048    FExecTransactionIntf := aTransaction;
1049 +  FSQLRecord.FTransaction := aTransaction as TFB25Transaction;
1050 +  FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1051    Inc(FChangeSeqNo);
1052   end;
1053  
# Line 1072 | Line 1085 | begin
1085       CreateGuid(GUID);
1086       FCursor := GUIDToString(GUID);
1087       Call(
1088 <       isc_dsql_set_cursor_name(StatusVector, @FHandle, PChar(FCursor), 0),
1088 >       isc_dsql_set_cursor_name(StatusVector, @FHandle, PAnsiChar(FCursor), 0),
1089         True);
1090     end;
1091  
# Line 1133 | Line 1146 | begin
1146          IBDatabaseError;
1147      end;
1148    finally
1149 <    if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1149 >    if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB25Transaction)) then
1150        RemoveMonitor(FSQLRecord.FTransaction);
1151      FOpen := False;
1152      FExecTransactionIntf := nil;
# Line 1143 | Line 1156 | begin
1156   end;
1157  
1158   constructor TFB25Statement.Create(Attachment: TFB25Attachment;
1159 <  Transaction: ITransaction; sql: string; aSQLDialect: integer);
1159 >  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1160   begin
1161    inherited Create(Attachment,Transaction,sql,aSQLDialect);
1162    FDBHandle := Attachment.Handle;
# Line 1153 | Line 1166 | begin
1166   end;
1167  
1168   constructor TFB25Statement.CreateWithParameterNames(Attachment: TFB25Attachment;
1169 <  Transaction: ITransaction; sql: string; aSQLDialect: integer;
1169 >  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1170    GenerateParamNames: boolean);
1171   begin
1172    inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
# Line 1228 | Line 1241 | begin
1241    Result := TMetaData(GetInterface(1));
1242   end;
1243  
1244 < function TFB25Statement.GetPlan: String;
1244 > function TFB25Statement.GetPlan: AnsiString;
1245   var
1246      RB: ISQLInfoResults;
1247   begin

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines