1 |
(* |
2 |
* Firebird Interface (fbintf). The fbintf components provide a set of |
3 |
* Pascal language bindings for the Firebird API. Although predominantly |
4 |
* a new development they include source code taken from IBX and may be |
5 |
* considered a derived product. This software thus also includes the copyright |
6 |
* notice and license conditions from IBX. |
7 |
* |
8 |
* Except for those parts dervied from IBX, contents of this file are subject |
9 |
* to the Initial Developer's Public License Version 1.0 (the "License"); you |
10 |
* may not use this file except in compliance with the License. You may obtain a |
11 |
* copy of the License here: |
12 |
* |
13 |
* http://www.firebirdsql.org/index.php?op=doc&id=idpl |
14 |
* |
15 |
* Software distributed under the License is distributed on an "AS |
16 |
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or |
17 |
* implied. See the License for the specific language governing rights |
18 |
* and limitations under the License. |
19 |
* |
20 |
* The Initial Developer of the Original Code is Tony Whyman. |
21 |
* |
22 |
* The Original Code is (C) 2016 Tony Whyman, MWA Software |
23 |
* (http://www.mwasoftware.co.uk). |
24 |
* |
25 |
* All Rights Reserved. |
26 |
* |
27 |
* Contributor(s): ______________________________________. |
28 |
* |
29 |
*) |
30 |
unit FBBlob; |
31 |
|
32 |
{$IFDEF FPC} |
33 |
{$mode objfpc}{$H+} |
34 |
{$interfaces COM} |
35 |
{$ENDIF} |
36 |
|
37 |
interface |
38 |
|
39 |
uses |
40 |
Classes, SysUtils, IB, FBActivityMonitor, FBTransaction, FBClientAPI; |
41 |
|
42 |
type |
43 |
|
44 |
{ TFBBlobMetaData } |
45 |
|
46 |
TFBBlobMetaData = class(TActivityReporter) |
47 |
private |
48 |
FRelationName: string; |
49 |
FColumnName: string; |
50 |
protected |
51 |
FUnconfirmedCharacterSet: boolean; |
52 |
FHasSubType: boolean; |
53 |
FSubType: integer; |
54 |
FCharSetID: cardinal; |
55 |
FSegmentSize: cardinal; |
56 |
procedure NeedFullMetadata; virtual; abstract; |
57 |
procedure NeedSubType; |
58 |
public |
59 |
constructor Create(Transaction: TFBTransaction; RelationName, ColumnName: string |
60 |
); |
61 |
|
62 |
public |
63 |
{IBlobMetaData} |
64 |
function GetSubType: integer; |
65 |
function GetCharSetID: cardinal; |
66 |
function GetCodePage: TSystemCodePage; |
67 |
function GetSegmentSize: cardinal; |
68 |
function GetRelationName: string; |
69 |
function GetColumnName: string; |
70 |
function GetUnconfirmedCharacterSet: boolean; |
71 |
end; |
72 |
|
73 |
TFBBlob = class(TActivityReporter) |
74 |
private |
75 |
FMetaData: IBlobMetaData; |
76 |
FAttachment: IAttachment; |
77 |
FTransaction: ITransaction; |
78 |
FBPB: IBPB; |
79 |
FStringData: rawbytestring; |
80 |
FStringCached: boolean; |
81 |
protected |
82 |
FCreating: boolean; |
83 |
FBlobID: TISC_QUAD; |
84 |
procedure CheckReadable; virtual; abstract; |
85 |
procedure CheckWritable; virtual; abstract; |
86 |
procedure ClearStringCache; |
87 |
function GetIntf: IBlob; virtual; abstract; |
88 |
procedure InternalClose(Force: boolean); virtual; abstract; |
89 |
procedure InternalCancel(Force: boolean); virtual; abstract; |
90 |
public |
91 |
constructor Create(Attachment: IAttachment; Transaction: TFBTransaction; |
92 |
MetaData: IBlobMetaData; BPB: IBPB); overload; |
93 |
constructor Create(Attachment: IAttachment; Transaction: TFBTransaction; |
94 |
MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload; |
95 |
destructor Destroy; override; |
96 |
procedure TransactionEnding(aTransaction: TFBTransaction; Force: boolean); |
97 |
|
98 |
public |
99 |
{IBlobMetaData} |
100 |
function GetSubType: integer; |
101 |
function GetCharSetID: cardinal; |
102 |
function GetCodePage: TSystemCodePage; |
103 |
function GetSegmentSize: cardinal; |
104 |
function GetRelationName: string; |
105 |
function GetColumnName: string; |
106 |
function GetUnconfirmedCharacterSet: boolean; |
107 |
|
108 |
{IBlob} |
109 |
function GetBPB: IBPB; |
110 |
procedure Cancel; |
111 |
procedure Close; |
112 |
function GetBlobSize: Int64; |
113 |
procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64; |
114 |
var BlobType: TBlobType); virtual; abstract; |
115 |
function GetBlobID: TISC_QUAD; |
116 |
function GetBlobMode: TFBBlobMode; |
117 |
function Read(var Buffer; Count: Longint): Longint; virtual; abstract; |
118 |
function Write(const Buffer; Count: Longint): Longint; virtual; abstract; |
119 |
function LoadFromFile(Filename: string): IBlob; |
120 |
function LoadFromStream(S: TStream) : IBlob; |
121 |
function SaveToFile(Filename: string): IBlob; |
122 |
function SaveToStream(S: TStream): IBlob; |
123 |
function GetAttachment: IAttachment; |
124 |
function GetTransaction: ITransaction; |
125 |
function GetAsString: rawbytestring; |
126 |
procedure SetAsString(aValue: rawbytestring); |
127 |
function SetString(aValue: rawbytestring): IBlob; |
128 |
end; |
129 |
|
130 |
|
131 |
|
132 |
implementation |
133 |
|
134 |
uses FBMessages; |
135 |
|
136 |
{ TFBBlob } |
137 |
|
138 |
procedure TFBBlob.ClearStringCache; |
139 |
begin |
140 |
FStringData := ''; |
141 |
FStringCached := false; |
142 |
end; |
143 |
|
144 |
constructor TFBBlob.Create(Attachment: IAttachment; |
145 |
Transaction: TFBTransaction; MetaData: IBlobMetaData; BPB: IBPB); |
146 |
begin |
147 |
inherited Create(Transaction); |
148 |
FAttachment := Attachment; |
149 |
FTransaction := Transaction; |
150 |
FMetaData := MetaData; |
151 |
FBPB := BPB; |
152 |
FCreating := true; |
153 |
end; |
154 |
|
155 |
constructor TFBBlob.Create(Attachment: IAttachment; |
156 |
Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); |
157 |
begin |
158 |
Create(Attachment,Transaction,MetaData,BPB); |
159 |
FBlobID := BlobID; |
160 |
FCreating := false; |
161 |
end; |
162 |
|
163 |
destructor TFBBlob.Destroy; |
164 |
begin |
165 |
if FCreating then |
166 |
Cancel |
167 |
else |
168 |
Close; |
169 |
inherited Destroy; |
170 |
end; |
171 |
|
172 |
procedure TFBBlob.TransactionEnding(aTransaction: TFBTransaction; |
173 |
Force: boolean); |
174 |
begin |
175 |
if aTransaction <> FTransaction then |
176 |
Exit; |
177 |
if FCreating then |
178 |
InternalCancel(Force) |
179 |
else |
180 |
InternalClose(Force); |
181 |
end; |
182 |
|
183 |
function TFBBlob.GetSubType: integer; |
184 |
begin |
185 |
Result := FMetaData.GetSubType; |
186 |
end; |
187 |
|
188 |
function TFBBlob.GetCharSetID: cardinal; |
189 |
begin |
190 |
Result := FMetaData.GetCharSetID; |
191 |
end; |
192 |
|
193 |
function TFBBlob.GetCodePage: TSystemCodePage; |
194 |
begin |
195 |
Result := FMetaData.GetCodePage; |
196 |
end; |
197 |
|
198 |
function TFBBlob.GetSegmentSize: cardinal; |
199 |
begin |
200 |
Result := FMetaData.GetSegmentSize; |
201 |
end; |
202 |
|
203 |
function TFBBlob.GetRelationName: string; |
204 |
begin |
205 |
Result := FMetaData.GetRelationName; |
206 |
end; |
207 |
|
208 |
function TFBBlob.GetColumnName: string; |
209 |
begin |
210 |
Result := FMetaData.GetColumnName; |
211 |
end; |
212 |
|
213 |
function TFBBlob.GetUnconfirmedCharacterSet: boolean; |
214 |
begin |
215 |
Result := (FMetadata as TFBBlobMetadata).GetUnconfirmedCharacterSet; |
216 |
end; |
217 |
|
218 |
function TFBBlob.GetBPB: IBPB; |
219 |
begin |
220 |
Result := FBPB; |
221 |
end; |
222 |
|
223 |
procedure TFBBlob.Cancel; |
224 |
begin |
225 |
InternalCancel(false); |
226 |
end; |
227 |
|
228 |
procedure TFBBlob.Close; |
229 |
begin |
230 |
InternalClose(false); |
231 |
end; |
232 |
|
233 |
function TFBBlob.GetBlobSize: Int64; |
234 |
var NumSegments: Int64; |
235 |
MaxSegmentSize: Int64; |
236 |
BlobType: TBlobType; |
237 |
begin |
238 |
GetInfo(NumSegments,MaxSegmentSize,Result,BlobType); |
239 |
end; |
240 |
|
241 |
function TFBBlob.GetBlobID: TISC_QUAD; |
242 |
begin |
243 |
Result := FBlobID; |
244 |
end; |
245 |
|
246 |
function TFBBlob.GetBlobMode: TFBBlobMode; |
247 |
begin |
248 |
if FCreating then |
249 |
Result := fbmWrite |
250 |
else |
251 |
Result := fbmRead; |
252 |
end; |
253 |
|
254 |
function TFBBlob.LoadFromFile(Filename: string): IBlob; |
255 |
var |
256 |
Stream: TStream; |
257 |
begin |
258 |
Stream := TFileStream.Create(FileName, fmOpenRead); |
259 |
try |
260 |
Result := LoadFromStream(Stream); |
261 |
finally |
262 |
Stream.Free; |
263 |
end; |
264 |
end; |
265 |
|
266 |
const BufSize = 8 * 1024; |
267 |
|
268 |
function TFBBlob.LoadFromStream(S: TStream): IBlob; |
269 |
var Buffer: array [0..BufSize-1] of char; |
270 |
BytesRead: integer; |
271 |
begin |
272 |
CheckWritable; |
273 |
S.Position := 0; |
274 |
repeat |
275 |
BytesRead := S.Read(Buffer,BufSize); |
276 |
Write(Buffer,BytesRead); |
277 |
until BytesRead = 0; |
278 |
Close; |
279 |
Result := GetIntf; |
280 |
end; |
281 |
|
282 |
function TFBBlob.SaveToFile(Filename: string): IBlob; |
283 |
var |
284 |
Stream: TStream; |
285 |
begin |
286 |
Stream := TFileStream.Create(FileName, fmCreate); |
287 |
try |
288 |
Result := SaveToStream(Stream); |
289 |
finally |
290 |
Stream.Free; |
291 |
end; |
292 |
end; |
293 |
|
294 |
function TFBBlob.SaveToStream(S: TStream): IBlob; |
295 |
var Buffer: array [0..BufSize-1] of char; |
296 |
BytesRead: integer; |
297 |
begin |
298 |
CheckReadable; |
299 |
repeat |
300 |
BytesRead := Read(Buffer,BufSize); |
301 |
S.Write(Buffer,BytesRead); |
302 |
until BytesRead = 0; |
303 |
Close; |
304 |
Result := GetIntf; |
305 |
end; |
306 |
|
307 |
function TFBBlob.GetAttachment: IAttachment; |
308 |
begin |
309 |
Result := FAttachment; |
310 |
end; |
311 |
|
312 |
function TFBBlob.GetTransaction: ITransaction; |
313 |
begin |
314 |
Result := FTransaction; |
315 |
end; |
316 |
|
317 |
function TFBBlob.GetAsString: rawbytestring; |
318 |
var ss: TStringStream; |
319 |
begin |
320 |
if FStringCached then |
321 |
begin |
322 |
Result := FStringData; |
323 |
Exit; |
324 |
end; |
325 |
|
326 |
ss := TStringStream.Create(''); |
327 |
try |
328 |
SaveToStream(ss); |
329 |
Result := ss.DataString; |
330 |
if (GetSubType = 1) and (FBPB = nil) then |
331 |
SetCodePage(Result,GetCodePage,false); |
332 |
finally |
333 |
ss.Free; |
334 |
end; |
335 |
FStringData := Result; |
336 |
FStringCached := true; |
337 |
end; |
338 |
|
339 |
procedure TFBBlob.SetAsString(aValue: rawbytestring); |
340 |
var |
341 |
ss: TStringStream; |
342 |
begin |
343 |
{if GetUnconfirmedCharacterSet then |
344 |
IBError(ibxeNoDefaultCharacterSet,[nil]);} |
345 |
|
346 |
if (GetSubType = 1) and (StringCodePage(aValue) <> GetCodePage) and |
347 |
(GetCodePage <> CP_NONE) and (FBPB = nil) then |
348 |
SetCodePage(aValue,GetCodePage,true); |
349 |
ss := TStringStream.Create(aValue); |
350 |
try |
351 |
LoadFromStream(ss); |
352 |
finally |
353 |
ss.Free; |
354 |
end; |
355 |
FStringData := aValue; |
356 |
FStringCached := true; |
357 |
end; |
358 |
|
359 |
function TFBBlob.SetString(aValue: rawbytestring): IBlob; |
360 |
begin |
361 |
SetAsString(aValue); |
362 |
Result := GetIntf; |
363 |
end; |
364 |
|
365 |
{TFBBlobMetaData} |
366 |
|
367 |
procedure TFBBlobMetaData.NeedSubType; |
368 |
begin |
369 |
if not FHasSubType then |
370 |
begin |
371 |
NeedFullMetadata; |
372 |
FHasSubType := true; |
373 |
end; |
374 |
end; |
375 |
|
376 |
constructor TFBBlobMetaData.Create(Transaction: TFBTransaction; RelationName, |
377 |
ColumnName: string); |
378 |
begin |
379 |
inherited Create(Transaction); |
380 |
// if (RelationName = '') or (ColumnName = '') then |
381 |
// IBError(ibxeMissingColumnName,[]); |
382 |
FRelationName := RelationName; |
383 |
FColumnName := ColumnName; |
384 |
FSegmentSize := 80; |
385 |
end; |
386 |
|
387 |
function TFBBlobMetaData.GetSubType: integer; |
388 |
begin |
389 |
NeedSubType; |
390 |
Result := FSubType; |
391 |
end; |
392 |
|
393 |
function TFBBlobMetaData.GetCharSetID: cardinal; |
394 |
begin |
395 |
NeedFullMetadata; |
396 |
Result := FCharSetID; |
397 |
end; |
398 |
|
399 |
function TFBBlobMetaData.GetCodePage: TSystemCodePage; |
400 |
begin |
401 |
FirebirdClientAPI.CharSetID2CodePage(GetCharSetID,Result); |
402 |
end; |
403 |
|
404 |
function TFBBlobMetaData.GetSegmentSize: cardinal; |
405 |
begin |
406 |
NeedFullMetadata; |
407 |
Result := FSegmentSize; |
408 |
end; |
409 |
|
410 |
function TFBBlobMetaData.GetRelationName: string; |
411 |
begin |
412 |
Result := FRelationName; |
413 |
end; |
414 |
|
415 |
function TFBBlobMetaData.GetColumnName: string; |
416 |
begin |
417 |
Result := FColumnName; |
418 |
end; |
419 |
|
420 |
function TFBBlobMetaData.GetUnconfirmedCharacterSet: boolean; |
421 |
begin |
422 |
NeedFullMetadata; |
423 |
Result := FUnconfirmedCharacterSet; |
424 |
end; |
425 |
|
426 |
|
427 |
end. |
428 |
|