unit UdrBlob;

interface

uses
  System.SysUtils, FbApi, System.Classes;

const
  SizeField = 255;
  cMaxBufSize: Word = 16384; //= 8192; //  16384;

type
  TLoadBLOBInMessagePtr = ^TLoadBLOBInMessage;

  TLoadBLOBInMessage = record
    StrLen: Word;
    Str: array [0 .. 4 * SizeField - 1] of AnsiChar;
    StrNull: WordBool;
  end;

  TLoadBLOBOutMessagePtr = ^TLoadBLOBOutMessage;

  TLoadBLOBOutMessage = record
    Size: Word;
    dataB: Blob;
    dataBNull: WordBool;
  end;

  TLoadBLOBFunction = class(ExternalFunctionImpl)
    procedure dispose(); override;
    procedure getCharSet(status: status; context: ExternalContext; name: PAnsiChar;
      nameSize: Cardinal); override;
    procedure execute(status: status; context: ExternalContext; inMsg: Pointer;
      outMsg: Pointer); override;
  end;

  TLoadBLOBFactory = class(UdrFunctionFactoryImpl)
    procedure dispose(); override;
    procedure setup(status: status; context: ExternalContext; metadata: RoutineMetadata;
      inBuilder: MetadataBuilder; outBuilder: MetadataBuilder); override;
    function newItem(status: status; context: ExternalContext; metadata: RoutineMetadata)
      : ExternalFunction; override;
  end;

implementation

uses
  System.AnsiStrings, ib_util;

{TLoadBLOBFunction}

procedure TLoadBLOBFunction.dispose();
begin
  destroy;
end;

procedure TLoadBLOBFunction.getCharSet(status: status; context: ExternalContext; name: PAnsiChar;
  nameSize: Cardinal);
begin
end;

procedure TLoadBLOBFunction.execute(status: status; context: ExternalContext; inMsg: Pointer;
  outMsg: Pointer);
var
  AInMsg: TLoadBLOBInMessagePtr;
  AOutMsg: TLoadBLOBOutMessagePtr;

  //inBlob, outBlob: Blob;

  BufSize, ReadLength, StreamSize: Integer;
  Buffer: PAnsiChar;
  Stream: TStream;

  AFileName: String;
begin
  //пример http://www.sql.ru/forum/1224694/udr-firebird-rabota-s-blob
  try
    AInMsg:=TLoadBLOBInMessagePtr(inMsg);
    AOutMsg:=TLoadBLOBOutMessagePtr(outMsg);

    AFileName:=UTF8ToString(AInMsg.Str);

// что делает эта команда?
    AOutMsg.dataB:=context.getAttachment(status).createBlob(status, context.getTransaction(status),
      outMsg {было inMsg}, 0, nil);

    Stream:=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
    try
      StreamSize:=Stream.Size; //размер файла
      if StreamSize > cMaxBufSize then //если размер файла больше размера сегмента
        BufSize:=cMaxBufSize//размер под буфер равен размеру сегмента
      else
        BufSize:=StreamSize; //иначе размер под буфер равен размеру файла

      GetMem(Buffer, BufSize); //выделение памяти под сегмент

      try
        while StreamSize <> 0 do begin
          if StreamSize > BufSize then
            ReadLength:=BufSize
          else
            ReadLength:=StreamSize;

          Stream.ReadBuffer(Buffer^, ReadLength);

          AOutMsg.dataB.putSegment(status, ReadLength, Buffer);

          Dec(StreamSize, ReadLength);

        end;
      finally
        FreeMem(Buffer, BufSize);
      end;
    finally
      Stream.Free;
    end;
    AOutMsg.Size:=Stream.Size;
    AOutMsg.dataBNull:=Stream.Size > 0;
  except
    on E: Exception do
      FbException.catchException(status, E);
  end;
end;

{TLoadBLOBFactory}

procedure TLoadBLOBFactory.dispose();
begin
  destroy;
end;

procedure TLoadBLOBFactory.setup(status: status; context: ExternalContext;
  metadata: RoutineMetadata; inBuilder: MetadataBuilder; outBuilder: MetadataBuilder);
begin
end;

function TLoadBLOBFactory.newItem(status: status; context: ExternalContext;
  metadata: RoutineMetadata): ExternalFunction;
begin
  Result:=TLoadBLOBFunction.Create;
end;

end.