ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBBlob.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBBlob.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 41 by tony, Sat Jul 16 12:25:48 2016 UTC

# Line 24 | Line 24
24   {       Corporation. All Rights Reserved.                                }
25   {    Contributor(s): Jeff Overcash                                       }
26   {                                                                        }
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                                                 }
31   {************************************************************************}
32  
33   unit IBBlob;
34  
35 + {$mode Delphi}
36 +
37   interface
38  
39   uses
40 <  Windows, SysUtils, Classes, Forms, IBHeader, IBErrorCodes, IBExternals,
41 <  DB, IB, IBDatabase, IBUtils;
40 >  SysUtils, Classes, IBHeader, IBErrorCodes, IBExternals, DB, IB, IBDatabase;
41 >
42  
43   const
44 <  DefaultBlobSegmentSize = 16 * 1024;
44 >  DefaultBlobSegmentSize = 16 * 1024;
45  
46   type
47 +  TIBBlobStates = (bsUninitialised, bsDataPending, bsData, bsModified);
48 +
49    { TIBBlobStream }
50    TIBBlobStream = class(TStream)
51    private
52      FBase: TIBBase;
53      FBlobID: TISC_QUAD;
54 <    FBlobMaxSegmentSize,
55 <    FBlobNumSegments,
56 <    FBlobSize: Long;
54 >    FBlobMaxSegmentSize: Int64;
55 >    FBlobNumSegments: Int64;
56 >    FBlobSize: Int64;
57      FBlobType: Short;  { 0 = segmented, 1 = streamed }
58      FBuffer: PChar;
51 –    FBlobInitialized: Boolean;
59      FHandle: TISC_BLOB_HANDLE;
60      FMode: TBlobStreamMode;
61 <    FModified: Boolean;
62 <    FPosition: Long;
61 >    FPosition: Int64;
62 >    FBlobState: TIBBlobStates;
63 >    function GetModified: Boolean;
64    protected
65      procedure CloseBlob;
66      procedure CreateBlob;
67      procedure EnsureBlobInitialized;
68 +    procedure EnsureLoaded;
69      procedure GetBlobInfo;
70 +    function  GetSize: Int64; override;
71      function GetDatabase: TIBDatabase;
72      function GetDBHandle: PISC_DB_HANDLE;
73      function GetTransaction: TIBTransaction;
# Line 66 | Line 76 | type
76      procedure SetBlobID(Value: TISC_QUAD);
77      procedure SetDatabase(Value: TIBDatabase);
78      procedure SetMode(Value: TBlobStreamMode);
79 +    procedure SetState(aValue: TIBBlobStates);
80      procedure SetTransaction(Value: TIBTransaction);
81    public
82      constructor Create;
# Line 79 | Line 90 | type
90      function Read(var Buffer; Count: Longint): Longint; override;
91      procedure SaveToFile(Filename: string);
92      procedure SaveToStream(Stream: TStream);
93 <    function Seek(Offset: Longint; Origin: Word): Longint; override;
94 <    procedure SetSize(NewSize: Long); override;
93 >    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
94 >    procedure SetSize(const NewSize: Int64); override;
95 >    procedure SetSize(NewSize: Longint); override;
96      procedure Truncate;
97      function Write(const Buffer; Count: Longint): Longint; override;
98      property Handle: TISC_BLOB_HANDLE read FHandle;
99      property BlobID: TISC_QUAD read FBlobID write SetBlobID;
100 <    property BlobMaxSegmentSize: Long read FBlobMaxSegmentSize;
101 <    property BlobNumSegments: Long read FBlobNumSegments;
102 <    property BlobSize: Long read FBlobSize;
100 >    property BlobMaxSegmentSize: Int64 read FBlobMaxSegmentSize;
101 >    property BlobNumSegments: Int64 read FBlobNumSegments;
102 >    property BlobSize: Int64 read GetSize;
103      property BlobType: Short read FBlobType;
104      property Database: TIBDatabase read GetDatabase write SetDatabase;
105      property DBHandle: PISC_DB_HANDLE read GetDBHandle;
106      property Mode: TBlobStreamMode read FMode write SetMode;
107 <    property Modified: Boolean read FModified;
107 >    property Modified: Boolean read GetModified;
108      property Transaction: TIBTransaction read GetTransaction write SetTransaction;
109      property TRHandle: PISC_TR_HANDLE read GetTRHandle;
110    end;
111  
112 <  procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments, MaxSegmentSize,
113 <                       TotalSize: Long; var BlobType: Short);
114 <  procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
115 <  procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
112 >  procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
113 >                      TotalSize: Int64; var BlobType: Short);
114 >  function GetBlobCharSetID(hDB_Handle: TISC_DB_HANDLE; hTR_Handle: TISC_TR_HANDLE;
115 >                      tableName, columnName: PChar): short;
116 >  procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
117 >  procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
118  
119   implementation
120  
121 < uses IBIntf, IBCustomDataSet;
121 > uses IBIntf;
122  
123 < procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments, MaxSegmentSize,
124 <                      TotalSize: Long; var BlobType: Short);
123 > procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
124 >                      TotalSize: Int64; var BlobType: Short);
125   var
126    items: array[0..3] of Char;
127    results: array[0..99] of Char;
# Line 130 | Line 144 | begin
144      item_length := isc_vax_integer(@results[i], 2); Inc(i, 2);
145      case item of
146        isc_info_blob_num_segments:
147 <        NumSegments := isc_vax_integer(@results[i], item_length);
147 >        NumSegments := isc_portable_integer(@results[i], item_length);
148        isc_info_blob_max_segment:
149 <        MaxSegmentSize := isc_vax_integer(@results[i], item_length);
149 >        MaxSegmentSize := isc_portable_integer(@results[i], item_length);
150        isc_info_blob_total_length:
151 <        TotalSize := isc_vax_integer(@results[i], item_length);
151 >        TotalSize := isc_portable_integer(@results[i], item_length);
152        isc_info_blob_type:
153 <        BlobType := isc_vax_integer(@results[i], item_length);
153 >        BlobType := isc_portable_integer(@results[i], item_length);
154      end;
155      Inc(i, item_length);
156    end;
157   end;
158  
159 < procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
159 > function GetBlobCharSetID(hDB_Handle: TISC_DB_HANDLE;
160 >  hTR_Handle: TISC_TR_HANDLE; tableName, columnName: PChar): short;
161 > var desc: TISC_BLOB_DESC;
162 >    uGlobal: array [0..31] of char;
163 > begin
164 >  if isc_blob_lookup_desc(StatusVector,@hDB_Handle,@hTR_Handle,
165 >                tableName,columnName,@desc,@uGlobal) > 0 then
166 >    IBDatabaseError;
167 >
168 >  Result := desc.blob_desc_charset;
169 > end;
170 >
171 > procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
172   var
173 <  CurPos: Long;
173 >  CurPos: Int64;
174    BytesRead, SegLen: UShort;
175    LocalBuffer: PChar;
176   begin
# Line 166 | Line 192 | begin
192   end;
193  
194   procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar;
195 <  BlobSize: Long);
195 >  BlobSize: Int64);
196   var
197 <  CurPos, SegLen: Long;
197 >  CurPos: Int64;
198 >  SegLen: Long;
199   begin
200    CurPos := 0;
201    SegLen := DefaultBlobSegmentSize;
# Line 191 | Line 218 | begin
218    FBase := TIBBase.Create(Self);
219    FBuffer := nil;
220    FBlobSize := 0;
221 +  FBlobState := bsUninitialised;
222   end;
223  
224   destructor TIBBlobStream.Destroy;
225   begin
226 <  if (FHandle <> nil) and
199 <     (Call(isc_close_blob(StatusVector, @FHandle), False) > 0) then
200 <    IBDataBaseError;
226 >  SetState(bsUninitialised);
227    FBase.Free;
228    SetSize(0);
229    inherited Destroy;
# Line 222 | Line 248 | begin
248    if FMode = bmRead then IBError(ibxeBlobCannotBeWritten, [nil]);
249   end;
250  
251 + function TIBBlobStream.GetModified: Boolean;
252 + begin
253 +  Result := FBlobState = bsModified;
254 + end;
255 +
256   procedure TIBBlobStream.CloseBlob;
257   begin
258    Finalize;
259 <  if (FHandle <> nil) and
229 <     (Call(isc_close_blob(StatusVector, @FHandle), False) > 0) then
230 <    IBDataBaseError;
259 >  SetState(bsUninitialised);
260   end;
261  
262   procedure TIBBlobStream.CreateBlob;
# Line 235 | Line 264 | begin
264    CheckWritable;
265    FBlobID.gds_quad_high := 0;
266    FBlobID.gds_quad_low := 0;
267 <  Truncate;
267 >  SetState(bsData);
268 >  SetSize(0);
269   end;
270  
271   procedure TIBBlobStream.EnsureBlobInitialized;
272   begin
273 <  if not FBlobInitialized then
273 >  if FBlobState = bsUninitialised then
274      case FMode of
275        bmWrite:
276          CreateBlob;
# Line 254 | Line 284 | begin
284        else
285          OpenBlob;
286      end;
287 <  FBlobInitialized := True;
287 > end;
288 >
289 > procedure TIBBlobStream.EnsureLoaded;
290 > begin
291 >  EnsureBlobInitialized;
292 >  if FBlobState = bsDataPending then
293 >  begin
294 >    SetSize(FBlobSize);
295 >    try
296 >      IBBlob.ReadBlob(@FHandle, FBuffer, FBlobSize);
297 >    except
298 >      Call(isc_close_blob(StatusVector, @FHandle), False);
299 >      raise;
300 >    end;
301 >    SetState(bsData);
302 >  end;
303   end;
304  
305   procedure TIBBlobStream.Finalize;
306   begin
307 <  if (not FBlobInitialized) or (FMode = bmRead) or (not FModified) then
307 >  if FBlobState <> bsModified then
308      exit;
309 <  { need to start writing to a blob, create one }
310 <  Call(isc_create_blob2(StatusVector, DBHandle, TRHandle, @FHandle, @FBlobID,
311 <                       0, nil), True);
312 <  IBBlob.WriteBlob(@FHandle, FBuffer, FBlobSize);
313 <  Call(isc_close_blob(StatusVector, @FHandle), True);
314 <  FModified := False;
309 >  if FBlobSize > 0 then
310 >  begin
311 >    { need to start writing to a blob, create one }
312 >    Call(isc_create_blob2(StatusVector, DBHandle, TRHandle, @FHandle, @FBlobID,
313 >                         0, nil), True);
314 >    IBBlob.WriteBlob(@FHandle, FBuffer, FBlobSize);
315 >    Call(isc_close_blob(StatusVector, @FHandle), True);
316 >  end
317 >  else
318 >  begin
319 >    FBlobID.gds_quad_high := 0;
320 >    FBlobID.gds_quad_low := 0;
321 >  end;
322 >  SetState(bsData);
323   end;
324  
325   procedure TIBBlobStream.GetBlobInfo;
326   var
327 <  iBlobSize: Long;
327 >  iBlobSize: Int64;
328   begin
329    IBBlob.GetBlobInfo(@FHandle, FBlobNumSegments, FBlobMaxSegmentSize,
330      iBlobSize, FBlobType);
331    SetSize(iBlobSize);
332   end;
333  
334 + function TIBBlobStream.GetSize: Int64;
335 + begin
336 +  EnsureBlobInitialized;
337 +  Result := FBlobSize;
338 + end;
339 +
340   function TIBBlobStream.GetDatabase: TIBDatabase;
341   begin
342    result := FBase.Database;
# Line 318 | Line 377 | begin
377    SetSize(Stream.Size);
378    if FBlobSize <> 0 then
379      Stream.ReadBuffer(FBuffer^, FBlobSize);
380 <  FModified := True;
380 >  SetState(bsModified);
381   end;
382  
383   procedure TIBBlobStream.OpenBlob;
# Line 328 | Line 387 | begin
387                       @FBlobID, 0, nil), True);
388    try
389      GetBlobInfo;
390 <    SetSize(FBlobSize);
332 <    IBBlob.ReadBlob(@FHandle, FBuffer, FBlobSize);
390 >    {Defer reading in blob until read method called}
391    except
392      Call(isc_close_blob(StatusVector, @FHandle), False);
393      raise;
394    end;
395 <  Call(isc_close_blob(StatusVector, @FHandle), True);
395 >  SetState(bsDataPending);
396   end;
397  
398   function TIBBlobStream.Read(var Buffer; Count: Longint): Longint;
399   begin
400    CheckReadable;
401 <  EnsureBlobInitialized;
401 >  EnsureLoaded;
402    if (Count <= 0) then
403    begin
404      result := 0;
# Line 369 | Line 427 | end;
427   procedure TIBBlobStream.SaveToStream(Stream: TStream);
428   begin
429    CheckReadable;
430 <  EnsureBlobInitialized;
430 >  EnsureLoaded;
431    if FBlobSize <> 0 then
432    begin
433      Seek(0, soFromBeginning);
# Line 377 | Line 435 | begin
435    end;
436   end;
437  
438 < function TIBBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
438 > function TIBBlobStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
439   begin
440    EnsureBlobInitialized;
441    case Origin of
442 <    soFromBeginning     : FPosition := Offset;
443 <    soFromCurrent       : Inc(FPosition, Offset);
444 <    soFromEnd           : FPosition := FBlobSize + Offset;
442 >    soBeginning     : FPosition := Offset;
443 >    soCurrent       : Inc(FPosition, Offset);
444 >    soEnd           : FPosition := FBlobSize + Offset;
445    end;
446    result := FPosition;
447   end;
# Line 391 | Line 449 | end;
449   procedure TIBBlobStream.SetBlobID(Value: TISC_QUAD);
450   begin
451    System.Move(Value, FBlobID, SizeOf(TISC_QUAD));
452 <  FBlobInitialized := False;
452 >  SetState(bsUninitialised);
453   end;
454  
455   procedure TIBBlobStream.SetDatabase(Value: TIBDatabase);
456   begin
457    FBase.Database := Value;
458 <  FBlobInitialized := False;
458 >  SetState(bsUninitialised);
459   end;
460  
461   procedure TIBBlobStream.SetMode(Value: TBlobStreamMode);
462   begin
463    FMode := Value;
464 <  FBlobInitialized := False;
464 >  SetState(bsUninitialised);
465 > end;
466 >
467 > procedure TIBBlobStream.SetState(aValue: TIBBlobStates);
468 > begin
469 >  if FBlobState = aValue then Exit;
470 >
471 >  if FBlobState = bsDataPending then
472 >    Call(isc_close_blob(StatusVector, @FHandle), True);
473 >
474 >  FBlobState := aValue;
475   end;
476  
477 < procedure TIBBlobStream.SetSize(NewSize: Long);
477 > procedure TIBBlobStream.SetSize(const NewSize: Int64);
478   begin
479    if (NewSize <> FBlobSize) then
480    begin
# Line 417 | Line 485 | begin
485    end;
486   end;
487  
488 + procedure TIBBlobStream.SetSize(NewSize: Longint);
489 + begin
490 +  SetSize(Int64(NewSize));
491 + end;
492 +
493   procedure TIBBlobStream.SetTransaction(Value: TIBTransaction);
494   begin
495    FBase.Transaction := Value;
496 <  FBlobInitialized := False;
496 >  SetState(bsUninitialised);
497   end;
498  
499   procedure TIBBlobStream.Truncate;
500   begin
501    SetSize(0);
502 +  SetState(bsModified);
503   end;
504  
505   function TIBBlobStream.Write(const Buffer; Count: Longint): Longint;
506   begin
507    CheckWritable;
508 <  EnsureBlobInitialized;
508 >  EnsureLoaded;  {Could be an untruncated bmReadWrite Blob}
509    result := Count;
510    if Count <= 0 then
511      exit;
# Line 439 | Line 513 | begin
513      SetSize(FPosition + Count);
514    Move(Buffer, FBuffer[FPosition], Count);
515    Inc(FPosition, Count);
516 <  FModified := True;
516 >  SetState(bsModified);
517   end;
518  
519   end.

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines