Delphi 12 Athens Updates Available!
To download, click your product: DIContainers, DIConverters, DICreole, DIFileFinder, DIGoogleReader, DIHtmlLabel, DIHtmlParser, DIMime, DIRegEx, DISQLite3, DITidy, DIUcl, DIUnicode, DIXml, YuBrotli, YuImage, YuNetSurf, YuOpenSSL, YuPcre2, YuPdf, YuStemmer, YuXmlSec, YuZip.

DISQLite3: DISQLite3ZLib.pas

Download Demo Download Personal Buy License

DISQLite3 implements a self-contained, embeddable, zero-configuration SQL database engine for Delphi (Embarcadero / CodeGear / Borland).

Please register and / or log in to edit. Anonymous Wiki edits are disabled to protect against vandalism.

An updated version of this unit is distributed with the DISQLite3 package.

{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2017 Ralf Junker, The Delphi Inspiration
 Internet: https://www.yunqa.de/delphi/
 E-Mail:   delphi@yunqa.de
 
-------------------------------------------------------------------------------}
 
unit DISQLite3ZLib;
 
{$I DI.inc}
{$I DISQLite3.inc}
 
{$IFDEF DISQLite3_Personal}
!!! This unit does not compile with DISQLite3 Personal !!!
!!! Download DISQLite3 Pro from www.yunqa.de/delphi/   !!!
{$ENDIF DISQLite3_Personal}
 
interface
 
uses
  DISQLite3Api;
 
procedure sqlite3_create_function_zlib(const DB: sqlite3);
 
implementation
 
uses
  SysUtils, zlib;
 
resourcestring
  SCompressError = 'COMPRESS() error';
  SDecompressError = 'UNCOMPRESS() error';
 
procedure sqlite3_zlib_compress_func(
  pCtx: sqlite3_context;
  nArgs: Integer;
  Args: PPointerArray);
var
  Arg0: Pointer;
  InBuf, OutBuf: Pointer;
  InBytes, OutBytes: Integer;
begin
  Arg0 := Args[0];
  case sqlite3_value_type(Arg0) of
    SQLITE_TEXT:
      begin
        InBuf := sqlite3_value_text(Arg0);
        InBytes := sqlite3_value_bytes(Arg0);
        if InBytes > 0 then
          begin
            try
              CompressBuf(InBuf, InBytes, OutBuf, OutBytes);
              if OutBytes > 0 then
                sqlite3_result_text(
                  pCtx, OutBuf, OutBytes, sqlite3_destroy_mem)
              else
                sqlite3_result_text(pCtx, '', 0, SQLITE_STATIC);
            except
              sqlite3_result_error(
                pCtx, PAnsiChar(SCompressError), Length(SCompressError));
            end;
            Exit;
          end;
      end;
    SQLITE_BLOB:
      begin
        InBuf := sqlite3_value_blob(Arg0);
        InBytes := sqlite3_value_bytes(Arg0);
        if InBytes > 0 then
          begin
            try
              CompressBuf(InBuf, InBytes, OutBuf, OutBytes);
              if OutBytes > 0 then
                sqlite3_result_blob(
                  pCtx, OutBuf, OutBytes, sqlite3_destroy_mem)
              else
                sqlite3_result_blob(pCtx, Pointer(1), 0, SQLITE_STATIC);
            except
              sqlite3_result_error(
                pCtx, PAnsiChar(SCompressError), Length(SCompressError));
            end;
            Exit;
          end;
      end;
  end;
  sqlite3_result_value(pCtx, Arg0);
end;
 
procedure sqlite3_zlib_uncompress_func(
  pCtx: sqlite3_context;
  nArgs: Integer;
  Args: PPointerArray);
var
  Arg0: Pointer;
  InBuf, OutBuf: Pointer;
  InBytes, OutBytes: Integer;
begin
  Arg0 := Args[0];
  case sqlite3_value_type(Arg0) of
    SQLITE_TEXT:
      begin
        InBuf := sqlite3_value_text(Arg0);
        InBytes := sqlite3_value_bytes(Arg0);
        if InBytes > 0 then
          begin
            try
              DeCompressBuf(InBuf, InBytes, InBytes * 2, OutBuf, OutBytes);
              if OutBytes > 0 then
                sqlite3_result_text(
                  pCtx, OutBuf, OutBytes, sqlite3_destroy_mem)
              else
                sqlite3_result_text(pCtx, '', 0, SQLITE_STATIC);
            except
              sqlite3_result_error(
                pCtx, PAnsiChar(SDecompressError), Length(SDecompressError));
            end;
            Exit;
          end;
      end;
    SQLITE_BLOB:
      begin
        InBuf := sqlite3_value_blob(Arg0);
        InBytes := sqlite3_value_bytes(Arg0);
        if InBytes > 0 then
          begin
            try
              DeCompressBuf(InBuf, InBytes, InBytes * 2, OutBuf, OutBytes);
              if OutBytes > 0 then
                sqlite3_result_blob(
                  pCtx, OutBuf, OutBytes, sqlite3_destroy_mem)
              else
                sqlite3_result_blob(pCtx, Pointer(1), 0, SQLITE_STATIC);
            except
              sqlite3_result_error(
                pCtx, PAnsiChar(SDecompressError), Length(SDecompressError));
            end;
            Exit;
          end;
      end;
  end;
  sqlite3_result_value(pCtx, Arg0);
end;
 
procedure sqlite3_create_function_zlib(const DB: sqlite3);
begin
  sqlite3_check(sqlite3_create_function(DB, 'COMPRESS', 1,
    SQLITE_ANY, nil, sqlite3_zlib_compress_func, nil, nil), DB);
  sqlite3_check(sqlite3_create_function(DB, 'UNCOMPRESS', 1,
    SQLITE_ANY, nil, sqlite3_zlib_uncompress_func, nil, nil), DB);
end;
 
end.