ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/2.5/FB25Array.pas
Revision: 113
Committed: Thu Jan 18 14:37:59 2018 UTC (2 years, 1 month ago) by tony
File size: 6123 byte(s)
Log Message:
Fixes Merged
Line File contents
1 (*
2 * Firebird Interface (fbintf). The fbintf components provide a set of
3 * Pascal language bindings for the Firebird API.
4 *
5 * The contents of this file are subject to the Initial Developer's
6 * Public License Version 1.0 (the "License"); you may not use this
7 * file except in compliance with the License. You may obtain a copy
8 * of the License here:
9 *
10 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11 *
12 * Software distributed under the License is distributed on an "AS
13 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14 * implied. See the License for the specific language governing rights
15 * and limitations under the License.
16 *
17 * The Initial Developer of the Original Code is Tony Whyman.
18 *
19 * The Original Code is (C) 2016 Tony Whyman, MWA Software
20 * (http://www.mwasoftware.co.uk).
21 *
22 * All Rights Reserved.
23 *
24 * Contributor(s): ______________________________________.
25 *
26 *)
27 unit FB25Array;
28 {$IFDEF MSWINDOWS}
29 {$DEFINE WINDOWS}
30 {$ENDIF}
31
32 {$IFDEF FPC}
33 {$mode delphi}
34 {$codepage UTF8}
35 {$interfaces COM}
36 {$ENDIF}
37
38 interface
39
40 uses
41 Classes, SysUtils, IB, FBArray, IBHeader, FB25Statement, FB25Attachment, FBClientAPI,
42 FB25Transaction;
43
44 type
45
46 { TFB25ArrayMetaData }
47
48 TFB25ArrayMetaData = class(TFBArrayMetaData,IArrayMetaData)
49 private
50 FCodePage: TSystemCodePage;
51 protected
52 procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
53 relationName, columnName: AnsiString); override;
54 public
55 function GetCharSetID: cardinal; override;
56 function GetCodePage: TSystemCodePage; override;
57 end;
58
59 { TFB25Array }
60
61 TFB25Array = class(TFBArray,IArray)
62 private
63 FDBHandle: TISC_DB_HANDLE;
64 FTRHandle: TISC_TR_HANDLE;
65 protected
66 procedure InternalGetSlice; override;
67 procedure InternalPutSlice(Force: boolean); override;
68 public
69 constructor Create(aAttachment: TFB25Attachment; aTransaction: TFB25Transaction; aField: IArrayMetaData); overload;
70 constructor Create(aAttachment: TFB25Attachment; aTransaction: TFB25Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
71 end;
72
73 implementation
74
75 uses FBAttachment, FB25ClientAPI;
76
77 const
78 sGetArrayMetaData = 'Select F.RDB$CHARACTER_SET_ID '+
79 'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS RF '+
80 'On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
81 'Where RF.RDB$RELATION_NAME = ? and RF.RDB$FIELD_NAME = ? '+
82 'UNION '+
83 'Select F.RDB$CHARACTER_SET_ID '+
84 'From RDB$FIELDS F JOIN RDB$PROCEDURE_PARAMETERS PP '+
85 'On F.RDB$FIELD_NAME = PP.RDB$FIELD_SOURCE '+
86 'Where PP.RDB$PROCEDURE_NAME = ? and PP.RDB$PARAMETER_NAME = ?';
87
88 { TFB25ArrayMetaData }
89
90 procedure TFB25ArrayMetaData.LoadMetaData(aAttachment: IAttachment;
91 aTransaction: ITransaction; relationName, columnName: AnsiString);
92 var
93 DBHandle: TISC_DB_HANDLE;
94 TRHandle: TISC_TR_HANDLE;
95 stmt: IStatement;
96 CharWidth: integer;
97 RelName: AnsiString;
98 ColName: AnsiString;
99 begin
100 DBHandle := (aAttachment as TFB25Attachment).Handle;
101 TRHandle := (aTransaction as TFB25Transaction).Handle;
102 RelName := AnsiUpperCase(relationName);
103 ColName := AnsiUpperCase(columnName);
104 with Firebird25ClientAPI do
105 if isc_array_lookup_bounds(StatusVector,@(DBHandle),@(TRHandle),
106 PAnsiChar(RelName),PAnsiChar(ColName),@FArrayDesc) > 0 then
107 IBDatabaseError;
108
109 if (GetSQLType = SQL_TEXT) or (GetSQLType = SQL_VARYING) then
110 begin
111 stmt := TFB25Statement.Create(aAttachment as TFB25Attachment,aTransaction,
112 sGetArrayMetaData ,aAttachment.GetSQLDialect);
113 with stmt do
114 begin
115 SQLParams[0].AsString := RelationName;
116 SQLParams[1].AsString := ColumnName;
117 SQLParams[2].AsString := RelationName;
118 SQLParams[3].AsString := ColumnName;
119 with OpenCursor do
120 if FetchNext then
121 begin
122 FCharSetID := Data[0].AsInteger;
123 with (aAttachment as TFB25Attachment) do
124 if (FCharSetID > 1) and HasDefaultCharSet then
125 begin
126 FCharSetID := CharSetID;
127 FCodePage := CodePage;
128 end
129 else
130 begin
131 FCodePage := CP_NONE;
132 FAttachment.CharSetID2CodePage(FCharSetID,FCodePage);
133 end;
134 end;
135 end;
136 end;
137 if (FArrayDesc.array_desc_dtype in [blr_text,blr_cstring, blr_varying]) and
138 (FCharSetID = 0) then {This really shouldn't be necessary - but it is :(}
139 with aAttachment as TFBAttachment do
140 begin
141 if HasDefaultCharSet and FAttachment.CharSetWidth(CharSetID,CharWidth) then
142 FArrayDesc.array_desc_length := FArrayDesc.array_desc_length * CharWidth;
143 end;
144 end;
145
146 function TFB25ArrayMetaData.GetCharSetID: cardinal;
147 begin
148 Result := FCharSetID;
149 end;
150
151 function TFB25ArrayMetaData.GetCodePage: TSystemCodePage;
152 begin
153 Result := FCodePage;
154 end;
155
156 { TFB25Array }
157
158 procedure TFB25Array.InternalGetSlice;
159 begin
160 with Firebird25ClientAPI do
161 Call(isc_array_get_slice(StatusVector,@(FDBHandle),@(FTRHandle),
162 @FArrayID, GetArrayDesc,
163 Pointer(FBuffer), @FBufSize));
164 end;
165
166 procedure TFB25Array.InternalPutSlice(Force: boolean);
167 begin
168 with Firebird25ClientAPI do
169 if (isc_array_put_slice(StatusVector, @(FDBHandle),@(FTRHandle),
170 @FArrayID, GetArrayDesc,
171 Pointer(FBuffer),@FBufSize) > 0) and not Force then
172 IBDatabaseError;
173 SignalActivity;
174 end;
175
176 constructor TFB25Array.Create(aAttachment: TFB25Attachment;
177 aTransaction: TFB25Transaction; aField: IArrayMetaData);
178 begin
179 inherited Create(aAttachment,aTransaction,aField);
180 FDBHandle := aAttachment.Handle;
181 FTRHandle := aTransaction.Handle;
182 end;
183
184 constructor TFB25Array.Create(aAttachment: TFB25Attachment;
185 aTransaction: TFB25Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD);
186 begin
187 inherited Create(aAttachment,aTransaction,aField,ArrayID);
188 FDBHandle := aAttachment.Handle;
189 FTRHandle := aTransaction.Handle;
190 end;
191
192 end.
193