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 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 35 by tony, Tue Jan 26 14:38:47 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;
# Line 45 | Line 49 | type
49    private
50      FBase: TIBBase;
51      FBlobID: TISC_QUAD;
52 <    FBlobMaxSegmentSize,
53 <    FBlobNumSegments,
54 <    FBlobSize: Long;
52 >    FBlobMaxSegmentSize: Int64;
53 >    FBlobNumSegments: Int64;
54 >    FBlobSize: Int64;
55      FBlobType: Short;  { 0 = segmented, 1 = streamed }
56      FBuffer: PChar;
57      FBlobInitialized: Boolean;
58      FHandle: TISC_BLOB_HANDLE;
59      FMode: TBlobStreamMode;
60      FModified: Boolean;
61 <    FPosition: Long;
61 >    FPosition: Int64;
62    protected
63      procedure CloseBlob;
64      procedure CreateBlob;
# Line 81 | Line 85 | type
85      function Read(var Buffer; Count: Longint): Longint; override;
86      procedure SaveToFile(Filename: string);
87      procedure SaveToStream(Stream: TStream);
88 <    function Seek(Offset: Longint; Origin: Word): Longint; override;
89 <    procedure SetSize(NewSize: Long); override;
88 >    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
89 >    procedure SetSize(const NewSize: Int64); override;
90 >    procedure SetSize(NewSize: Longint); override;
91      procedure Truncate;
92      function Write(const Buffer; Count: Longint): Longint; override;
93      property Handle: TISC_BLOB_HANDLE read FHandle;
94      property BlobID: TISC_QUAD read FBlobID write SetBlobID;
95 <    property BlobMaxSegmentSize: Long read FBlobMaxSegmentSize;
96 <    property BlobNumSegments: Long read FBlobNumSegments;
97 <    property BlobSize: Long read FBlobSize;
95 >    property BlobMaxSegmentSize: Int64 read FBlobMaxSegmentSize;
96 >    property BlobNumSegments: Int64 read FBlobNumSegments;
97 >    property BlobSize: Int64 read FBlobSize;
98      property BlobType: Short read FBlobType;
99      property Database: TIBDatabase read GetDatabase write SetDatabase;
100      property DBHandle: PISC_DB_HANDLE read GetDBHandle;
# Line 99 | Line 104 | type
104      property TRHandle: PISC_TR_HANDLE read GetTRHandle;
105    end;
106  
107 <  procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments, MaxSegmentSize,
108 <                       TotalSize: Long; var BlobType: Short);
109 <  procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
110 <  procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
107 >  procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
108 >                      TotalSize: Int64; var BlobType: Short);
109 >  function GetBlobCharSetID(hDB_Handle: TISC_DB_HANDLE; hTR_Handle: TISC_TR_HANDLE;
110 >                      tableName, columnName: PChar): short;
111 >  procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
112 >  procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
113  
114   implementation
115  
116   uses IBIntf;
117  
118 < procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments, MaxSegmentSize,
119 <                      TotalSize: Long; var BlobType: Short);
118 > procedure GetBlobInfo(hBlobHandle: PISC_BLOB_HANDLE; var NumSegments: Int64; var MaxSegmentSize,
119 >                      TotalSize: Int64; var BlobType: Short);
120   var
121    items: array[0..3] of Char;
122    results: array[0..99] of Char;
# Line 132 | Line 139 | begin
139      item_length := isc_vax_integer(@results[i], 2); Inc(i, 2);
140      case item of
141        isc_info_blob_num_segments:
142 <        NumSegments := isc_vax_integer(@results[i], item_length);
142 >        NumSegments := isc_portable_integer(@results[i], item_length);
143        isc_info_blob_max_segment:
144 <        MaxSegmentSize := isc_vax_integer(@results[i], item_length);
144 >        MaxSegmentSize := isc_portable_integer(@results[i], item_length);
145        isc_info_blob_total_length:
146 <        TotalSize := isc_vax_integer(@results[i], item_length);
146 >        TotalSize := isc_portable_integer(@results[i], item_length);
147        isc_info_blob_type:
148 <        BlobType := isc_vax_integer(@results[i], item_length);
148 >        BlobType := isc_portable_integer(@results[i], item_length);
149      end;
150      Inc(i, item_length);
151    end;
152   end;
153  
154 < procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Long);
154 > function GetBlobCharSetID(hDB_Handle: TISC_DB_HANDLE;
155 >  hTR_Handle: TISC_TR_HANDLE; tableName, columnName: PChar): short;
156 > var desc: TISC_BLOB_DESC;
157 >    uGlobal: array [0..31] of char;
158 > begin
159 >  if isc_blob_lookup_desc(StatusVector,@hDB_Handle,@hTR_Handle,
160 >                tableName,columnName,@desc,@uGlobal) > 0 then
161 >    IBDatabaseError;
162 >
163 >  Result := desc.blob_desc_charset;
164 > end;
165 >
166 > procedure ReadBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar; BlobSize: Int64);
167   var
168 <  CurPos: Long;
168 >  CurPos: Int64;
169    BytesRead, SegLen: UShort;
170    LocalBuffer: PChar;
171   begin
# Line 168 | Line 187 | begin
187   end;
188  
189   procedure WriteBlob(hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar;
190 <  BlobSize: Long);
190 >  BlobSize: Int64);
191   var
192 <  CurPos, SegLen: Long;
192 >  CurPos: Int64;
193 >  SegLen: Long;
194   begin
195    CurPos := 0;
196    SegLen := DefaultBlobSegmentSize;
# Line 273 | Line 293 | end;
293  
294   procedure TIBBlobStream.GetBlobInfo;
295   var
296 <  iBlobSize: Long;
296 >  iBlobSize: Int64;
297   begin
298    IBBlob.GetBlobInfo(@FHandle, FBlobNumSegments, FBlobMaxSegmentSize,
299      iBlobSize, FBlobType);
# Line 379 | Line 399 | begin
399    end;
400   end;
401  
402 < function TIBBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
402 > function TIBBlobStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
403   begin
404    EnsureBlobInitialized;
405    case Origin of
406 <    soFromBeginning     : FPosition := Offset;
407 <    soFromCurrent       : Inc(FPosition, Offset);
408 <    soFromEnd           : FPosition := FBlobSize + Offset;
406 >    soBeginning     : FPosition := Offset;
407 >    soCurrent       : Inc(FPosition, Offset);
408 >    soEnd           : FPosition := FBlobSize + Offset;
409    end;
410    result := FPosition;
411   end;
# Line 408 | Line 428 | begin
428    FBlobInitialized := False;
429   end;
430  
431 < procedure TIBBlobStream.SetSize(NewSize: Long);
431 > procedure TIBBlobStream.SetSize(const NewSize: Int64);
432   begin
433    if (NewSize <> FBlobSize) then
434    begin
# Line 419 | Line 439 | begin
439    end;
440   end;
441  
442 + procedure TIBBlobStream.SetSize(NewSize: Longint);
443 + begin
444 +  SetSize(Int64(NewSize));
445 + end;
446 +
447   procedure TIBBlobStream.SetTransaction(Value: TIBTransaction);
448   begin
449    FBase.Transaction := Value;

Diff Legend

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