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; |
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; |
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; |
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, IBCustomDataSet; |
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; |
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 |
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; |
293 |
|
|
294 |
|
procedure TIBBlobStream.GetBlobInfo; |
295 |
|
var |
296 |
< |
iBlobSize: Long; |
296 |
> |
iBlobSize: Int64; |
297 |
|
begin |
298 |
|
IBBlob.GetBlobInfo(@FHandle, FBlobNumSegments, FBlobMaxSegmentSize, |
299 |
|
iBlobSize, FBlobType); |
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; |
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 |
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; |