Delphi Inspiration – Delphi Components and Software Applications

DISQLite3ZLib.pas

Anonymous editing of this Wiki page is disabled to hamper vandalism. To edit, you must first log in using the button in the left column.


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

{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2007 Ralf Junker, The Delphi Inspiration
 Internet: http://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.
wiki/sqlite3/disqlite3zlib.pas.txt · Last modified: 2009/10/28 19:28 (external edit)