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

Comparing ibx/trunk/fbintf/client/2.5/FB25Blob.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC

# Line 60 | Line 60
60   {                                                                        }
61   {************************************************************************}
62   unit FB25Blob;
63 + {$IFDEF MSWINDOWS}
64 + {$DEFINE WINDOWS}
65 + {$ENDIF}
66  
67   {$IFDEF FPC}
68 < {$mode objfpc}{$H+}
68 > {$mode delphi}
69   {$interfaces COM}
70   {$ENDIF}
71  
# Line 70 | Line 73 | interface
73  
74   uses
75    Classes, SysUtils, IB,  IBHeader,IBExternals, FBClientAPI, FB25ClientAPI, FB25Attachment,
76 <  FB25Transaction, FBActivityMonitor, FBBlob;
76 >  FB25Transaction, FBActivityMonitor, FBBlob, FBOutputBlock;
77  
78   type
79  
# Line 85 | Line 88 | type
88       procedure NeedFullMetadata; override;
89     public
90       constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
91 <       RelationName, ColumnName: string); overload;
91 >       RelationName, ColumnName: AnsiString); overload;
92       constructor Create(Attachment: TFB25Attachment; Transaction: TFB25Transaction;
93 <       RelationName, ColumnName: string; SubType: integer); overload;
93 >       RelationName, ColumnName: AnsiString; SubType: integer); overload;
94    end;
95  
96  
# Line 101 | Line 104 | type
104      procedure CheckReadable; override;
105      procedure CheckWritable; override;
106      function GetIntf: IBlob; override;
107 +    procedure GetInfo(Request: array of byte; Response: IBlobInfo); override;
108      procedure InternalClose(Force: boolean); override;
109      procedure InternalCancel(Force: boolean); override;
110    public
# Line 113 | Line 117 | type
117      property Handle: TISC_BLOB_HANDLE read FHandle;
118  
119    public
116    procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
117      var BlobType: TBlobType); override;
120      function Read(var Buffer; Count: Longint): Longint; override;
121      function Write(const Buffer; Count: Longint): Longint; override;
122    end;
# Line 129 | Line 131 | procedure TFB25BlobMetaData.NeedFullMeta
131   var
132    BlobDesc: TISC_BLOB_DESC;
133    Global: array [0..31] of char;
134 +  RelName: AnsiString;
135 +  ColName: AnsiString;
136   begin
137    if FHasFullMetaData then Exit;
138  
135  FCharSetID := 0;
139    FSegmentSize := 80;
140 <  FUnconfirmedCharacterSet := false;
141 <  if (GetColumnName <> '') and (GetRelationName <> '') then
140 >  RelName := AnsiUpperCase(GetRelationName);
141 >  ColName := AnsiUpperCase(GetColumnName);
142 >  if (ColName <> '') and (RelName <> '') then
143    begin
144      with Firebird25ClientAPI do
145        Call(isc_blob_lookup_desc(StatusVector,@(FAttachment.Handle),
146                                              @(FTransaction.Handle),
147 <                PChar(AnsiUpperCase(GetRelationName)),PChar(AnsiUpperCase(GetColumnName)),@BlobDesc,@Global));
148 <    FCharSetID := BlobDesc.blob_desc_charset;
147 >                PAnsiChar(RelName),PAnsiChar(ColName),@BlobDesc,@Global));
148 >    if FUnconfirmedCharacterSet then
149 >      FCharSetID := BlobDesc.blob_desc_charset;
150      FSubType := BlobDesc.blob_desc_subtype;
151      FSegmentSize := BlobDesc.blob_desc_segment_size ;
152 <  end
148 <  else
149 <    FUnconfirmedCharacterSet := true;
152 >  end;
153  
154 <  if (FCharSetID > 1) and FAttachment.HasDefaultCharSet then
154 >  if FUnconfirmedCharacterSet and (FCharSetID > 1) and FAttachment.HasDefaultCharSet then
155    begin
156      FCharSetID := FAttachment.CharSetID;
157      FUnconfirmedCharacterSet := false;
# Line 160 | Line 163 | begin
163   end;
164  
165   constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
166 <  Transaction: TFB25Transaction; RelationName, ColumnName: string);
166 >  Transaction: TFB25Transaction; RelationName, ColumnName: AnsiString);
167   begin
168    inherited Create(Transaction,RelationName,ColumnName);
169    FAttachment := Attachment;
# Line 168 | Line 171 | begin
171   end;
172  
173   constructor TFB25BlobMetaData.Create(Attachment: TFB25Attachment;
174 <  Transaction: TFB25Transaction; RelationName, ColumnName: string;
174 >  Transaction: TFB25Transaction; RelationName, ColumnName: AnsiString;
175    SubType: integer);
176   begin
177    Create(Attachment,Transaction,RelationName,ColumnName);
# Line 195 | Line 198 | begin
198    Result := self;
199   end;
200  
201 + procedure TFB25Blob.GetInfo(Request: array of byte; Response: IBlobInfo);
202 + begin
203 +  if FHandle = nil then
204 +    IBError(ibxeBlobNotOpen,[nil]);
205 +
206 +  with Firebird25ClientAPI, Response as TBlobInfo do
207 +    Call(isc_blob_info(StatusVector, @FHandle, Length(Request),@Request,
208 +                                               GetBufSize, Buffer));
209 + end;
210 +
211   procedure TFB25Blob.InternalClose(Force: boolean);
212   begin
213    if FHandle = nil then
# Line 275 | Line 288 | begin
288                     @FBlobID, getDataLength, getBuffer));
289   end;
290  
278 procedure TFB25Blob.GetInfo(var NumSegments: Int64; var MaxSegmentSize,
279  TotalSize: Int64; var BlobType: TBlobType);
280 var
281  items: array[0..3] of Char;
282  results: array[0..99] of Char;
283  i, item_length: Integer;
284  item: Integer;
285 begin
286  if FHandle = nil then
287    IBError(ibxeBlobNotOpen,[nil]);
288
289  items[0] := Char(isc_info_blob_num_segments);
290  items[1] := Char(isc_info_blob_max_segment);
291  items[2] := Char(isc_info_blob_total_length);
292  items[3] := Char(isc_info_blob_type);
293
294  with Firebird25ClientAPI do
295  begin
296    Call(isc_blob_info(StatusVector, @FHandle, 4, @items[0], SizeOf(results),
297                    @results[0]));
298    i := 0;
299    while (i < SizeOf(results)) and (results[i] <> Char(isc_info_end)) do
300    begin
301      item := Integer(results[i]); Inc(i);
302      item_length := isc_portable_integer(@results[i], 2); Inc(i, 2);
303      case item of
304        isc_info_blob_num_segments:
305          NumSegments := isc_portable_integer(@results[i], item_length);
306        isc_info_blob_max_segment:
307          MaxSegmentSize := isc_portable_integer(@results[i], item_length);
308        isc_info_blob_total_length:
309          TotalSize := isc_portable_integer(@results[i], item_length);
310        isc_info_blob_type:
311          if isc_portable_integer(@results[i], item_length) = 0 then
312            BlobType := btSegmented
313          else
314            BlobType := btStream;
315      end;
316      Inc(i, item_length);
317    end;
318  end;
319 end;
320
291   function TFB25Blob.Read(var Buffer; Count: Longint): Longint;
292   var
293    BytesRead : UShort;
294 <  LocalBuffer: PChar;
294 >  LocalBuffer: PByte;
295    returnCode: long;
296    localCount: uShort;
297   begin
# Line 330 | Line 300 | begin
300    if FEOB then
301      Exit;
302  
303 <  LocalBuffer := PChar(@Buffer);
303 >  LocalBuffer := PByte(@Buffer);
304    repeat
305      if Count > MaxuShort then
306        localCount := MaxuShort
# Line 352 | Line 322 | end;
322  
323   function TFB25Blob.Write(const Buffer; Count: Longint): Longint;
324   var
325 <  LocalBuffer: PChar;
325 >  LocalBuffer: PByte;
326    localCount: uShort;
327   begin
328    CheckWritable;
329 <  LocalBuffer := PChar(@Buffer);
329 >  LocalBuffer := PByte(@Buffer);
330    Result := 0;
331    if Count = 0 then Exit;
332  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines