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: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 5546 byte(s)
Log Message:
Committing updates for Release R2-0-1

File Contents

# User Rev Content
1 tony 45 (*
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     FCodePage: TSystemCodePage;
48     protected
49     procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
50     relationName, columnName: string); override;
51     public
52     function GetCharSetID: cardinal; override;
53     function GetCodePage: TSystemCodePage; override;
54     end;
55    
56     { TFB25Array }
57    
58     TFB25Array = class(TFBArray,IArray)
59     private
60     FDBHandle: TISC_DB_HANDLE;
61     FTRHandle: TISC_TR_HANDLE;
62     protected
63     procedure InternalGetSlice; override;
64     procedure InternalPutSlice(Force: boolean); override;
65     public
66     constructor Create(aAttachment: TFB25Attachment; aTransaction: TFB25Transaction; aField: IArrayMetaData); overload;
67     constructor Create(aAttachment: TFB25Attachment; aTransaction: TFB25Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
68     end;
69    
70     implementation
71    
72 tony 47 uses FBAttachment, FB25ClientAPI;
73 tony 45
74     const
75     sGetArrayMetaData = 'Select F.RDB$CHARACTER_SET_ID '+
76     'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS RF '+
77     'On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
78     'Where RF.RDB$RELATION_NAME = ? and RF.RDB$FIELD_NAME = ?';
79    
80     { TFB25ArrayMetaData }
81    
82     procedure TFB25ArrayMetaData.LoadMetaData(aAttachment: IAttachment;
83     aTransaction: ITransaction; relationName, columnName: string);
84     var
85     DBHandle: TISC_DB_HANDLE;
86     TRHandle: TISC_TR_HANDLE;
87     stmt: IStatement;
88 tony 47 CharWidth: integer;
89 tony 45 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 tony 47 if (FArrayDesc.array_desc_dtype in [blr_text,blr_cstring, blr_varying]) and
124     (FCharSetID = 0) then {This really shouldn't be necessary - but it is :(}
125     with aAttachment as TFBAttachment do
126     begin
127     if HasDefaultCharSet and FirebirdClientAPI.CharSetWidth(CharSetID,CharWidth) then
128     FArrayDesc.array_desc_length *= CharWidth;
129     end;
130 tony 45 end;
131    
132     function TFB25ArrayMetaData.GetCharSetID: cardinal;
133     begin
134     Result := FCharSetID;
135     end;
136    
137     function TFB25ArrayMetaData.GetCodePage: TSystemCodePage;
138     begin
139     Result := FCodePage;
140     end;
141    
142     { TFB25Array }
143    
144     procedure TFB25Array.InternalGetSlice;
145     begin
146     with Firebird25ClientAPI do
147     Call(isc_array_get_slice(StatusVector,@(FDBHandle),@(FTRHandle),
148     @FArrayID, GetArrayDesc,
149     Pointer(FBuffer), @FBufSize));
150     end;
151    
152     procedure TFB25Array.InternalPutSlice(Force: boolean);
153     begin
154     with Firebird25ClientAPI do
155     if (isc_array_put_slice(StatusVector, @(FDBHandle),@(FTRHandle),
156     @FArrayID, GetArrayDesc,
157     Pointer(FBuffer),@FBufSize) > 0) and not Force then
158     IBDatabaseError;
159     SignalActivity;
160     end;
161    
162     constructor TFB25Array.Create(aAttachment: TFB25Attachment;
163     aTransaction: TFB25Transaction; aField: IArrayMetaData);
164     begin
165     inherited Create(aAttachment,aTransaction,aField);
166     FDBHandle := aAttachment.Handle;
167     FTRHandle := aTransaction.Handle;
168     end;
169    
170     constructor TFB25Array.Create(aAttachment: TFB25Attachment;
171     aTransaction: TFB25Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD);
172     begin
173     inherited Create(aAttachment,aTransaction,aField,ArrayID);
174     FDBHandle := aAttachment.Handle;
175     FTRHandle := aTransaction.Handle;
176     end;
177    
178     end.
179