27 |
|
{ IBX For Lazarus (Firebird Express) } |
28 |
|
{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk } |
29 |
|
{ Portions created by MWA Software are copyright McCallum Whyman } |
30 |
< |
{ Associates Ltd 2011 } |
30 |
> |
{ Associates Ltd 2011 - 2014 } |
31 |
|
{ } |
32 |
|
{************************************************************************} |
33 |
|
|
35 |
|
|
36 |
|
{$Mode Delphi} |
37 |
|
|
38 |
+ |
{$IF FPC_FULLVERSION >= 20700 } |
39 |
+ |
{$codepage UTF8} |
40 |
+ |
{$DEFINE HAS_ANSISTRING_CODEPAGE} |
41 |
+ |
{$ENDIF} |
42 |
+ |
|
43 |
+ |
{ IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled. |
44 |
+ |
|
45 |
+ |
Dialect 3 quoted format parameter names represent a significant overhead and are of |
46 |
+ |
limited value - especially for users that use only TIBSQL or TIBCustomDataset |
47 |
+ |
descendents. They were previously used internally by IBX to simplify SQL generation |
48 |
+ |
for TTable components in Master/Slave relationships which are linked by |
49 |
+ |
Dialect 3 names. They were also generated by TStoredProc when the original |
50 |
+ |
parameter names are quoted. |
51 |
+ |
|
52 |
+ |
However, for some users they do cause a big processing overhead. The TTable/TStoredProc |
53 |
+ |
code has been re-written so that they are no required by IBX internally. |
54 |
+ |
The code to support quoted parameter names is now subject to conditional compilation. |
55 |
+ |
To enable support, ALLOWDIALECT3PARAMNAMES should be defined when IBX is compiled. |
56 |
+ |
|
57 |
+ |
Hint: deleting the space between the brace and the dollar sign below |
58 |
+ |
|
59 |
+ |
} |
60 |
+ |
|
61 |
+ |
{ $define ALLOWDIALECT3PARAMNAMES} |
62 |
+ |
|
63 |
+ |
{$ifndef ALLOWDIALECT3PARAMNAMES} |
64 |
+ |
|
65 |
+ |
{ Even when dialect 3 quoted format parameter names are not supported, IBX still processes |
66 |
+ |
parameter names case insensitive. This does result in some additional overhead |
67 |
+ |
due to a call to "AnsiUpperCase". This can be avoided by undefining |
68 |
+ |
"UseCaseSensitiveParamName" below. |
69 |
+ |
|
70 |
+ |
Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES" |
71 |
+ |
is defined. This will not give a useful result. |
72 |
+ |
} |
73 |
+ |
{$define UseCaseSensitiveParamName} |
74 |
+ |
{$endif} |
75 |
+ |
|
76 |
|
interface |
77 |
|
|
78 |
|
uses |
81 |
|
{$ELSE} |
82 |
|
baseunix, unix, |
83 |
|
{$ENDIF} |
84 |
< |
SysUtils, Classes, Forms, Controls, IBHeader, |
84 |
> |
SysUtils, Classes, IBHeader, |
85 |
|
IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst; |
86 |
|
|
87 |
+ |
const |
88 |
+ |
sSQLErrorSeparator = ' When Executing: '; |
89 |
+ |
|
90 |
|
type |
91 |
|
TIBSQL = class; |
92 |
|
TIBXSQLDA = class; |
97 |
|
FParent: TIBXSQLDA; |
98 |
|
FSQL: TIBSQL; |
99 |
|
FIndex: Integer; |
100 |
+ |
FCharSetID: integer; |
101 |
|
FModified: Boolean; |
102 |
|
FName: String; |
103 |
+ |
FUniqueName: boolean; |
104 |
|
FXSQLVAR: PXSQLVAR; { Point to the PXSQLVAR in the owner object } |
105 |
|
|
106 |
|
function AdjustScale(Value: Int64; Scale: Integer): Double; |
107 |
|
function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64; |
108 |
|
function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency; |
109 |
+ |
function GetAsBoolean: boolean; |
110 |
|
function GetAsCurrency: Currency; |
111 |
|
function GetAsInt64: Int64; |
112 |
|
function GetAsDateTime: TDateTime; |
123 |
|
function GetIsNullable: Boolean; |
124 |
|
function GetSize: Integer; |
125 |
|
function GetSQLType: Integer; |
126 |
+ |
procedure SetAsBoolean(AValue: boolean); |
127 |
|
procedure SetAsCurrency(Value: Currency); |
128 |
|
procedure SetAsInt64(Value: Int64); |
129 |
|
procedure SetAsDate(Value: TDateTime); |
130 |
+ |
procedure SetAsLong(Value: Long); |
131 |
|
procedure SetAsTime(Value: TDateTime); |
132 |
|
procedure SetAsDateTime(Value: TDateTime); |
133 |
|
procedure SetAsDouble(Value: Double); |
134 |
|
procedure SetAsFloat(Value: Float); |
89 |
– |
procedure SetAsLong(Value: Long); |
135 |
|
procedure SetAsPointer(Value: Pointer); |
136 |
|
procedure SetAsQuad(Value: TISC_QUAD); |
137 |
|
procedure SetAsShort(Value: Short); |
140 |
|
procedure SetAsXSQLVAR(Value: PXSQLVAR); |
141 |
|
procedure SetIsNull(Value: Boolean); |
142 |
|
procedure SetIsNullable(Value: Boolean); |
143 |
+ |
procedure xSetAsBoolean(AValue: boolean); |
144 |
+ |
procedure xSetAsCurrency(Value: Currency); |
145 |
+ |
procedure xSetAsInt64(Value: Int64); |
146 |
+ |
procedure xSetAsDate(Value: TDateTime); |
147 |
+ |
procedure xSetAsTime(Value: TDateTime); |
148 |
+ |
procedure xSetAsDateTime(Value: TDateTime); |
149 |
+ |
procedure xSetAsDouble(Value: Double); |
150 |
+ |
procedure xSetAsFloat(Value: Float); |
151 |
+ |
procedure xSetAsLong(Value: Long); |
152 |
+ |
procedure xSetAsPointer(Value: Pointer); |
153 |
+ |
procedure xSetAsQuad(Value: TISC_QUAD); |
154 |
+ |
procedure xSetAsShort(Value: Short); |
155 |
+ |
procedure xSetAsString(Value: String); |
156 |
+ |
procedure xSetAsVariant(Value: Variant); |
157 |
+ |
procedure xSetAsXSQLVAR(Value: PXSQLVAR); |
158 |
+ |
procedure xSetIsNull(Value: Boolean); |
159 |
+ |
procedure xSetIsNullable(Value: Boolean); |
160 |
|
public |
161 |
|
constructor Create(Parent: TIBXSQLDA; Query: TIBSQL); |
162 |
|
procedure Assign(Source: TIBXSQLVAR); |
163 |
|
procedure Clear; |
164 |
+ |
function GetCharSetID: integer; |
165 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
166 |
+ |
function GetCodePage: TSystemCodePage; |
167 |
+ |
{$ENDIF} |
168 |
|
procedure LoadFromFile(const FileName: String); |
169 |
|
procedure LoadFromStream(Stream: TStream); |
170 |
|
procedure SaveToFile(const FileName: String); |
171 |
|
procedure SaveToStream(Stream: TStream); |
172 |
|
property AsDate: TDateTime read GetAsDateTime write SetAsDate; |
173 |
+ |
property AsBoolean:boolean read GetAsBoolean write SetAsBoolean; |
174 |
|
property AsTime: TDateTime read GetAsDateTime write SetAsTime; |
175 |
|
property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime; |
176 |
|
property AsDouble: Double read GetAsDouble write SetAsDouble; |
198 |
|
|
199 |
|
TIBXSQLVARArray = Array of TIBXSQLVAR; |
200 |
|
|
201 |
< |
{ TIBXSQLVAR } |
201 |
> |
TIBXSQLDAType = (daInput,daOutput); |
202 |
> |
|
203 |
> |
{ TIBXSQLDA } |
204 |
> |
|
205 |
|
TIBXSQLDA = class(TObject) |
206 |
|
protected |
207 |
|
FSQL: TIBSQL; |
208 |
|
FCount: Integer; |
139 |
– |
FNames: TStrings; |
209 |
|
FSize: Integer; |
210 |
+ |
FInputSQLDA: boolean; |
211 |
|
FXSQLDA: PXSQLDA; |
212 |
|
FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs } |
213 |
|
FUniqueRelationName: String; |
214 |
|
function GetModified: Boolean; |
145 |
– |
function GetNames: String; |
215 |
|
function GetRecordSize: Integer; |
216 |
|
function GetXSQLDA: PXSQLDA; |
217 |
|
function GetXSQLVAR(Idx: Integer): TIBXSQLVAR; |
219 |
|
procedure Initialize; |
220 |
|
procedure SetCount(Value: Integer); |
221 |
|
public |
222 |
< |
constructor Create(Query: TIBSQL); |
222 |
> |
constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType); |
223 |
|
destructor Destroy; override; |
224 |
< |
procedure AddName(FieldName: String; Idx: Integer); |
224 |
> |
procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false); |
225 |
|
function ByName(Idx: String): TIBXSQLVAR; |
226 |
|
property AsXSQLDA: PXSQLDA read GetXSQLDA; |
227 |
|
property Count: Integer read FCount write SetCount; |
228 |
|
property Modified: Boolean read GetModified; |
160 |
– |
property Names: String read GetNames; |
229 |
|
property RecordSize: Integer read GetRecordSize; |
230 |
|
property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default; |
231 |
|
property UniqueRelationName: String read FUniqueRelationName; |
338 |
|
TIBSQL = class(TComponent) |
339 |
|
private |
340 |
|
FIBLoaded: Boolean; |
341 |
+ |
FOnSQLChanged: TNotifyEvent; |
342 |
+ |
FUniqueParamNames: Boolean; |
343 |
|
function GetFieldCount: integer; |
344 |
+ |
procedure SetUniqueParamNames(AValue: Boolean); |
345 |
|
protected |
346 |
|
FBase: TIBBase; |
347 |
|
FBOF, { At BOF? } |
377 |
|
procedure SetSQL(Value: TStrings); |
378 |
|
procedure SetTransaction(Value: TIBTransaction); |
379 |
|
procedure SQLChanging(Sender: TObject); |
380 |
< |
procedure BeforeTransactionEnd(Sender: TObject); |
380 |
> |
procedure SQLChanged(Sender: TObject); |
381 |
> |
procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction); |
382 |
|
public |
383 |
|
constructor Create(AOwner: TComponent); override; |
384 |
|
destructor Destroy; override; |
412 |
|
property SQLType: TIBSQLTypes read FSQLType; |
413 |
|
property TRHandle: PISC_TR_HANDLE read GetTRHandle; |
414 |
|
property Handle: TISC_STMT_HANDLE read FHandle; |
343 |
– |
property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames; |
415 |
|
property UniqueRelationName: String read GetUniqueRelationName; |
416 |
|
published |
417 |
|
property Database: TIBDatabase read GetDatabase write SetDatabase; |
418 |
+ |
property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames; |
419 |
+ |
property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames; |
420 |
|
property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute |
421 |
|
write FGoToFirstRecordOnExecute |
422 |
|
default True; |
424 |
|
property SQL: TStrings read FSQL write SetSQL; |
425 |
|
property Transaction: TIBTransaction read GetTransaction write SetTransaction; |
426 |
|
property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging; |
427 |
+ |
property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged; |
428 |
|
end; |
429 |
|
|
430 |
|
implementation |
431 |
|
|
432 |
|
uses |
433 |
< |
IBIntf, IBBlob, Variants , IBSQLMonitor; |
433 |
> |
IBIntf, IBBlob, Variants , IBSQLMonitor, IBCodePage; |
434 |
|
|
435 |
|
{ TIBXSQLVAR } |
436 |
|
constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL); |
605 |
|
result := Value; |
606 |
|
end; |
607 |
|
|
608 |
+ |
function TIBXSQLVAR.GetAsBoolean: boolean; |
609 |
+ |
begin |
610 |
+ |
result := false; |
611 |
+ |
if not IsNull then |
612 |
+ |
begin |
613 |
+ |
if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then |
614 |
+ |
result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE |
615 |
+ |
else |
616 |
+ |
IBError(ibxeInvalidDataConversion, [nil]); |
617 |
+ |
end |
618 |
+ |
end; |
619 |
+ |
|
620 |
|
function TIBXSQLVAR.GetAsCurrency: Currency; |
621 |
|
begin |
622 |
|
result := 0; |
847 |
|
sz: PChar; |
848 |
|
str_len: Integer; |
849 |
|
ss: TStringStream; |
850 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
851 |
+ |
rs: RawByteString; |
852 |
+ |
{$ENDIF} |
853 |
|
begin |
854 |
|
result := ''; |
855 |
|
{ Check null, if so return a default string } |
861 |
|
ss := TStringStream.Create(''); |
862 |
|
try |
863 |
|
SaveToStream(ss); |
864 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
865 |
+ |
rs := ss.DataString; |
866 |
+ |
SetCodePage(rs,GetCodePage,false); |
867 |
+ |
result := rs; |
868 |
+ |
{$ELSE} |
869 |
|
result := ss.DataString; |
870 |
+ |
{$ENDIF} |
871 |
|
finally |
872 |
|
ss.Free; |
873 |
|
end; |
880 |
|
str_len := isc_vax_integer(FXSQLVar^.sqldata, 2); |
881 |
|
Inc(sz, 2); |
882 |
|
end; |
883 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
884 |
+ |
SetString(rs, sz, str_len); |
885 |
+ |
SetCodePage(rs,GetCodePage,false); |
886 |
+ |
result := rs; |
887 |
+ |
{$ELSE} |
888 |
|
SetString(result, sz, str_len); |
889 |
+ |
{$ENDIF} |
890 |
|
if ((FXSQLVar^.sqltype and (not 1)) = SQL_TEXT) then |
891 |
|
result := TrimRight(result); |
892 |
|
end; |
943 |
|
result := AsDouble; |
944 |
|
SQL_INT64: |
945 |
|
if FXSQLVAR^.sqlscale = 0 then |
946 |
< |
IBError(ibxeInvalidDataConversion, [nil]) |
946 |
> |
result := AsInt64 |
947 |
|
else if FXSQLVAR^.sqlscale >= (-4) then |
948 |
|
result := AsCurrency |
949 |
|
else |
950 |
|
result := AsDouble; |
951 |
|
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
952 |
|
result := AsDouble; |
953 |
+ |
SQL_BOOLEAN: |
954 |
+ |
result := AsBoolean; |
955 |
|
else |
956 |
|
IBError(ibxeInvalidDataConversion, [nil]); |
957 |
|
end; |
1040 |
|
result := FXSQLVAR^.sqltype and (not 1); |
1041 |
|
end; |
1042 |
|
|
1043 |
+ |
procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean); |
1044 |
+ |
var |
1045 |
+ |
i: Integer; |
1046 |
+ |
begin |
1047 |
+ |
if FUniqueName then |
1048 |
+ |
xSetAsBoolean(AValue) |
1049 |
+ |
else |
1050 |
+ |
for i := 0 to FParent.FCount - 1 do |
1051 |
+ |
if FParent[i].FName = FName then |
1052 |
+ |
FParent[i].xSetAsBoolean(AValue); |
1053 |
+ |
end; |
1054 |
+ |
|
1055 |
+ |
procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency); |
1056 |
+ |
begin |
1057 |
+ |
if IsNullable then |
1058 |
+ |
IsNull := False; |
1059 |
+ |
FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1); |
1060 |
+ |
FXSQLVAR^.sqlscale := -4; |
1061 |
+ |
FXSQLVAR^.sqllen := SizeOf(Int64); |
1062 |
+ |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1063 |
+ |
PCurrency(FXSQLVAR^.sqldata)^ := Value; |
1064 |
+ |
FModified := True; |
1065 |
+ |
end; |
1066 |
+ |
|
1067 |
|
procedure TIBXSQLVAR.SetAsCurrency(Value: Currency); |
1068 |
|
var |
942 |
– |
xvar: TIBXSQLVAR; |
1069 |
|
i: Integer; |
1070 |
|
begin |
1071 |
|
if FSQL.Database.SQLDialect < 3 then |
1072 |
|
AsDouble := Value |
1073 |
|
else |
1074 |
|
begin |
1075 |
< |
if IsNullable then |
1076 |
< |
IsNull := False; |
1075 |
> |
|
1076 |
> |
if FUniqueName then |
1077 |
> |
xSetAsCurrency(Value) |
1078 |
> |
else |
1079 |
|
for i := 0 to FParent.FCount - 1 do |
1080 |
< |
if FParent.FNames[i] = FName then |
1081 |
< |
begin |
954 |
< |
xvar := FParent[i]; |
955 |
< |
xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1); |
956 |
< |
xvar.FXSQLVAR^.sqlscale := -4; |
957 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(Int64); |
958 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
959 |
< |
PCurrency(xvar.FXSQLVAR^.sqldata)^ := Value; |
960 |
< |
xvar.FModified := True; |
961 |
< |
end; |
1080 |
> |
if FParent[i].FName = FName then |
1081 |
> |
FParent[i].xSetAsCurrency(Value); |
1082 |
|
end; |
1083 |
|
end; |
1084 |
|
|
1085 |
+ |
procedure TIBXSQLVAR.xSetAsInt64(Value: Int64); |
1086 |
+ |
begin |
1087 |
+ |
if IsNullable then |
1088 |
+ |
IsNull := False; |
1089 |
+ |
|
1090 |
+ |
FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1); |
1091 |
+ |
FXSQLVAR^.sqlscale := 0; |
1092 |
+ |
FXSQLVAR^.sqllen := SizeOf(Int64); |
1093 |
+ |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1094 |
+ |
PInt64(FXSQLVAR^.sqldata)^ := Value; |
1095 |
+ |
FModified := True; |
1096 |
+ |
end; |
1097 |
+ |
|
1098 |
|
procedure TIBXSQLVAR.SetAsInt64(Value: Int64); |
1099 |
|
var |
1100 |
|
i: Integer; |
1101 |
< |
xvar: TIBXSQLVAR; |
1101 |
> |
begin |
1102 |
> |
if FUniqueName then |
1103 |
> |
xSetAsInt64(Value) |
1104 |
> |
else |
1105 |
> |
for i := 0 to FParent.FCount - 1 do |
1106 |
> |
if FParent[i].FName = FName then |
1107 |
> |
FParent[i].xSetAsInt64(Value); |
1108 |
> |
end; |
1109 |
> |
|
1110 |
> |
procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime); |
1111 |
> |
var |
1112 |
> |
tm_date: TCTimeStructure; |
1113 |
> |
Yr, Mn, Dy: Word; |
1114 |
|
begin |
1115 |
|
if IsNullable then |
1116 |
|
IsNull := False; |
1117 |
< |
for i := 0 to FParent.FCount - 1 do |
1118 |
< |
if FParent.FNames[i] = FName then |
1119 |
< |
begin |
1120 |
< |
xvar := FParent[i]; |
1121 |
< |
xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1); |
1122 |
< |
xvar.FXSQLVAR^.sqlscale := 0; |
1123 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(Int64); |
1124 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1125 |
< |
PInt64(xvar.FXSQLVAR^.sqldata)^ := Value; |
1126 |
< |
xvar.FModified := True; |
1127 |
< |
end; |
1117 |
> |
|
1118 |
> |
FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1); |
1119 |
> |
DecodeDate(Value, Yr, Mn, Dy); |
1120 |
> |
with tm_date do begin |
1121 |
> |
tm_sec := 0; |
1122 |
> |
tm_min := 0; |
1123 |
> |
tm_hour := 0; |
1124 |
> |
tm_mday := Dy; |
1125 |
> |
tm_mon := Mn - 1; |
1126 |
> |
tm_year := Yr - 1900; |
1127 |
> |
end; |
1128 |
> |
FXSQLVAR^.sqllen := SizeOf(ISC_DATE); |
1129 |
> |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1130 |
> |
isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata)); |
1131 |
> |
FModified := True; |
1132 |
|
end; |
1133 |
|
|
1134 |
|
procedure TIBXSQLVAR.SetAsDate(Value: TDateTime); |
1135 |
|
var |
1136 |
|
i: Integer; |
988 |
– |
tm_date: TCTimeStructure; |
989 |
– |
Yr, Mn, Dy: Word; |
990 |
– |
xvar: TIBXSQLVAR; |
1137 |
|
begin |
1138 |
|
if FSQL.Database.SQLDialect < 3 then |
1139 |
|
begin |
1140 |
|
AsDateTime := Value; |
1141 |
|
exit; |
1142 |
|
end; |
1143 |
+ |
|
1144 |
+ |
if FUniqueName then |
1145 |
+ |
xSetAsDate(Value) |
1146 |
+ |
else |
1147 |
+ |
for i := 0 to FParent.FCount - 1 do |
1148 |
+ |
if FParent[i].FName = FName then |
1149 |
+ |
FParent[i].xSetAsDate(Value); |
1150 |
+ |
end; |
1151 |
+ |
|
1152 |
+ |
procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime); |
1153 |
+ |
var |
1154 |
+ |
tm_date: TCTimeStructure; |
1155 |
+ |
Hr, Mt, S, Ms: Word; |
1156 |
+ |
begin |
1157 |
|
if IsNullable then |
1158 |
|
IsNull := False; |
1159 |
< |
for i := 0 to FParent.FCount - 1 do |
1160 |
< |
if FParent.FNames[i] = FName then |
1161 |
< |
begin |
1162 |
< |
xvar := FParent[i]; |
1163 |
< |
xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1); |
1164 |
< |
DecodeDate(Value, Yr, Mn, Dy); |
1165 |
< |
with tm_date do begin |
1166 |
< |
tm_sec := 0; |
1167 |
< |
tm_min := 0; |
1168 |
< |
tm_hour := 0; |
1169 |
< |
tm_mday := Dy; |
1170 |
< |
tm_mon := Mn - 1; |
1171 |
< |
tm_year := Yr - 1900; |
1172 |
< |
end; |
1173 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE); |
1174 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1175 |
< |
isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata)); |
1016 |
< |
xvar.FModified := True; |
1017 |
< |
end; |
1159 |
> |
|
1160 |
> |
FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1); |
1161 |
> |
DecodeTime(Value, Hr, Mt, S, Ms); |
1162 |
> |
with tm_date do begin |
1163 |
> |
tm_sec := S; |
1164 |
> |
tm_min := Mt; |
1165 |
> |
tm_hour := Hr; |
1166 |
> |
tm_mday := 0; |
1167 |
> |
tm_mon := 0; |
1168 |
> |
tm_year := 0; |
1169 |
> |
end; |
1170 |
> |
FXSQLVAR^.sqllen := SizeOf(ISC_TIME); |
1171 |
> |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1172 |
> |
isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata)); |
1173 |
> |
if Ms > 0 then |
1174 |
> |
Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10); |
1175 |
> |
FModified := True; |
1176 |
|
end; |
1177 |
|
|
1178 |
|
procedure TIBXSQLVAR.SetAsTime(Value: TDateTime); |
1179 |
|
var |
1180 |
|
i: Integer; |
1023 |
– |
tm_date: TCTimeStructure; |
1024 |
– |
Hr, Mt, S, Ms: Word; |
1025 |
– |
xvar: TIBXSQLVAR; |
1181 |
|
begin |
1182 |
|
if FSQL.Database.SQLDialect < 3 then |
1183 |
|
begin |
1184 |
|
AsDateTime := Value; |
1185 |
|
exit; |
1186 |
|
end; |
1187 |
< |
if IsNullable then |
1188 |
< |
IsNull := False; |
1187 |
> |
|
1188 |
> |
if FUniqueName then |
1189 |
> |
xSetAsTime(Value) |
1190 |
> |
else |
1191 |
|
for i := 0 to FParent.FCount - 1 do |
1192 |
< |
if FParent.FNames[i] = FName then |
1193 |
< |
begin |
1037 |
< |
xvar := FParent[i]; |
1038 |
< |
xvar.FXSQLVAR^.sqltype := SQL_TYPE_TIME or (xvar.FXSQLVAR^.sqltype and 1); |
1039 |
< |
DecodeTime(Value, Hr, Mt, S, Ms); |
1040 |
< |
with tm_date do begin |
1041 |
< |
tm_sec := S; |
1042 |
< |
tm_min := Mt; |
1043 |
< |
tm_hour := Hr; |
1044 |
< |
tm_mday := 0; |
1045 |
< |
tm_mon := 0; |
1046 |
< |
tm_year := 0; |
1047 |
< |
end; |
1048 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(ISC_TIME); |
1049 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1050 |
< |
isc_encode_sql_time(@tm_date, PISC_TIME(xvar.FXSQLVAR^.sqldata)); |
1051 |
< |
if Ms > 0 then |
1052 |
< |
Inc(PISC_TIME(xvar.FXSQLVAR^.sqldata)^,Ms*10); |
1053 |
< |
xvar.FModified := True; |
1054 |
< |
end; |
1192 |
> |
if FParent[i].FName = FName then |
1193 |
> |
FParent[i].xSetAsTime(Value); |
1194 |
|
end; |
1195 |
|
|
1196 |
< |
procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime); |
1196 |
> |
procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime); |
1197 |
|
var |
1059 |
– |
i: Integer; |
1198 |
|
tm_date: TCTimeStructure; |
1199 |
|
Yr, Mn, Dy, Hr, Mt, S, Ms: Word; |
1062 |
– |
xvar: TIBXSQLVAR; |
1200 |
|
begin |
1201 |
|
if IsNullable then |
1202 |
|
IsNull := False; |
1203 |
+ |
|
1204 |
+ |
FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1); |
1205 |
+ |
DecodeDate(Value, Yr, Mn, Dy); |
1206 |
+ |
DecodeTime(Value, Hr, Mt, S, Ms); |
1207 |
+ |
with tm_date do begin |
1208 |
+ |
tm_sec := S; |
1209 |
+ |
tm_min := Mt; |
1210 |
+ |
tm_hour := Hr; |
1211 |
+ |
tm_mday := Dy; |
1212 |
+ |
tm_mon := Mn - 1; |
1213 |
+ |
tm_year := Yr - 1900; |
1214 |
+ |
end; |
1215 |
+ |
FXSQLVAR^.sqllen := SizeOf(TISC_QUAD); |
1216 |
+ |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1217 |
+ |
isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata)); |
1218 |
+ |
if Ms > 0 then |
1219 |
+ |
Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10); |
1220 |
+ |
FModified := True; |
1221 |
+ |
end; |
1222 |
+ |
|
1223 |
+ |
procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime); |
1224 |
+ |
var |
1225 |
+ |
i: Integer; |
1226 |
+ |
begin |
1227 |
+ |
if FUniqueName then |
1228 |
+ |
xSetAsDateTime(value) |
1229 |
+ |
else |
1230 |
|
for i := 0 to FParent.FCount - 1 do |
1231 |
< |
if FParent.FNames[i] = FName then |
1232 |
< |
begin |
1233 |
< |
xvar := FParent[i]; |
1234 |
< |
xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1); |
1235 |
< |
DecodeDate(Value, Yr, Mn, Dy); |
1236 |
< |
DecodeTime(Value, Hr, Mt, S, Ms); |
1237 |
< |
with tm_date do begin |
1238 |
< |
tm_sec := S; |
1239 |
< |
tm_min := Mt; |
1240 |
< |
tm_hour := Hr; |
1241 |
< |
tm_mday := Dy; |
1242 |
< |
tm_mon := Mn - 1; |
1243 |
< |
tm_year := Yr - 1900; |
1244 |
< |
end; |
1245 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD); |
1082 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1083 |
< |
isc_encode_date(@tm_date, PISC_QUAD(xvar.FXSQLVAR^.sqldata)); |
1084 |
< |
if Ms > 0 then |
1085 |
< |
Inc(PISC_TIMESTAMP(xvar.FXSQLVAR^.sqldata)^.timestamp_time,Ms*10); |
1086 |
< |
xvar.FModified := True; |
1087 |
< |
end; |
1231 |
> |
if FParent[i].FName = FName then |
1232 |
> |
FParent[i].xSetAsDateTime(Value); |
1233 |
> |
end; |
1234 |
> |
|
1235 |
> |
procedure TIBXSQLVAR.xSetAsDouble(Value: Double); |
1236 |
> |
begin |
1237 |
> |
if IsNullable then |
1238 |
> |
IsNull := False; |
1239 |
> |
|
1240 |
> |
FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1); |
1241 |
> |
FXSQLVAR^.sqllen := SizeOf(Double); |
1242 |
> |
FXSQLVAR^.sqlscale := 0; |
1243 |
> |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1244 |
> |
PDouble(FXSQLVAR^.sqldata)^ := Value; |
1245 |
> |
FModified := True; |
1246 |
|
end; |
1247 |
|
|
1248 |
|
procedure TIBXSQLVAR.SetAsDouble(Value: Double); |
1249 |
|
var |
1250 |
|
i: Integer; |
1251 |
< |
xvar: TIBXSQLVAR; |
1251 |
> |
begin |
1252 |
> |
if FUniqueName then |
1253 |
> |
xSetAsDouble(Value) |
1254 |
> |
else |
1255 |
> |
for i := 0 to FParent.FCount - 1 do |
1256 |
> |
if FParent[i].FName = FName then |
1257 |
> |
FParent[i].xSetAsDouble(Value); |
1258 |
> |
end; |
1259 |
> |
|
1260 |
> |
procedure TIBXSQLVAR.xSetAsFloat(Value: Float); |
1261 |
|
begin |
1262 |
|
if IsNullable then |
1263 |
|
IsNull := False; |
1264 |
< |
for i := 0 to FParent.FCount - 1 do |
1265 |
< |
if FParent.FNames[i] = FName then |
1266 |
< |
begin |
1267 |
< |
xvar := FParent[i]; |
1268 |
< |
xvar.FXSQLVAR^.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1); |
1269 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(Double); |
1270 |
< |
xvar.FXSQLVAR^.sqlscale := 0; |
1104 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1105 |
< |
PDouble(xvar.FXSQLVAR^.sqldata)^ := Value; |
1106 |
< |
xvar.FModified := True; |
1107 |
< |
end; |
1264 |
> |
|
1265 |
> |
FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1); |
1266 |
> |
FXSQLVAR^.sqllen := SizeOf(Float); |
1267 |
> |
FXSQLVAR^.sqlscale := 0; |
1268 |
> |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1269 |
> |
PSingle(FXSQLVAR^.sqldata)^ := Value; |
1270 |
> |
FModified := True; |
1271 |
|
end; |
1272 |
|
|
1273 |
|
procedure TIBXSQLVAR.SetAsFloat(Value: Float); |
1274 |
|
var |
1275 |
|
i: Integer; |
1276 |
< |
xvar: TIBXSQLVAR; |
1276 |
> |
begin |
1277 |
> |
if FUniqueName then |
1278 |
> |
xSetAsFloat(Value) |
1279 |
> |
else |
1280 |
> |
for i := 0 to FParent.FCount - 1 do |
1281 |
> |
if FParent[i].FName = FName then |
1282 |
> |
FParent[i].xSetAsFloat(Value); |
1283 |
> |
end; |
1284 |
> |
|
1285 |
> |
procedure TIBXSQLVAR.xSetAsLong(Value: Long); |
1286 |
|
begin |
1287 |
|
if IsNullable then |
1288 |
|
IsNull := False; |
1289 |
< |
for i := 0 to FParent.FCount - 1 do |
1290 |
< |
if FParent.FNames[i] = FName then |
1291 |
< |
begin |
1292 |
< |
xvar := FParent[i]; |
1293 |
< |
xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1); |
1294 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(Float); |
1295 |
< |
xvar.FXSQLVAR^.sqlscale := 0; |
1124 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1125 |
< |
PSingle(xvar.FXSQLVAR^.sqldata)^ := Value; |
1126 |
< |
xvar.FModified := True; |
1127 |
< |
end; |
1289 |
> |
|
1290 |
> |
FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1); |
1291 |
> |
FXSQLVAR^.sqllen := SizeOf(Long); |
1292 |
> |
FXSQLVAR^.sqlscale := 0; |
1293 |
> |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1294 |
> |
PLong(FXSQLVAR^.sqldata)^ := Value; |
1295 |
> |
FModified := True; |
1296 |
|
end; |
1297 |
|
|
1298 |
|
procedure TIBXSQLVAR.SetAsLong(Value: Long); |
1299 |
|
var |
1300 |
|
i: Integer; |
1133 |
– |
xvar: TIBXSQLVAR; |
1301 |
|
begin |
1302 |
< |
if IsNullable then |
1303 |
< |
IsNull := False; |
1302 |
> |
if FUniqueName then |
1303 |
> |
xSetAsLong(Value) |
1304 |
> |
else |
1305 |
|
for i := 0 to FParent.FCount - 1 do |
1306 |
< |
if FParent.FNames[i] = FName then |
1307 |
< |
begin |
1140 |
< |
xvar := FParent[i]; |
1141 |
< |
xvar.FXSQLVAR^.sqltype := SQL_LONG or (xvar.FXSQLVAR^.sqltype and 1); |
1142 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(Long); |
1143 |
< |
xvar.FXSQLVAR^.sqlscale := 0; |
1144 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1145 |
< |
PLong(xvar.FXSQLVAR^.sqldata)^ := Value; |
1146 |
< |
xvar.FModified := True; |
1147 |
< |
end; |
1306 |
> |
if FParent[i].FName = FName then |
1307 |
> |
FParent[i].xSetAsLong(Value); |
1308 |
|
end; |
1309 |
|
|
1310 |
< |
procedure TIBXSQLVAR.SetAsPointer(Value: Pointer); |
1151 |
< |
var |
1152 |
< |
i: Integer; |
1153 |
< |
xvar: TIBXSQLVAR; |
1310 |
> |
procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer); |
1311 |
|
begin |
1312 |
|
if IsNullable and (Value = nil) then |
1313 |
|
IsNull := True |
1314 |
|
else begin |
1315 |
|
IsNull := False; |
1316 |
< |
for i := 0 to FParent.FCount - 1 do |
1317 |
< |
if FParent.FNames[i] = FName then |
1161 |
< |
begin |
1162 |
< |
xvar := FParent[i]; |
1163 |
< |
xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1); |
1164 |
< |
Move(Value^, xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen); |
1165 |
< |
xvar.FModified := True; |
1166 |
< |
end; |
1316 |
> |
FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1); |
1317 |
> |
Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen); |
1318 |
|
end; |
1319 |
+ |
FModified := True; |
1320 |
+ |
end; |
1321 |
+ |
|
1322 |
+ |
procedure TIBXSQLVAR.SetAsPointer(Value: Pointer); |
1323 |
+ |
var |
1324 |
+ |
i: Integer; |
1325 |
+ |
begin |
1326 |
+ |
if FUniqueName then |
1327 |
+ |
xSetAsPointer(Value) |
1328 |
+ |
else |
1329 |
+ |
for i := 0 to FParent.FCount - 1 do |
1330 |
+ |
if FParent[i].FName = FName then |
1331 |
+ |
FParent[i].xSetAsPointer(Value); |
1332 |
+ |
end; |
1333 |
+ |
|
1334 |
+ |
procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD); |
1335 |
+ |
begin |
1336 |
+ |
if IsNullable then |
1337 |
+ |
IsNull := False; |
1338 |
+ |
if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and |
1339 |
+ |
(FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then |
1340 |
+ |
IBError(ibxeInvalidDataConversion, [nil]); |
1341 |
+ |
FXSQLVAR^.sqllen := SizeOf(TISC_QUAD); |
1342 |
+ |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1343 |
+ |
PISC_QUAD(FXSQLVAR^.sqldata)^ := Value; |
1344 |
+ |
FModified := True; |
1345 |
|
end; |
1346 |
|
|
1347 |
|
procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD); |
1348 |
|
var |
1349 |
|
i: Integer; |
1350 |
< |
xvar: TIBXSQLVAR; |
1350 |
> |
begin |
1351 |
> |
if FUniqueName then |
1352 |
> |
xSetAsQuad(Value) |
1353 |
> |
else |
1354 |
> |
for i := 0 to FParent.FCount - 1 do |
1355 |
> |
if FParent[i].FName = FName then |
1356 |
> |
FParent[i].xSetAsQuad(Value); |
1357 |
> |
end; |
1358 |
> |
|
1359 |
> |
procedure TIBXSQLVAR.xSetAsShort(Value: Short); |
1360 |
|
begin |
1361 |
|
if IsNullable then |
1362 |
|
IsNull := False; |
1363 |
< |
for i := 0 to FParent.FCount - 1 do |
1364 |
< |
if FParent.FNames[i] = FName then |
1365 |
< |
begin |
1366 |
< |
xvar := FParent[i]; |
1367 |
< |
if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and |
1368 |
< |
(xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then |
1369 |
< |
IBError(ibxeInvalidDataConversion, [nil]); |
1184 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD); |
1185 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1186 |
< |
PISC_QUAD(xvar.FXSQLVAR^.sqldata)^ := Value; |
1187 |
< |
xvar.FModified := True; |
1188 |
< |
end; |
1363 |
> |
|
1364 |
> |
FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1); |
1365 |
> |
FXSQLVAR^.sqllen := SizeOf(Short); |
1366 |
> |
FXSQLVAR^.sqlscale := 0; |
1367 |
> |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1368 |
> |
PShort(FXSQLVAR^.sqldata)^ := Value; |
1369 |
> |
FModified := True; |
1370 |
|
end; |
1371 |
|
|
1372 |
|
procedure TIBXSQLVAR.SetAsShort(Value: Short); |
1373 |
|
var |
1374 |
|
i: Integer; |
1194 |
– |
xvar: TIBXSQLVAR; |
1375 |
|
begin |
1376 |
< |
if IsNullable then |
1377 |
< |
IsNull := False; |
1376 |
> |
if FUniqueName then |
1377 |
> |
xSetAsShort(Value) |
1378 |
> |
else |
1379 |
|
for i := 0 to FParent.FCount - 1 do |
1380 |
< |
if FParent.FNames[i] = FName then |
1381 |
< |
begin |
1201 |
< |
xvar := FParent[i]; |
1202 |
< |
xvar.FXSQLVAR^.sqltype := SQL_SHORT or (xvar.FXSQLVAR^.sqltype and 1); |
1203 |
< |
xvar.FXSQLVAR^.sqllen := SizeOf(Short); |
1204 |
< |
xvar.FXSQLVAR^.sqlscale := 0; |
1205 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen); |
1206 |
< |
PShort(xvar.FXSQLVAR^.sqldata)^ := Value; |
1207 |
< |
xvar.FModified := True; |
1208 |
< |
end; |
1380 |
> |
if FParent[i].FName = FName then |
1381 |
> |
FParent[i].xSetAsShort(Value); |
1382 |
|
end; |
1383 |
|
|
1384 |
< |
procedure TIBXSQLVAR.SetAsString(Value: String); |
1384 |
> |
procedure TIBXSQLVAR.xSetAsString(Value: String); |
1385 |
|
var |
1386 |
< |
stype: Integer; |
1387 |
< |
ss: TStringStream; |
1215 |
< |
|
1216 |
< |
procedure SetStringValue; |
1217 |
< |
var |
1218 |
< |
i: Integer; |
1219 |
< |
xvar: TIBXSQLVAR; |
1220 |
< |
begin |
1221 |
< |
for i := 0 to FParent.FCount - 1 do |
1222 |
< |
if FParent.FNames[i] = FName then |
1223 |
< |
begin |
1224 |
< |
xvar := FParent[i]; |
1225 |
< |
if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize} |
1226 |
< |
(xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize} |
1227 |
< |
Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen) |
1228 |
< |
else begin |
1229 |
< |
xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1); |
1230 |
< |
xvar.FXSQLVAR^.sqllen := Length(Value); |
1231 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen + 1); |
1232 |
< |
if (Length(Value) > 0) then |
1233 |
< |
Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen); |
1234 |
< |
end; |
1235 |
< |
xvar.FModified := True; |
1236 |
< |
end; |
1237 |
< |
end; |
1386 |
> |
stype: Integer; |
1387 |
> |
ss: TStringStream; |
1388 |
|
|
1389 |
+ |
procedure SetStringValue; |
1390 |
+ |
var |
1391 |
+ |
i: Integer; |
1392 |
+ |
begin |
1393 |
+ |
if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize} |
1394 |
+ |
(FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize} |
1395 |
+ |
Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen) |
1396 |
+ |
else begin |
1397 |
+ |
FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1); |
1398 |
+ |
FXSQLVAR^.sqllen := Length(Value); |
1399 |
+ |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1); |
1400 |
+ |
if (Length(Value) > 0) then |
1401 |
+ |
Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen); |
1402 |
+ |
end; |
1403 |
+ |
FModified := True; |
1404 |
+ |
end; |
1405 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1406 |
+ |
var rs: RawByteString; |
1407 |
+ |
codepage: TSystemCodePage; |
1408 |
+ |
{$ENDIF} |
1409 |
|
begin |
1410 |
|
if IsNullable then |
1411 |
|
IsNull := False; |
1412 |
+ |
|
1413 |
|
stype := FXSQLVAR^.sqltype and (not 1); |
1414 |
+ |
|
1415 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1416 |
+ |
codepage := GetCodePage; |
1417 |
+ |
if (codepage <> CP_NONE) and (StringCodePage(Value) <> codepage) then |
1418 |
+ |
begin |
1419 |
+ |
rs := Value; |
1420 |
+ |
SetCodePage(rs,codepage,true); |
1421 |
+ |
Value := rs; |
1422 |
+ |
end; |
1423 |
+ |
{$ENDIF} |
1424 |
+ |
|
1425 |
|
if (stype = SQL_TEXT) or (stype = SQL_VARYING) then |
1426 |
|
SetStringValue |
1427 |
|
else begin |
1438 |
|
IsNull := True |
1439 |
|
else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or |
1440 |
|
(stype = SQL_TYPE_TIME) then |
1441 |
< |
SetAsDateTime(StrToDateTime(Value)) |
1441 |
> |
xSetAsDateTime(StrToDateTime(Value)) |
1442 |
|
else |
1443 |
|
SetStringValue; |
1444 |
|
end; |
1445 |
|
end; |
1446 |
|
|
1447 |
< |
procedure TIBXSQLVAR.SetAsVariant(Value: Variant); |
1447 |
> |
procedure TIBXSQLVAR.SetAsString(Value: String); |
1448 |
> |
var |
1449 |
> |
i: integer; |
1450 |
> |
begin |
1451 |
> |
if FUniqueName then |
1452 |
> |
xSetAsString(Value) |
1453 |
> |
else |
1454 |
> |
for i := 0 to FParent.FCount - 1 do |
1455 |
> |
if FParent[i].FName = FName then |
1456 |
> |
FParent[i].xSetAsString(Value); |
1457 |
> |
end; |
1458 |
> |
|
1459 |
> |
procedure TIBXSQLVAR.xSetAsVariant(Value: Variant); |
1460 |
|
begin |
1461 |
|
if VarIsNull(Value) then |
1462 |
|
IsNull := True |
1463 |
|
else case VarType(Value) of |
1464 |
|
varEmpty, varNull: |
1465 |
|
IsNull := True; |
1466 |
< |
varSmallint, varInteger, varByte: |
1466 |
> |
varSmallint, varInteger, varByte, |
1467 |
> |
varWord, varShortInt: |
1468 |
|
AsLong := Value; |
1469 |
+ |
varInt64: |
1470 |
+ |
AsInt64 := Value; |
1471 |
|
varSingle, varDouble: |
1472 |
|
AsDouble := Value; |
1473 |
|
varCurrency: |
1474 |
|
AsCurrency := Value; |
1475 |
|
varBoolean: |
1476 |
< |
if Value then |
1280 |
< |
AsLong := ISC_TRUE |
1281 |
< |
else |
1282 |
< |
AsLong := ISC_FALSE; |
1476 |
> |
AsBoolean := Value; |
1477 |
|
varDate: |
1478 |
|
AsDateTime := Value; |
1479 |
|
varOleStr, varString: |
1485 |
|
end; |
1486 |
|
end; |
1487 |
|
|
1488 |
< |
procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR); |
1488 |
> |
procedure TIBXSQLVAR.SetAsVariant(Value: Variant); |
1489 |
> |
var |
1490 |
> |
i: integer; |
1491 |
> |
begin |
1492 |
> |
if FUniqueName then |
1493 |
> |
xSetAsVariant(Value) |
1494 |
> |
else |
1495 |
> |
for i := 0 to FParent.FCount - 1 do |
1496 |
> |
if FParent[i].FName = FName then |
1497 |
> |
FParent[i].xSetAsVariant(Value); |
1498 |
> |
end; |
1499 |
> |
|
1500 |
> |
procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR); |
1501 |
|
var |
1296 |
– |
i: Integer; |
1297 |
– |
xvar: TIBXSQLVAR; |
1502 |
|
sqlind: PShort; |
1503 |
|
sqldata: PChar; |
1504 |
|
local_sqllen: Integer; |
1505 |
|
begin |
1506 |
< |
for i := 0 to FParent.FCount - 1 do |
1507 |
< |
if FParent.FNames[i] = FName then |
1508 |
< |
begin |
1509 |
< |
xvar := FParent[i]; |
1510 |
< |
sqlind := xvar.FXSQLVAR^.sqlind; |
1511 |
< |
sqldata := xvar.FXSQLVAR^.sqldata; |
1512 |
< |
Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR)); |
1513 |
< |
xvar.FXSQLVAR^.sqlind := sqlind; |
1514 |
< |
xvar.FXSQLVAR^.sqldata := sqldata; |
1515 |
< |
if (Value^.sqltype and 1 = 1) then |
1516 |
< |
begin |
1517 |
< |
if (xvar.FXSQLVAR^.sqlind = nil) then |
1518 |
< |
IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short)); |
1519 |
< |
xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^; |
1520 |
< |
end |
1521 |
< |
else |
1522 |
< |
if (xvar.FXSQLVAR^.sqlind <> nil) then |
1523 |
< |
ReallocMem(xvar.FXSQLVAR^.sqlind, 0); |
1524 |
< |
if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then |
1525 |
< |
local_sqllen := xvar.FXSQLVAR^.sqllen + 2 |
1526 |
< |
else |
1527 |
< |
local_sqllen := xvar.FXSQLVAR^.sqllen; |
1324 |
< |
FXSQLVAR^.sqlscale := Value^.sqlscale; |
1325 |
< |
IBAlloc(xvar.FXSQLVAR^.sqldata, 0, local_sqllen); |
1326 |
< |
Move(Value^.sqldata[0], xvar.FXSQLVAR^.sqldata[0], local_sqllen); |
1327 |
< |
xvar.FModified := True; |
1328 |
< |
end; |
1506 |
> |
sqlind := FXSQLVAR^.sqlind; |
1507 |
> |
sqldata := FXSQLVAR^.sqldata; |
1508 |
> |
Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR)); |
1509 |
> |
FXSQLVAR^.sqlind := sqlind; |
1510 |
> |
FXSQLVAR^.sqldata := sqldata; |
1511 |
> |
if (Value^.sqltype and 1 = 1) then |
1512 |
> |
begin |
1513 |
> |
if (FXSQLVAR^.sqlind = nil) then |
1514 |
> |
IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short)); |
1515 |
> |
FXSQLVAR^.sqlind^ := Value^.sqlind^; |
1516 |
> |
end |
1517 |
> |
else |
1518 |
> |
if (FXSQLVAR^.sqlind <> nil) then |
1519 |
> |
ReallocMem(FXSQLVAR^.sqlind, 0); |
1520 |
> |
if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then |
1521 |
> |
local_sqllen := FXSQLVAR^.sqllen + 2 |
1522 |
> |
else |
1523 |
> |
local_sqllen := FXSQLVAR^.sqllen; |
1524 |
> |
FXSQLVAR^.sqlscale := Value^.sqlscale; |
1525 |
> |
IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen); |
1526 |
> |
Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen); |
1527 |
> |
FModified := True; |
1528 |
|
end; |
1529 |
|
|
1530 |
< |
procedure TIBXSQLVAR.SetIsNull(Value: Boolean); |
1530 |
> |
procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR); |
1531 |
|
var |
1532 |
|
i: Integer; |
1533 |
< |
xvar: TIBXSQLVAR; |
1533 |
> |
begin |
1534 |
> |
if FUniqueName then |
1535 |
> |
xSetAsXSQLVAR(Value) |
1536 |
> |
else |
1537 |
> |
for i := 0 to FParent.FCount - 1 do |
1538 |
> |
if FParent[i].FName = FName then |
1539 |
> |
FParent[i].xSetAsXSQLVAR(Value); |
1540 |
> |
end; |
1541 |
> |
|
1542 |
> |
procedure TIBXSQLVAR.xSetIsNull(Value: Boolean); |
1543 |
|
begin |
1544 |
|
if Value then |
1545 |
|
begin |
1546 |
|
if not IsNullable then |
1547 |
|
IsNullable := True; |
1548 |
< |
for i := 0 to FParent.FCount - 1 do |
1549 |
< |
if FParent.FNames[i] = FName then |
1550 |
< |
begin |
1551 |
< |
xvar := FParent[i]; |
1344 |
< |
if Assigned(xvar.FXSQLVAR^.sqlind) then |
1345 |
< |
xvar.FXSQLVAR^.sqlind^ := -1; |
1346 |
< |
xvar.FModified := True; |
1347 |
< |
end; |
1548 |
> |
|
1549 |
> |
if Assigned(FXSQLVAR^.sqlind) then |
1550 |
> |
FXSQLVAR^.sqlind^ := -1; |
1551 |
> |
FModified := True; |
1552 |
|
end |
1553 |
|
else |
1554 |
|
if ((not Value) and IsNullable) then |
1555 |
|
begin |
1556 |
< |
for i := 0 to FParent.FCount - 1 do |
1557 |
< |
if FParent.FNames[i] = FName then |
1558 |
< |
begin |
1355 |
< |
xvar := FParent[i]; |
1356 |
< |
if Assigned(xvar.FXSQLVAR^.sqlind) then |
1357 |
< |
xvar.FXSQLVAR^.sqlind^ := 0; |
1358 |
< |
xvar.FModified := True; |
1359 |
< |
end; |
1556 |
> |
if Assigned(FXSQLVAR^.sqlind) then |
1557 |
> |
FXSQLVAR^.sqlind^ := 0; |
1558 |
> |
FModified := True; |
1559 |
|
end; |
1560 |
|
end; |
1561 |
|
|
1562 |
< |
procedure TIBXSQLVAR.SetIsNullable(Value: Boolean); |
1562 |
> |
procedure TIBXSQLVAR.SetIsNull(Value: Boolean); |
1563 |
|
var |
1564 |
|
i: Integer; |
1366 |
– |
xvar: TIBXSQLVAR; |
1565 |
|
begin |
1566 |
+ |
if FUniqueName then |
1567 |
+ |
xSetIsNull(Value) |
1568 |
+ |
else |
1569 |
|
for i := 0 to FParent.FCount - 1 do |
1570 |
< |
if FParent.FNames[i] = FName then |
1570 |
> |
if FParent[i].FName = FName then |
1571 |
> |
FParent[i].xSetIsNull(Value); |
1572 |
> |
end; |
1573 |
> |
|
1574 |
> |
procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean); |
1575 |
> |
begin |
1576 |
> |
if (Value <> IsNullable) then |
1577 |
> |
begin |
1578 |
> |
if Value then |
1579 |
|
begin |
1580 |
< |
xvar := FParent[i]; |
1581 |
< |
if (Value <> IsNullable) then |
1582 |
< |
begin |
1583 |
< |
if Value then |
1584 |
< |
begin |
1585 |
< |
xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1; |
1586 |
< |
IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short)); |
1378 |
< |
end |
1379 |
< |
else |
1380 |
< |
begin |
1381 |
< |
xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1); |
1382 |
< |
ReallocMem(xvar.FXSQLVAR^.sqlind, 0); |
1383 |
< |
end; |
1384 |
< |
end; |
1580 |
> |
FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1; |
1581 |
> |
IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short)); |
1582 |
> |
end |
1583 |
> |
else |
1584 |
> |
begin |
1585 |
> |
FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1); |
1586 |
> |
ReallocMem(FXSQLVAR^.sqlind, 0); |
1587 |
|
end; |
1588 |
+ |
end; |
1589 |
+ |
end; |
1590 |
+ |
|
1591 |
+ |
procedure TIBXSQLVAR.SetIsNullable(Value: Boolean); |
1592 |
+ |
var |
1593 |
+ |
i: Integer; |
1594 |
+ |
begin |
1595 |
+ |
if FUniqueName then |
1596 |
+ |
xSetIsNullable(Value) |
1597 |
+ |
else |
1598 |
+ |
for i := 0 to FParent.FCount - 1 do |
1599 |
+ |
if FParent[i].FName = FName then |
1600 |
+ |
FParent[i].xSetIsNullable(Value); |
1601 |
+ |
end; |
1602 |
+ |
|
1603 |
+ |
procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean); |
1604 |
+ |
begin |
1605 |
+ |
if IsNullable then |
1606 |
+ |
IsNull := False; |
1607 |
+ |
|
1608 |
+ |
FXSQLVAR^.sqltype := SQL_BOOLEAN; |
1609 |
+ |
FXSQLVAR^.sqllen := 1; |
1610 |
+ |
FXSQLVAR^.sqlscale := 0; |
1611 |
+ |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
1612 |
+ |
if AValue then |
1613 |
+ |
PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE |
1614 |
+ |
else |
1615 |
+ |
PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE; |
1616 |
+ |
FModified := True; |
1617 |
|
end; |
1618 |
|
|
1619 |
|
procedure TIBXSQLVAR.Clear; |
1621 |
|
IsNull := true; |
1622 |
|
end; |
1623 |
|
|
1624 |
+ |
function TIBXSQLVAR.GetCharSetID: integer; |
1625 |
+ |
var stype: Integer; |
1626 |
+ |
begin |
1627 |
+ |
if FCharSetID = -1 then |
1628 |
+ |
begin |
1629 |
+ |
FCharSetID := 0; |
1630 |
+ |
stype := FXSQLVAR^.sqltype and (not 1); |
1631 |
+ |
case stype of |
1632 |
+ |
SQL_TEXT,SQL_VARYING: |
1633 |
+ |
FCharSetID := FXSQLVAR^.sqlsubtype and $FF; |
1634 |
+ |
|
1635 |
+ |
SQL_BLOB: |
1636 |
+ |
if (FXSQLVAR^.sqlsubtype = 1) and (strpas(FXSQLVAR^.relname) <> '') and |
1637 |
+ |
(strpas(FXSQLVAR^.sqlname) <> '') then |
1638 |
+ |
FCharSetID := GetBlobCharSetID(FParent.FSQL.Database.Handle,FParent.FSQL.Transaction.Handle, |
1639 |
+ |
@(FXSQLVAR^.relname),@(FXSQLVAR^.sqlname)); |
1640 |
+ |
end; |
1641 |
+ |
|
1642 |
+ |
if (FCharSetID > 1) and (FParent.FSQL.Database.DefaultCharSetName <> '') |
1643 |
+ |
and (FParent.FSQL.Database.DefaultCharSetID > 1) then |
1644 |
+ |
FCharSetID := FParent.FSQL.Database.DefaultCharSetID; |
1645 |
+ |
end; |
1646 |
+ |
Result := FCharSetID; |
1647 |
+ |
end; |
1648 |
+ |
|
1649 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1650 |
+ |
function TIBXSQLVAR.GetCodePage: TSystemCodePage; |
1651 |
+ |
begin |
1652 |
+ |
TFirebirdCharacterSets.CharSetID2CodePage(GetCharSetID,Result); |
1653 |
+ |
end; |
1654 |
+ |
{$ENDIF} |
1655 |
+ |
|
1656 |
|
|
1657 |
|
{ TIBXSQLDA } |
1658 |
< |
constructor TIBXSQLDA.Create(Query: TIBSQL); |
1658 |
> |
constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType); |
1659 |
|
begin |
1660 |
|
inherited Create; |
1661 |
|
FSQL := Query; |
1399 |
– |
FNames := TStringList.Create; |
1662 |
|
FSize := 0; |
1663 |
|
FUniqueRelationName := ''; |
1664 |
+ |
FInputSQLDA := sqldaType = daInput; |
1665 |
|
end; |
1666 |
|
|
1667 |
|
destructor TIBXSQLDA.Destroy; |
1668 |
|
var |
1669 |
|
i: Integer; |
1670 |
|
begin |
1408 |
– |
FNames.Free; |
1671 |
|
if FXSQLDA <> nil then |
1672 |
|
begin |
1673 |
|
for i := 0 to FSize - 1 do |
1683 |
|
inherited Destroy; |
1684 |
|
end; |
1685 |
|
|
1686 |
< |
procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer); |
1686 |
> |
procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer; |
1687 |
> |
UniqueName: boolean); |
1688 |
|
var |
1689 |
< |
fn: String; |
1689 |
> |
fn: string; |
1690 |
|
begin |
1691 |
< |
fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName); |
1692 |
< |
while FNames.Count <= Idx do |
1693 |
< |
FNames.Add(''); |
1694 |
< |
FNames[Idx] := fn; |
1695 |
< |
FXSQLVARs[Idx].FName := fn; |
1691 |
> |
{$ifdef UseCaseSensitiveParamName} |
1692 |
> |
FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName); |
1693 |
> |
{$else} |
1694 |
> |
FXSQLVARs[Idx].FName := FieldName; |
1695 |
> |
{$endif} |
1696 |
|
FXSQLVARs[Idx].FIndex := Idx; |
1697 |
+ |
FXSQLVARs[Idx].FUniqueName := UniqueName |
1698 |
|
end; |
1699 |
|
|
1700 |
|
function TIBXSQLDA.GetModified: Boolean; |
1710 |
|
end; |
1711 |
|
end; |
1712 |
|
|
1449 |
– |
function TIBXSQLDA.GetNames: String; |
1450 |
– |
begin |
1451 |
– |
result := FNames.Text; |
1452 |
– |
end; |
1453 |
– |
|
1713 |
|
function TIBXSQLDA.GetRecordSize: Integer; |
1714 |
|
begin |
1715 |
|
result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize); |
1737 |
|
function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR; |
1738 |
|
var |
1739 |
|
s: String; |
1740 |
< |
i, Cnt: Integer; |
1740 |
> |
i: Integer; |
1741 |
|
begin |
1742 |
< |
s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx); |
1743 |
< |
i := 0; |
1744 |
< |
Cnt := FNames.Count; |
1745 |
< |
while (i < Cnt) and (FNames[i] <> s) do Inc(i); |
1746 |
< |
if i = Cnt then |
1747 |
< |
result := nil |
1748 |
< |
else |
1749 |
< |
result := GetXSQLVAR(i); |
1742 |
> |
{$ifdef ALLOWDIALECT3PARAMNAMES} |
1743 |
> |
s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx); |
1744 |
> |
{$else} |
1745 |
> |
{$ifdef UseCaseSensitiveParamName} |
1746 |
> |
s := AnsiUpperCase(Idx); |
1747 |
> |
{$else} |
1748 |
> |
s := Idx; |
1749 |
> |
{$endif} |
1750 |
> |
{$endif} |
1751 |
> |
for i := 0 to FCount - 1 do |
1752 |
> |
if Vars[i].FName = s then |
1753 |
> |
begin |
1754 |
> |
Result := FXSQLVARs[i]; |
1755 |
> |
Exit; |
1756 |
> |
end; |
1757 |
> |
Result := nil; |
1758 |
|
end; |
1759 |
|
|
1760 |
|
procedure TIBXSQLDA.Initialize; |
1761 |
+ |
|
1762 |
+ |
function VarByName(idx: string; limit: integer): TIBXSQLVAR; |
1763 |
+ |
var |
1764 |
+ |
k: integer; |
1765 |
+ |
begin |
1766 |
+ |
for k := 0 to limit do |
1767 |
+ |
if FXSQLVARs[k].FName = idx then |
1768 |
+ |
begin |
1769 |
+ |
Result := FXSQLVARs[k]; |
1770 |
+ |
Exit; |
1771 |
+ |
end; |
1772 |
+ |
Result := nil; |
1773 |
+ |
end; |
1774 |
+ |
|
1775 |
|
var |
1776 |
|
i, j, j_len: Integer; |
1496 |
– |
NamesWereEmpty: Boolean; |
1777 |
|
st: String; |
1778 |
|
bUnique: Boolean; |
1779 |
+ |
sBaseName: string; |
1780 |
|
begin |
1781 |
|
bUnique := True; |
1501 |
– |
NamesWereEmpty := (FNames.Count = 0); |
1782 |
|
if FXSQLDA <> nil then |
1783 |
|
begin |
1784 |
|
for i := 0 to FCount - 1 do |
1785 |
|
begin |
1786 |
+ |
FXSQLVARs[i].FCharSetID := -1; |
1787 |
|
with FXSQLVARs[i].Data^ do |
1788 |
|
begin |
1789 |
+ |
|
1790 |
+ |
{First get the unique relation name, if any} |
1791 |
+ |
|
1792 |
|
if bUnique and (strpas(relname) <> '') then |
1793 |
|
begin |
1794 |
|
if FUniqueRelationName = '' then |
1800 |
|
bUnique := False; |
1801 |
|
end; |
1802 |
|
end; |
1803 |
< |
if NamesWereEmpty then |
1803 |
> |
|
1804 |
> |
{If an output SQLDA then copy the aliasnames to the FName list. Ensure |
1805 |
> |
that they are all upper case only and disambiguated. |
1806 |
> |
} |
1807 |
> |
|
1808 |
> |
if not FInputSQLDA then |
1809 |
|
begin |
1810 |
< |
st := strpas(aliasname); |
1810 |
> |
st := Space2Underscore(AnsiUppercase(strpas(aliasname))); |
1811 |
|
if st = '' then |
1812 |
|
begin |
1813 |
< |
st := 'F_'; {do not localize} |
1813 |
> |
sBaseName := 'F_'; {do not localize} |
1814 |
|
aliasname_length := 2; |
1815 |
|
j := 1; j_len := 1; |
1816 |
< |
StrPCopy(aliasname, st + IntToStr(j)); |
1816 |
> |
st := sBaseName + IntToStr(j); |
1817 |
|
end |
1818 |
|
else |
1819 |
|
begin |
1531 |
– |
StrPCopy(aliasname, st); |
1820 |
|
j := 0; j_len := 0; |
1821 |
+ |
sBaseName := st; |
1822 |
|
end; |
1823 |
< |
while GetXSQLVARByName(strpas(aliasname)) <> nil do |
1823 |
> |
|
1824 |
> |
{Look for other columns with the same name and make unique} |
1825 |
> |
|
1826 |
> |
while VarByName(st,i-1) <> nil do |
1827 |
|
begin |
1828 |
< |
Inc(j); j_len := Length(IntToStr(j)); |
1829 |
< |
if j_len + aliasname_length > 31 then |
1830 |
< |
StrPCopy(aliasname, |
1831 |
< |
Copy(st, 1, 31 - j_len) + |
1832 |
< |
IntToStr(j)) |
1833 |
< |
else |
1542 |
< |
StrPCopy(aliasname, st + IntToStr(j)); |
1828 |
> |
Inc(j); |
1829 |
> |
j_len := Length(IntToStr(j)); |
1830 |
> |
if j_len + Length(sBaseName) > 31 then |
1831 |
> |
st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j) |
1832 |
> |
else |
1833 |
> |
st := sBaseName + IntToStr(j); |
1834 |
|
end; |
1835 |
< |
Inc(aliasname_length, j_len); |
1836 |
< |
AddName(strpas(aliasname), i); |
1835 |
> |
|
1836 |
> |
FXSQLVARs[i].FName := st; |
1837 |
|
end; |
1838 |
+ |
|
1839 |
+ |
{Finally initialise the XSQLVAR} |
1840 |
+ |
|
1841 |
+ |
FXSQLVARs[i].FIndex := i; |
1842 |
+ |
|
1843 |
|
case sqltype and (not 1) of |
1844 |
|
SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP, |
1845 |
< |
SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, |
1845 |
> |
SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN, |
1846 |
|
SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin |
1847 |
|
if (sqllen = 0) then |
1848 |
|
{ Make sure you get a valid pointer anyway |
1872 |
|
i, OldSize: Integer; |
1873 |
|
p : PXSQLVAR; |
1874 |
|
begin |
1579 |
– |
FNames.Clear; |
1875 |
|
FCount := Value; |
1876 |
|
if FCount = 0 then |
1877 |
|
FUniqueRelationName := '' |
2212 |
|
|
2213 |
|
{ TIBSQL } |
2214 |
|
constructor TIBSQL.Create(AOwner: TComponent); |
2215 |
+ |
var GUID : TGUID; |
2216 |
|
begin |
2217 |
|
inherited Create(AOwner); |
2218 |
|
FIBLoaded := False; |
2229 |
|
FRecordCount := 0; |
2230 |
|
FSQL := TStringList.Create; |
2231 |
|
TStringList(FSQL).OnChanging := SQLChanging; |
2232 |
+ |
TStringList(FSQL).OnChange := SQLChanged; |
2233 |
|
FProcessedSQL := TStringList.Create; |
2234 |
|
FHandle := nil; |
2235 |
< |
FSQLParams := TIBXSQLDA.Create(self); |
2236 |
< |
FSQLRecord := TIBXSQLDA.Create(self); |
2235 |
> |
FSQLParams := TIBXSQLDA.Create(self,daInput); |
2236 |
> |
FSQLRecord := TIBXSQLDA.Create(self,daOutput); |
2237 |
|
FSQLType := SQLUnknown; |
2238 |
|
FParamCheck := True; |
2239 |
< |
FCursor := Name + RandomString(8); |
2239 |
> |
CreateGuid(GUID); |
2240 |
> |
FCursor := GUIDToString(GUID); |
2241 |
|
if AOwner is TIBDatabase then |
2242 |
|
Database := TIBDatabase(AOwner) |
2243 |
|
else |
2352 |
|
Result := FSQLRecord.Count |
2353 |
|
end; |
2354 |
|
|
2355 |
+ |
procedure TIBSQL.SetUniqueParamNames(AValue: Boolean); |
2356 |
+ |
begin |
2357 |
+ |
if FUniqueParamNames = AValue then Exit; |
2358 |
+ |
FreeHandle; |
2359 |
+ |
FUniqueParamNames := AValue; |
2360 |
+ |
end; |
2361 |
+ |
|
2362 |
|
procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject); |
2363 |
|
begin |
2364 |
|
if (FHandle <> nil) then begin |
2389 |
|
FBOF := True; |
2390 |
|
FEOF := False; |
2391 |
|
FRecordCount := 0; |
2392 |
+ |
if not (csDesigning in ComponentState) then |
2393 |
+ |
MonitorHook.SQLExecute(Self); |
2394 |
|
if FGoToFirstRecordOnExecute then |
2395 |
|
Next; |
2396 |
|
end; |
2400 |
|
@FHandle, |
2401 |
|
Database.SQLDialect, |
2402 |
|
FSQLParams.AsXSQLDA, |
2403 |
< |
FSQLRecord.AsXSQLDA), False); |
2404 |
< |
if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then |
2403 |
> |
FSQLRecord.AsXSQLDA), True); |
2404 |
> |
if not (csDesigning in ComponentState) then |
2405 |
> |
MonitorHook.SQLExecute(Self); |
2406 |
> |
(* if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then |
2407 |
|
begin |
2408 |
|
{ Sometimes a prepared stored procedure appears to get |
2409 |
|
off sync on the server ....This code is meant to try |
2418 |
|
Database.SQLDialect, |
2419 |
|
FSQLParams.AsXSQLDA, |
2420 |
|
FSQLRecord.AsXSQLDA), True); |
2421 |
< |
end; |
2421 |
> |
end; *) |
2422 |
|
end |
2423 |
|
else |
2424 |
|
Call(isc_dsql_execute(StatusVector, |
2425 |
|
TRHandle, |
2426 |
|
@FHandle, |
2427 |
|
Database.SQLDialect, |
2428 |
< |
FSQLParams.AsXSQLDA), True) |
2428 |
> |
FSQLParams.AsXSQLDA), True); |
2429 |
> |
if not (csDesigning in ComponentState) then |
2430 |
> |
MonitorHook.SQLExecute(Self); |
2431 |
|
end; |
2432 |
< |
if not (csDesigning in ComponentState) then |
2433 |
< |
MonitorHook.SQLExecute(Self); |
2432 |
> |
FBase.DoAfterExecQuery(self); |
2433 |
> |
// writeln('Rows Affected = ',RowsAffected); |
2434 |
|
end; |
2435 |
|
|
2436 |
|
function TIBSQL.GetEOF: Boolean; |
2542 |
|
SQLUpdate, SQLDelete])) then |
2543 |
|
result := '' |
2544 |
|
else begin |
2545 |
< |
info_request := Char(isc_info_sql_get_plan); |
2545 |
> |
info_request := isc_info_sql_get_plan; |
2546 |
|
Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request, |
2547 |
|
SizeOf(result_buffer), result_buffer), True); |
2548 |
< |
if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then |
2548 |
> |
if (result_buffer[0] <> isc_info_sql_get_plan) then |
2549 |
|
IBError(ibxeUnknownError, [nil]); |
2550 |
|
result_length := isc_vax_integer(@result_buffer[1], 2); |
2551 |
|
SetString(result, nil, result_length); |
2560 |
|
result := FRecordCount; |
2561 |
|
end; |
2562 |
|
|
2563 |
< |
function TIBSQL.GetRowsAffected: integer; |
2563 |
> |
function TIBSQL.GetRowsAffected: Integer; |
2564 |
|
var |
2254 |
– |
result_buffer: array[0..1048] of Char; |
2565 |
|
info_request: Char; |
2566 |
+ |
RB: TResultBuffer; |
2567 |
|
begin |
2568 |
|
if not Prepared then |
2569 |
|
result := -1 |
2570 |
|
else begin |
2571 |
< |
info_request := Char(isc_info_sql_records); |
2572 |
< |
if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request, |
2573 |
< |
SizeOf(result_buffer), result_buffer) > 0 then |
2574 |
< |
IBDatabaseError; |
2575 |
< |
if (result_buffer[0] <> Char(isc_info_sql_records)) then |
2576 |
< |
result := -1 |
2577 |
< |
else |
2578 |
< |
case SQLType of |
2579 |
< |
SQLUpdate: Result := isc_vax_integer(@result_buffer[6], 4); |
2580 |
< |
SQLDelete: Result := isc_vax_integer(@result_buffer[13], 4); |
2581 |
< |
SQLInsert: Result := isc_vax_integer(@result_buffer[27], 4); |
2582 |
< |
else Result := -1 ; |
2583 |
< |
end ; |
2571 |
> |
RB := TResultBuffer.Create; |
2572 |
> |
try |
2573 |
> |
info_request := isc_info_sql_records; |
2574 |
> |
if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request, |
2575 |
> |
RB.Size, RB.buffer) > 0 then |
2576 |
> |
IBDatabaseError; |
2577 |
> |
case SQLType of |
2578 |
> |
SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update} |
2579 |
> |
Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+ |
2580 |
> |
RB.GetValue(isc_info_sql_records, isc_info_req_update_count); |
2581 |
> |
SQLDelete: |
2582 |
> |
Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count); |
2583 |
> |
SQLExecProcedure: |
2584 |
> |
Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) + |
2585 |
> |
RB.GetValue(isc_info_sql_records, isc_info_req_update_count) + |
2586 |
> |
RB.GetValue(isc_info_sql_records, isc_info_req_delete_count); |
2587 |
> |
else |
2588 |
> |
Result := 0; |
2589 |
> |
end; |
2590 |
> |
finally |
2591 |
> |
RB.Free; |
2592 |
> |
end; |
2593 |
|
end; |
2594 |
|
end; |
2595 |
|
|
2620 |
|
cCurChar, cNextChar, cQuoteChar: Char; |
2621 |
|
sSQL, sProcessedSQL, sParamName: String; |
2622 |
|
i, iLenSQL, iSQLPos: Integer; |
2623 |
< |
iCurState, iCurParamState: Integer; |
2623 |
> |
iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer; |
2624 |
|
iParamSuffix: Integer; |
2625 |
|
slNames: TStrings; |
2626 |
|
|
2629 |
|
CommentState = 1; |
2630 |
|
QuoteState = 2; |
2631 |
|
ParamState = 3; |
2632 |
+ |
{$ifdef ALLOWDIALECT3PARAMNAMES} |
2633 |
|
ParamDefaultState = 0; |
2634 |
|
ParamQuoteState = 1; |
2635 |
+ |
{$endif} |
2636 |
|
|
2637 |
|
procedure AddToProcessedSQL(cChar: Char); |
2638 |
|
begin |
2641 |
|
end; |
2642 |
|
|
2643 |
|
begin |
2644 |
+ |
sParamName := ''; |
2645 |
|
slNames := TStringList.Create; |
2646 |
|
try |
2647 |
|
{ Do some initializations of variables } |
2653 |
|
i := 1; |
2654 |
|
iSQLPos := 1; |
2655 |
|
iCurState := DefaultState; |
2656 |
+ |
{$ifdef ALLOWDIALECT3PARAMNAMES} |
2657 |
|
iCurParamState := ParamDefaultState; |
2658 |
+ |
{$endif} |
2659 |
|
{ Now, traverse through the SQL string, character by character, |
2660 |
|
picking out the parameters and formatting correctly for InterBase } |
2661 |
|
while (i <= iLenSQL) do begin |
2706 |
|
ParamState: |
2707 |
|
begin |
2708 |
|
{ collect the name of the parameter } |
2709 |
+ |
{$ifdef ALLOWDIALECT3PARAMNAMES} |
2710 |
|
if iCurParamState = ParamDefaultState then |
2711 |
|
begin |
2712 |
|
if cCurChar = '"' then |
2713 |
|
iCurParamState := ParamQuoteState |
2714 |
< |
else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then |
2714 |
> |
else |
2715 |
> |
{$endif} |
2716 |
> |
if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then |
2717 |
|
sParamName := sParamName + cCurChar |
2718 |
|
else if FGenerateParamNames then |
2719 |
|
begin |
2720 |
|
sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize} |
2721 |
|
Inc(iParamSuffix); |
2722 |
|
iCurState := DefaultState; |
2723 |
< |
slNames.Add(sParamName); |
2723 |
> |
slNames.AddObject(sParamName,self); //Note local convention |
2724 |
> |
//add pointer to self to mark entry |
2725 |
|
sParamName := ''; |
2726 |
|
end |
2727 |
|
else |
2728 |
|
IBError(ibxeSQLParseError, [SParamNameExpected]); |
2729 |
+ |
{$ifdef ALLOWDIALECT3PARAMNAMES} |
2730 |
|
end |
2731 |
|
else begin |
2732 |
|
{ determine if Quoted parameter name is finished } |
2741 |
|
else |
2742 |
|
sParamName := sParamName + cCurChar |
2743 |
|
end; |
2744 |
+ |
{$endif} |
2745 |
|
{ determine if the unquoted parameter name is finished } |
2746 |
< |
if (iCurParamState <> ParamQuoteState) and |
2746 |
> |
if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif} |
2747 |
|
(iCurState <> DefaultState) then |
2748 |
|
begin |
2749 |
|
if not (cNextChar in ['A'..'Z', 'a'..'z', |
2763 |
|
AddToProcessedSQL(#0); |
2764 |
|
FSQLParams.Count := slNames.Count; |
2765 |
|
for i := 0 to slNames.Count - 1 do |
2766 |
< |
FSQLParams.AddName(slNames[i], i); |
2766 |
> |
FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil)); |
2767 |
|
FProcessedSQL.Text := sProcessedSQL; |
2768 |
|
finally |
2769 |
|
slNames.Free; |
2802 |
|
{ After preparing the statement, query the stmt type and possibly |
2803 |
|
create a FSQLRecord "holder" } |
2804 |
|
{ Get the type of the statement } |
2805 |
< |
type_item := Char(isc_info_sql_stmt_type); |
2805 |
> |
type_item := isc_info_sql_stmt_type; |
2806 |
|
Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item, |
2807 |
|
SizeOf(res_buffer), res_buffer), True); |
2808 |
< |
if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then |
2808 |
> |
if (res_buffer[0] <> isc_info_sql_stmt_type) then |
2809 |
|
IBError(ibxeUnknownError, [nil]); |
2810 |
|
stmt_len := isc_vax_integer(@res_buffer[1], 2); |
2811 |
|
FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len)); |
2850 |
|
on E: Exception do begin |
2851 |
|
if (FHandle <> nil) then |
2852 |
|
FreeHandle; |
2853 |
< |
raise; |
2853 |
> |
if E is EIBInterBaseError then |
2854 |
> |
raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode, |
2855 |
> |
EIBInterBaseError(E).IBErrorCode, |
2856 |
> |
EIBInterBaseError(E).Message + |
2857 |
> |
sSQLErrorSeparator + FProcessedSQL.Text) |
2858 |
> |
else |
2859 |
> |
raise; |
2860 |
|
end; |
2861 |
|
end; |
2862 |
|
end; |
2894 |
|
if FHandle <> nil then FreeHandle; |
2895 |
|
end; |
2896 |
|
|
2897 |
< |
procedure TIBSQL.BeforeTransactionEnd(Sender: TObject); |
2897 |
> |
procedure TIBSQL.SQLChanged(Sender: TObject); |
2898 |
> |
begin |
2899 |
> |
if assigned(OnSQLChanged) then |
2900 |
> |
OnSQLChanged(self); |
2901 |
> |
end; |
2902 |
> |
|
2903 |
> |
procedure TIBSQL.BeforeTransactionEnd(Sender: TObject; |
2904 |
> |
Action: TTransactionAction); |
2905 |
|
begin |
2906 |
|
if (FOpen) then |
2907 |
|
Close; |