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: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 5187 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# Content
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
29 {$IFDEF FPC}
30 {$mode objfpc}{$H+}
31 {$codepage UTF8}
32 {$interfaces COM}
33 {$ENDIF}
34
35 interface
36
37 uses
38 Classes, SysUtils, IB, FBArray, IBHeader, FB25Statement, FB25Attachment, FBClientAPI,
39 FB25Transaction;
40
41 type
42
43 { TFB25ArrayMetaData }
44
45 TFB25ArrayMetaData = class(TFBArrayMetaData,IArrayMetaData)
46 private
47 FCharSetID: integer;
48 FCodePage: TSystemCodePage;
49 protected
50 procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
51 relationName, columnName: string); override;
52 public
53 function GetCharSetID: cardinal; override;
54 function GetCodePage: TSystemCodePage; override;
55 end;
56
57 { TFB25Array }
58
59 TFB25Array = class(TFBArray,IArray)
60 private
61 FDBHandle: TISC_DB_HANDLE;
62 FTRHandle: TISC_TR_HANDLE;
63 protected
64 procedure InternalGetSlice; override;
65 procedure InternalPutSlice(Force: boolean); override;
66 public
67 constructor Create(aAttachment: TFB25Attachment; aTransaction: TFB25Transaction; aField: IArrayMetaData); overload;
68 constructor Create(aAttachment: TFB25Attachment; aTransaction: TFB25Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
69 end;
70
71 implementation
72
73 uses FB25ClientAPI;
74
75 const
76 sGetArrayMetaData = 'Select F.RDB$CHARACTER_SET_ID '+
77 'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS RF '+
78 'On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
79 'Where RF.RDB$RELATION_NAME = ? and RF.RDB$FIELD_NAME = ?';
80
81 { TFB25ArrayMetaData }
82
83 procedure TFB25ArrayMetaData.LoadMetaData(aAttachment: IAttachment;
84 aTransaction: ITransaction; relationName, columnName: string);
85 var
86 DBHandle: TISC_DB_HANDLE;
87 TRHandle: TISC_TR_HANDLE;
88 stmt: IStatement;
89 begin
90 DBHandle := (aAttachment as TFB25Attachment).Handle;
91 TRHandle := (aTransaction as TFB25Transaction).Handle;
92 with Firebird25ClientAPI do
93 if isc_array_lookup_bounds(StatusVector,@(DBHandle),@(TRHandle),
94 PChar(AnsiUpperCase(relationName)),PChar(AnsiUpperCase(columnName)),@FArrayDesc) > 0 then
95 IBDatabaseError;
96
97 if (GetSQLType = SQL_TEXT) or (GetSQLType = SQL_VARYING) then
98 begin
99 stmt := TFB25Statement.Create(aAttachment as TFB25Attachment,aTransaction,
100 sGetArrayMetaData ,aAttachment.GetSQLDialect);
101 with stmt do
102 begin
103 SQLParams[0].AsString := RelationName;
104 SQLParams[1].AsString := ColumnName;
105 with OpenCursor do
106 if FetchNext then
107 begin
108 FCharSetID := Data[0].AsInteger;
109 with (aAttachment as TFB25Attachment) do
110 if (FCharSetID > 1) and HasDefaultCharSet then
111 begin
112 FCharSetID := CharSetID;
113 FCodePage := CodePage;
114 end
115 else
116 begin
117 FCodePage := CP_NONE;
118 FirebirdClientAPI.CharSetID2CodePage(FCharSetID,FCodePage);
119 end;
120 end;
121 end;
122 end;
123 end;
124
125 function TFB25ArrayMetaData.GetCharSetID: cardinal;
126 begin
127 Result := FCharSetID;
128 end;
129
130 function TFB25ArrayMetaData.GetCodePage: TSystemCodePage;
131 begin
132 Result := FCodePage;
133 end;
134
135 { TFB25Array }
136
137 procedure TFB25Array.InternalGetSlice;
138 begin
139 with Firebird25ClientAPI do
140 Call(isc_array_get_slice(StatusVector,@(FDBHandle),@(FTRHandle),
141 @FArrayID, GetArrayDesc,
142 Pointer(FBuffer), @FBufSize));
143 end;
144
145 procedure TFB25Array.InternalPutSlice(Force: boolean);
146 begin
147 with Firebird25ClientAPI do
148 if (isc_array_put_slice(StatusVector, @(FDBHandle),@(FTRHandle),
149 @FArrayID, GetArrayDesc,
150 Pointer(FBuffer),@FBufSize) > 0) and not Force then
151 IBDatabaseError;
152 SignalActivity;
153 end;
154
155 constructor TFB25Array.Create(aAttachment: TFB25Attachment;
156 aTransaction: TFB25Transaction; aField: IArrayMetaData);
157 begin
158 inherited Create(aAttachment,aTransaction,aField);
159 FDBHandle := aAttachment.Handle;
160 FTRHandle := aTransaction.Handle;
161 end;
162
163 constructor TFB25Array.Create(aAttachment: TFB25Attachment;
164 aTransaction: TFB25Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD);
165 begin
166 inherited Create(aAttachment,aTransaction,aField,ArrayID);
167 FDBHandle := aAttachment.Handle;
168 FTRHandle := aTransaction.Handle;
169 end;
170
171 end.
172