* Patch from Mantis #19116, from Toru Takubo modified by Reinier for recent

   changes.  Implements a check on blobsize to avoid reading beyond the
   length of a blob where isc_get_segment can segfault.

git-svn-id: trunk@20633 -

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -85,6 +85,7 @@ type
     procedure AddFieldDefs(cursor: TSQLCursor;FieldDefs : TfieldDefs); override;
     function Fetch(cursor : TSQLCursor) : boolean; override;
     function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
+    function GetBlobSize(blobHandle : TIsc_Blob_Handle) : LongInt;
     function GetTransactionHandle(trans : TSQLHandle): pointer; override;
     function Commit(trans : TSQLHandle) : boolean; override;
     function RollBack(trans : TSQLHandle) : boolean; override;
@@ -1253,6 +1254,22 @@ begin
   Move(Dbl, Buffer^, 8);
 end;
 
+function TIBConnection.GetBlobSize(blobHandle: TIsc_Blob_Handle): LongInt;
+var
+  iscInfoBlobTotalLength : byte;
+  blobInfo : array[0..50] of byte;
+
+begin
+  iscInfoBlobTotalLength:=isc_info_blob_total_length;
+  if isc_blob_info(@Fstatus[0], @blobHandle, sizeof(iscInfoBlobTotalLength), pchar(@iscInfoBlobTotalLength), sizeof(blobInfo) - 2, pchar(@blobInfo[0])) <> 0 then
+    CheckError('isc_blob_info', FStatus);
+  if blobInfo[0]  = iscInfoBlobTotalLength then
+    begin
+      result :=  isc_vax_integer(pchar(@blobInfo[3]), isc_vax_integer(pchar(@blobInfo[1]), 2));
+    end
+  else
+     CheckError('isc_blob_info', FStatus);
+end;
 
 procedure TIBConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction);
 const
@@ -1262,6 +1279,7 @@ var
   blobHandle : Isc_blob_Handle;
   blobSegment : pointer;
   blobSegLen : word;
+  blobSize: LongInt;
   TransactionHandle : pointer;
   blobId : PISC_QUAD;
   ptr : Pointer;
@@ -1274,29 +1292,35 @@ begin
   if isc_open_blob(@FStatus[0], @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, blobId) <> 0 then
     CheckError('TIBConnection.CreateBlobStream', FStatus);
 
+  blobSize := GetBlobSize(blobHandle);
+
   //For performance, read as much as we can, regardless of any segment size set in database.
   blobSegment := AllocMem(MAXBLOBSEGMENTSIZE);
 
   with ABlobBuf^.BlobBuffer^ do
     begin
     Size := 0;
-    while (isc_get_segment(@FStatus[0], @blobHandle, @blobSegLen, MAXBLOBSEGMENTSIZE, blobSegment) = 0) do
+    // Test for Size is a workaround for Win64 Firebird embedded crashing in isc_get_segment when entire blob is read.
+    while (Size < blobSize) and (isc_get_segment(@FStatus[0], @blobHandle, @blobSegLen, MAXBLOBSEGMENTSIZE, blobSegment) = 0) do
       begin
       ReAllocMem(Buffer,Size+blobSegLen);
       ptr := Buffer+Size;
       move(blobSegment^,ptr^,blobSegLen);
       inc(Size,blobSegLen);
       end;
-    end;
-  freemem(blobSegment);
 
-  if FStatus[1] = isc_segstr_eof then
-    begin
-      if isc_close_blob(@FStatus[0], @blobHandle) <> 0 then
-        CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
-    end
-  else
-    CheckError('TIBConnection.CreateBlobStream isc_get_segment', FStatus);
+   freemem(blobSegment);
+
+    // Throwing the proper error on failure is more important than closing the blob:
+    // Test for Size is another workaround.
+    if (Size = blobSize) or (FStatus[1] = isc_segstr_eof) then
+      begin
+        if isc_close_blob(@FStatus[0], @blobHandle) <> 0 then
+          CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
+      end
+    else
+      CheckError('TIBConnection.CreateBlobStream isc_get_segment', FStatus);
+    end;
 end;
 
 function TIBConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;