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 44 by tony, Sat Jul 16 12:25:48 2016 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

# Line 37 | Line 37 | unit IBBlob;
37   interface
38  
39   uses
40 <  SysUtils, Classes, IBHeader, IBErrorCodes, IBExternals, DB, IB, IBDatabase;
40 >  SysUtils, Classes, DB, IB, IBDatabase;
41  
42  
43   const
# Line 50 | Line 50 | type
50    TIBBlobStream = class(TStream)
51    private
52      FBase: TIBBase;
53 <    FBlobID: TISC_QUAD;
53 >    FBlob: IBlob;
54      FBlobMaxSegmentSize: Int64;
55      FBlobNumSegments: Int64;
56      FBlobSize: Int64;
57 <    FBlobType: Short;  { 0 = segmented, 1 = streamed }
57 >    FBlobType: TBlobType;
58      FBuffer: PChar;
59 <    FHandle: TISC_BLOB_HANDLE;
59 >    FColumnName: string;
60      FMode: TBlobStreamMode;
61      FPosition: Int64;
62      FBlobState: TIBBlobStates;
63 +    FRelationName: string;
64 +    function GetBlobID: TISC_QUAD;
65      function GetModified: Boolean;
66 +    procedure CheckActive;
67    protected
68      procedure CloseBlob;
66 –    procedure CreateBlob;
69      procedure EnsureBlobInitialized;
70      procedure EnsureLoaded;
71      procedure GetBlobInfo;
72      function  GetSize: Int64; override;
73      function GetDatabase: TIBDatabase;
72 –    function GetDBHandle: PISC_DB_HANDLE;
74      function GetTransaction: TIBTransaction;
74 –    function GetTRHandle: PISC_TR_HANDLE;
75      procedure OpenBlob;
76      procedure SetBlobID(Value: TISC_QUAD);
77      procedure SetDatabase(Value: TIBDatabase);
# Line 81 | Line 81 | type
81    public
82      constructor Create;
83      destructor Destroy; override;
84 –    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
84      procedure CheckReadable;
85      procedure CheckWritable;
86      procedure Finalize;
# Line 91 | Line 90 | type
90      procedure SaveToFile(Filename: string);
91      procedure SaveToStream(Stream: TStream);
92      function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
93 +    procedure SetField(aField: TField);
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;
98 >    property BlobID: TISC_QUAD read GetBlobID write SetBlobID;
99 >    property Blob: IBlob read FBlob;
100      property BlobMaxSegmentSize: Int64 read FBlobMaxSegmentSize;
101      property BlobNumSegments: Int64 read FBlobNumSegments;
102      property BlobSize: Int64 read GetSize;
103 <    property BlobType: Short read FBlobType;
103 >    property BlobType: TBlobType read FBlobType;
104      property Database: TIBDatabase read GetDatabase write SetDatabase;
105 –    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
105      property Mode: TBlobStreamMode read FMode write SetMode;
106      property Modified: Boolean read GetModified;
107      property Transaction: TIBTransaction read GetTransaction write SetTransaction;
108 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
108 >    property RelationName: string read FRelationName;
109 >    property ColumnName: string read FColumnName;
110    end;
111  
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 –
112   implementation
113  
114 < uses IBIntf;
122 <
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;
128 <  i, item_length: Integer;
129 <  item: Integer;
130 < begin
131 <  items[0] := Char(isc_info_blob_num_segments);
132 <  items[1] := Char(isc_info_blob_max_segment);
133 <  items[2] := Char(isc_info_blob_total_length);
134 <  items[3] := Char(isc_info_blob_type);
135 <
136 <  if isc_blob_info(StatusVector, hBlobHandle, 4, @items[0], SizeOf(results),
137 <                    @results[0]) > 0 then
138 <    IBDatabaseError;
139 <
140 <  i := 0;
141 <  while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
142 <  begin
143 <    item := Integer(results[i]); Inc(i);
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_portable_integer(@results[i], item_length);
148 <      isc_info_blob_max_segment:
149 <        MaxSegmentSize := isc_portable_integer(@results[i], item_length);
150 <      isc_info_blob_total_length:
151 <        TotalSize := isc_portable_integer(@results[i], item_length);
152 <      isc_info_blob_type:
153 <        BlobType := isc_portable_integer(@results[i], item_length);
154 <    end;
155 <    Inc(i, item_length);
156 <  end;
157 < end;
158 <
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: Int64;
174 <  BytesRead, SegLen: UShort;
175 <  LocalBuffer: PChar;
176 < begin
177 <  CurPos := 0;
178 <  LocalBuffer := Buffer;
179 <  SegLen := UShort(DefaultBlobSegmentSize);
180 <  while (CurPos < BlobSize) do
181 <  begin
182 <    if (CurPos + SegLen > BlobSize) then
183 <      SegLen := BlobSize - CurPos;
184 <    if not ((isc_get_segment(StatusVector, hBlobHandle, @BytesRead, SegLen,
185 <                             LocalBuffer) = 0) or
186 <            (StatusVectorArray[1] = isc_segment)) then
187 <      IBDatabaseError;
188 <    Inc(LocalBuffer, BytesRead);
189 <    Inc(CurPos, BytesRead);
190 <    BytesRead := 0;
191 <  end;
192 < end;
193 <
194 < procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar;
195 <  BlobSize: Int64);
196 < var
197 <  CurPos: Int64;
198 <  SegLen: Long;
199 < begin
200 <  CurPos := 0;
201 <  SegLen := DefaultBlobSegmentSize;
202 <  while (CurPos < BlobSize) do
203 <  begin
204 <    if (CurPos + SegLen > BlobSize) then
205 <      SegLen := BlobSize - CurPos;
206 <    if isc_put_segment(StatusVector, hBlobHandle, SegLen,
207 <         PChar(@Buffer[CurPos])) > 0 then
208 <      IBDatabaseError;
209 <    Inc(CurPos, SegLen);
210 <  end;
211 < end;
212 <
114 > uses FBMessages, IBCustomDataSet;
115  
116   { TIBBlobStream }
117   constructor TIBBlobStream.Create;
# Line 219 | Line 121 | begin
121    FBuffer := nil;
122    FBlobSize := 0;
123    FBlobState := bsUninitialised;
124 +  FBlob := nil;
125   end;
126  
127   destructor TIBBlobStream.Destroy;
128   begin
129 <  SetState(bsUninitialised);
129 >  CloseBlob;
130    FBase.Free;
131    SetSize(0);
132    inherited Destroy;
133   end;
134  
232 – function TIBBlobStream.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
233 – begin
234 –  result := 0;
235 –  if Transaction <> nil then
236 –    result := Transaction.Call(ErrCode, RaiseError)
237 –  else if RaiseError and (ErrCode > 0) then
238 –    IBDataBaseError;
239 – end;
240 –
135   procedure TIBBlobStream.CheckReadable;
136   begin
137    if FMode = bmWrite then IBError(ibxeBlobCannotBeRead, [nil]);
# Line 253 | Line 147 | begin
147    Result := FBlobState = bsModified;
148   end;
149  
150 < procedure TIBBlobStream.CloseBlob;
150 > procedure TIBBlobStream.CheckActive;
151   begin
152 <  Finalize;
153 <  SetState(bsUninitialised);
152 >  if Database = nil then
153 >    IBError(ibxeDatabaseNotAssigned,[nil]);
154 >
155 >  if (Database.Attachment = nil) or
156 >                     not Database.Attachment.IsConnected then
157 >    IBError(ibxeDatabaseClosed,[nil]);
158 >
159 >  if Transaction = nil then
160 >    IBError(ibxeTransactionNotAssigned,[nil]);
161 >
162 >  if (Transaction.TransactionIntf = nil) or
163 >      not Transaction.TransactionIntf.InTransaction then
164 >    IBError(ibxeNotInTransaction,[nil]);
165   end;
166  
167 < procedure TIBBlobStream.CreateBlob;
167 > function TIBBlobStream.GetBlobID: TISC_QUAD;
168   begin
169 <  CheckWritable;
170 <  FBlobID.gds_quad_high := 0;
171 <  FBlobID.gds_quad_low := 0;
172 <  SetState(bsData);
173 <  SetSize(0);
169 >  if (FBlob = nil) or (FBlobSize = 0) then
170 >  begin
171 >    Result.gds_quad_high := 0;
172 >    Result.gds_quad_low := 0;
173 >  end
174 >  else
175 >    Result := FBlob.GetBlobID;
176 > end;
177 >
178 > procedure TIBBlobStream.CloseBlob;
179 > begin
180 >  Finalize;
181 >  FBlob := nil;
182 >  SetState(bsUninitialised);
183   end;
184  
185   procedure TIBBlobStream.EnsureBlobInitialized;
186   begin
187 <  if FBlobState = bsUninitialised then
188 <    case FMode of
189 <      bmWrite:
190 <        CreateBlob;
191 <      bmReadWrite: begin
192 <        if (FBlobID.gds_quad_high = 0) and
193 <           (FBlobID.gds_quad_low = 0) then
194 <          CreateBlob
195 <        else
196 <          OpenBlob;
197 <      end;
198 <      else
199 <        OpenBlob;
187 >  if FBlobState <> bsUninitialised then Exit;
188 >
189 >  if FMode = bmWrite then
190 >    SetState(bsData)
191 >  else
192 >  begin
193 >    CheckReadable;
194 >    if FBlob = nil then Exit;
195 >    try
196 >      GetBlobInfo;
197 >      {Defer reading in blob until read method called}
198 >    except
199 >      FBlob := nil;
200 >      raise;
201      end;
202 +    SetState(bsDataPending);
203 +  end;
204   end;
205  
206   procedure TIBBlobStream.EnsureLoaded;
207   begin
208    EnsureBlobInitialized;
209 <  if FBlobState = bsDataPending then
209 >  if (FBlobState = bsDataPending) and (FBlob <> nil) then
210    begin
211      SetSize(FBlobSize);
212 <    try
296 <      IBBlob.ReadBlob(@FHandle, FBuffer, FBlobSize);
297 <    except
298 <      Call(isc_close_blob(StatusVector, @FHandle), False);
299 <      raise;
300 <    end;
212 >    FBlob.Read(FBuffer^, FBlobSize);
213      SetState(bsData);
214    end;
215   end;
# Line 306 | Line 218 | procedure TIBBlobStream.Finalize;
218   begin
219    if FBlobState <> bsModified then
220      exit;
221 +  CheckWritable;
222    if FBlobSize > 0 then
223    begin
224      { need to start writing to a blob, create one }
225 <    Call(isc_create_blob2(StatusVector, DBHandle, TRHandle, @FHandle, @FBlobID,
226 <                         0, nil), True);
227 <    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;
225 >    FBlob := Database.Attachment.CreateBlob(Transaction.TransactionIntf,RelationName,ColumnName);
226 >    FBlob.Write(FBuffer^, FBlobSize);
227 >    FBlob.Close;
228    end;
229    SetState(bsData);
230   end;
# Line 326 | Line 233 | procedure TIBBlobStream.GetBlobInfo;
233   var
234    iBlobSize: Int64;
235   begin
236 <  IBBlob.GetBlobInfo(@FHandle, FBlobNumSegments, FBlobMaxSegmentSize,
237 <    iBlobSize, FBlobType);
236 >  if FBlob = nil then Exit;
237 >
238 >  FBlob.GetInfo(FBlobNumSegments, FBlobMaxSegmentSize, iBlobSize, FBlobType);
239    SetSize(iBlobSize);
240   end;
241  
# Line 342 | Line 250 | begin
250    result := FBase.Database;
251   end;
252  
345 – function TIBBlobStream.GetDBHandle: PISC_DB_HANDLE;
346 – begin
347 –  result := FBase.DBHandle;
348 – end;
349 –
253   function TIBBlobStream.GetTransaction: TIBTransaction;
254   begin
255    result := FBase.Transaction;
256   end;
257  
355 – function TIBBlobStream.GetTRHandle: PISC_TR_HANDLE;
356 – begin
357 –  result := FBase.TRHandle;
358 – end;
359 –
258   procedure TIBBlobStream.LoadFromFile(Filename: string);
259   var
260    Stream: TStream;
# Line 383 | Line 281 | end;
281   procedure TIBBlobStream.OpenBlob;
282   begin
283    CheckReadable;
386 –  Call(isc_open_blob2(StatusVector, DBHandle, TRHandle, @FHandle,
387 –                     @FBlobID, 0, nil), True);
284    try
285      GetBlobInfo;
286      {Defer reading in blob until read method called}
287    except
288 <    Call(isc_close_blob(StatusVector, @FHandle), False);
288 >    FBlob.Close;
289      raise;
290    end;
291    SetState(bsDataPending);
# Line 399 | Line 295 | function TIBBlobStream.Read(var Buffer;
295   begin
296    CheckReadable;
297    EnsureLoaded;
298 <  if (Count <= 0) then
298 >  if Count <= 0 then
299    begin
300      result := 0;
301      exit;
# Line 446 | Line 342 | begin
342    result := FPosition;
343   end;
344  
345 + procedure TIBBlobStream.SetField(aField: TField);
346 + begin
347 +  FRelationName := '';
348 +  if aField.FieldDef <> nil then
349 +    FRelationName := (aField.FieldDef as TIBFieldDef).RelationName;
350 +  FColumnName := aField.FieldName;;
351 + end;
352 +
353   procedure TIBBlobStream.SetBlobID(Value: TISC_QUAD);
354   begin
355 <  System.Move(Value, FBlobID, SizeOf(TISC_QUAD));
356 <  SetState(bsUninitialised);
355 >  CheckActive;
356 >  FBlob := nil;
357 >  if (Value.gds_quad_high = 0) and (Value.gds_quad_low = 0) then
358 >    Exit;
359 >  FBlob := Database.Attachment.OpenBlob(Transaction.TransactionIntf,RelationName,ColumnName,Value);
360 >  if FBlobState <> bsData then
361 >    SetState(bsUninitialised);
362   end;
363  
364   procedure TIBBlobStream.SetDatabase(Value: TIBDatabase);
# Line 468 | Line 377 | procedure TIBBlobStream.SetState(aValue:
377   begin
378    if FBlobState = aValue then Exit;
379  
380 <  if FBlobState = bsDataPending then
381 <    Call(isc_close_blob(StatusVector, @FHandle), True);
380 >  if (FBlobState = bsDataPending) and (FBlob <> nil) then
381 >    FBlob.Close;
382  
383    FBlobState := aValue;
384   end;

Diff Legend

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