{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2021 Ralf Junker, Yunqa
 Internet: https://www.yunqa.de
 E-Mail:   delphi@yunqa.de

-------------------------------------------------------------------------------}

unit DISQLite3ZLib;

{$I DICompilers.inc}
{$I DISQLite3.inc}

{$IFDEF DISQLite3_Personal}
!!! This file requires functionality unavailable in DISQLite3 Personal. !!!
!!! To compile, download DISQLite3 Pro from www.yunqa.de.               !!!
{$ENDIF DISQLite3_Personal}

interface

uses
  DISystemCompat, DISQLite3Api;

procedure sqlite3_create_function_zlib(const DB: sqlite3_ptr);

implementation

uses
  {$IFDEF HAS_UNITSCOPE}
  System.SysUtils, System.ZLib
  {$ELSE HAS_UNITSCOPE}
  SysUtils, ZLib
  {$ENDIF HAS_UNITSCOPE}
  ;

resourcestring
  SCompressError = 'COMPRESS() error';
  SDecompressError = 'UNCOMPRESS() error';

procedure sqlite3_zlib_compress_func(
  pCtx: sqlite3_context_ptr;
  nArgs: Integer;
  Args: sqlite3_value_ptr_array_ptr);
var
  Arg0: Pointer;
  InBuf, OutBuf: Pointer;
  InBytes, OutBytes: Integer;
  Msg8: RawByteString;
  OK: Boolean;

  DataType: Integer;
begin
  Arg0 := Args[0];
  DataType := sqlite3_value_type(Arg0);
  case DataType of
    SQLITE_TEXT, SQLITE_BLOB:
      begin
        if DataType = SQLITE_TEXT then
          InBuf := sqlite3_value_text(Arg0)
        else
          InBuf := sqlite3_value_blob(Arg0);
        InBytes := sqlite3_value_bytes(Arg0);
        if InBytes > 0 then
          begin

            try
              {$IFDEF COMPILER_12_UP}ZCompress{$ELSE}CompressBuf{$ENDIF}(
                InBuf, InBytes, OutBuf, OutBytes);
              OK := True;
            except
              OK := False;
            end;

            if OK then
              if OutBytes > 0 then
                if DataType = SQLITE_TEXT then
                  sqlite3_result_text(pCtx, OutBuf, OutBytes, sqlite3_Destroy_Mem)
                else
                  sqlite3_result_blob(pCtx, OutBuf, OutBytes, sqlite3_Destroy_Mem)
              else

                if DataType = SQLITE_TEXT then
                  sqlite3_result_text(pCtx, '', 0, SQLITE_STATIC)
                else
                  sqlite3_result_blob(pCtx, Pointer(1), 0, SQLITE_STATIC)
              else
                begin
                  FreeMem(OutBuf);
                  Msg8 := sqlite3_encode_utf8(LoadResString(PResStringRec(@SCompressError)));
                  sqlite3_result_error(pCtx, Pointer(Msg8), Length(Msg8));
                end;
                Exit;
          end;
      end;
  end;
  sqlite3_result_value(pCtx, Arg0);
end;

procedure sqlite3_zlib_uncompress_func(
  pCtx: sqlite3_context_ptr;
  nArgs: Integer;
  Args: sqlite3_value_ptr_array_ptr);
var
  Arg0: Pointer;
  InBuf, OutBuf: Pointer;
  InBytes, OutBytes: Integer;
  Msg8: RawByteString;
  DataType: Integer;
begin
  Arg0 := Args[0];
  DataType := sqlite3_value_type(Arg0);
  case DataType of
    SQLITE_TEXT, SQLITE_BLOB:
      begin
        if DataType = SQLITE_TEXT then
          InBuf := sqlite3_value_text(Arg0)
        else
          InBuf := sqlite3_value_blob(Arg0);
        InBytes := sqlite3_value_bytes(Arg0);
        if InBytes > 0 then
          begin
            try

              {$IFDEF COMPILER_12_UP}
              ZDecompress(InBuf, InBytes, OutBuf, OutBytes, InBytes * 2);
              {$ELSE COMPILER_12_UP}
              DeCompressBuf(InBuf, InBytes, InBytes * 2, OutBuf, OutBytes);
              {$ENDIF COMPILER_12_UP}

              if OutBytes > 0 then
                if DataType = SQLITE_TEXT then
                  sqlite3_result_text(pCtx, OutBuf, OutBytes, sqlite3_Destroy_Mem)
                else
                  sqlite3_result_blob(pCtx, OutBuf, OutBytes, sqlite3_Destroy_Mem)
              else

                if DataType = SQLITE_TEXT then
                  sqlite3_result_text(pCtx, '', 0, SQLITE_STATIC)
                else
                  sqlite3_result_blob(pCtx, Pointer(1), 0, SQLITE_STATIC)
            except
              Msg8 := sqlite3_encode_utf8(LoadResString(PResStringRec(@SDecompressError)));
              sqlite3_result_error(pCtx, Pointer(Msg8), Length(Msg8));
            end;
            Exit;
          end;
      end;
  end;
  sqlite3_result_value(pCtx, Arg0);
end;

procedure sqlite3_create_function_zlib(const DB: sqlite3_ptr);
begin
  sqlite3_check(sqlite3_create_function(DB, 'COMPRESS', 1,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, nil, sqlite3_zlib_compress_func, nil, nil), DB);

  sqlite3_check(sqlite3_create_function(DB, 'UNCOMPRESS', 1,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, nil, sqlite3_zlib_uncompress_func, nil, nil), DB);
end;

end.

