iBase.ru Forum

Код: Выделить всё

type
  PBlob = ^TBlob;
  TBlob = record
    GetSegment: function(Handle: pointer; Buffer: PChar; MaxLength: integer; var ReadLength: integer): WordBool; cdecl;
    Handle: pointer;               // handle
    SegCount,                      // number of segments
    MaxSegLength,                  // max length of segment
    TotalLength: integer;          // total blob length
    PutSegment: procedure(Handle: pointer; Buffer: PChar; Length: integer); cdecl;
  end;

const
  MaxBlobPutLength = 80;
  MaxVarCharLength = 32767;
  MaxResultStringLength = 8190;


{ udfs }


function FillBuffer(var Blob: TBlob; Buf: PChar; FreeBufLen: integer; var ReadLen: Integer): boolean;
var
  EndOfBlob: boolean;
  FreeBufLenX, GotLength: integer;
begin
  try
    ReadLen := 0;
    repeat
      GotLength := 0; { !?! }

      if FreeBufLen > MaxBlobPutLength
        then FreeBufLenX := MaxBlobPutLength
        else FreeBufLenX := FreeBufLen;

      with Blob do
        EndOfBlob := not GetSegment(Handle, Buf+ReadLen, FreeBufLenX, GotLength);

      Inc(ReadLen, GotLength);
      Dec(FreeBufLen, GotLength);
    until EndOfBlob or (FreeBufLen = 0);
  except
    EndOfBlob := True;
  end;
  Buf[ReadLen] := #0;
  Result := EndOfBlob;
end;

function ReadBlob(var Blob: TBlob): string;
var
  ReadLen: Integer;
begin
  with Blob do
    if Assigned(Handle) and (TotalLength > 0) then
    begin
      SetLength(Result, TotalLength);
      FillBuffer(Blob, PChar(Result), TotalLength, ReadLen);
      SetLength(Result, ReadLen);
    end else
      Result := '';
end;

procedure WriteBlob(var Blob: TBlob; const S: string);
var
  SLen, PutLen: integer;
  PS: PChar;
begin
  SLen := length(S);
  PS := PChar(S);

  if not Assigned(Blob.Handle) then
    Exit;

  if SLen = 0 then
  begin
    PutLen := 0;
    with Blob do
      PutSegment(Handle, PS, PutLen);
  end else
  begin
    while SLen > 0 do
    begin
      if SLen > MaxBlobPutLength then
        PutLen := MaxBlobPutLength
      else
        PutLen := SLen;

      with Blob do
        PutSegment(Handle, PS, PutLen);

      dec(SLen, PutLen);
      inc(PS, PutLen);
    end;
  end;
end;

procedure BCommaUnion(Comma1, Comma2, Res: PBlob);
begin
  WriteBlob(Res^, ReadBlob(Comma1^) + ReadBlob(Comma2^));
end;

Код: Выделить всё

select BlobToStr(BCOmmaUnion(Props, StrToBlob('800'))) as Props from classes where Props is null