umysqlnet.pas

用delphi连接mysql的组件

{--------------------------------------------------------------------------------
Licencing issues:
13-December-2003      〤ristian Nicola
Note:
 Mysql is copyright by MySQL AB. Refer to their site ( http://www.mysql.com )
for licencing issues.
 Zlib is copyright by Jean-loup Gailly and Mark Adler. Refer to their site for
licencing issues. ( http://www.info-zip.org/pub/infozip/zlib/ )

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

NOTES:
  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. If you are using it for a commercial software it must be open source and
     it must include full source code of this library in an unaltered fashion
     or you would need to ask for permission to use it. This library will be
     considered donationware which means if you want to contribute with any money
     or hardware you are more than welcome.
  4. This notice may not be removed or altered from any source distribution.

  Cristian Nicola
  [e-mail]

If you use the mysqldirect library in a product, i would appreciate *not*
receiving lengthy legal documents to sign. The sources are provided
for free but without warranty of any kind.  The library has been
entirely written by Cristian Nicola after libmysql of MYSQL AB.
--------------------------------------------------------------------------------}
unit uMysqlNet;
////////////////////////////////////////////////////////////////////////////////
// Net structure it is responsible of packing/unpacking packets
// it uses Vio to read/write and if using compressed protocol
// it decompress/compress packets
// controlled by Mysql Client no one should ever use it directly

interface

{$I mysqlinc.inc}

uses
  sysutils, uMysqlErrors, uMysqlCT, uMysqlVio;

type
  TMysqlNet = class (TObject)
  private
    fvio                : TMysqlVIO;
    fcompress           : boolean;
    freading_or_writing : byte;
    fbuff               : pointer;
    fpkt_nr             : byte;
    fmax_packet         : longint;
    fwrite_pos          : longint;
    fread_pos           : longint;
    fbuf_length         : longint;
    fwhere_b            : longint;
    fremain_in_buf      : longint;
    fsave_char          : char;
    //timeout            : cardinal;
    //error              : byte;
    fprotocol_version   : cardinal;
    procedure Setlast_error(const Value: string);
    function Getlast_error: string;
    procedure Setlast_errorno(const Value: cardinal);
    function Getlast_errorno: cardinal;
    procedure setcompress(const Value: boolean);
    function GetNetConnected: boolean;
    function GetVioType: TEnumVioType;
    procedure SetNoTimeOut(const Value: Boolean);
    function GetNoTimeOut: Boolean;
  public
    property last_error : string read Getlast_error write Setlast_error;
    property last_errno : cardinal read Getlast_errorno write Setlast_errorno;
    property read_pos : longint read fread_pos;
    property protocol_version:cardinal read fprotocol_version write fprotocol_version;
    property compress:boolean read fcompress write setcompress;
    property net_connected:boolean read GetNetConnected;
    property vio_type:TEnumVioType read GetVioType;
    property NoTimeOut : Boolean read GetNoTimeOut write SetNoTimeOut;
    constructor Create;
    destructor Destroy;override;
    function net_open( VioType:TEnumVioType; host:string='localhost'; unix_socket:string={$IFDEF _WIN_}MYSQL_NAMEDPIPE{$ELSE}MYSQL_UNIX_ADDR{$ENDIF}; port:longint=0; connect_timeout:cardinal=0; trysock:boolean=true):longint;
    function net_close:longint;
    function net_pack:boolean;
    function net_realloc(len1:cardinal):boolean;
    procedure net_clear;
    function net_flush:longint;
    function my_net_write(const packet:PCHAR;len1:cardinal):longint;
    function net_write_command(command:char;const packet:pchar;len1:cardinal):longint;
    function net_write_buff({const }packet:pchar;len1:longint):longint;
    function net_real_write({const }packet1:pchar;len1:longint):longint;
    function my_real_read(var complen:longint):longint;
    function my_net_read:longint;
    function net_safe_read(fclient_flag: integer):longint;
    {$IFDEF HAVE_SSL}
    procedure SwitchToSSL(const key_file:pchar;const cert_file:pchar;const ca_file:pchar;const ca_path:pchar;var cipher:pchar; timeout:cardinal);
    {$ENDIF}
  end;

////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////

{$IFDEF HAVE_COMPRESS}
//zlib imports
{$IFDEF _WIN_}
{$L zlib\compress.obj}
{$L zlib\uncompr.obj}
{$L zlib\deflate.obj}
{$L zlib\adler32.obj}
{$L zlib\trees.obj}

{$L zlib\inflate.obj}
{$L zlib\infblock.obj}
{$L zlib\infcodes.obj}
{$L zlib\inffast.obj}
{$L zlib\inftrees.obj}
{$L zlib\infutil.obj}
function compress(dest:pointer; destLen: pointer; const source:pointer; sourceLen:longint):longint;external;
function uncompress(dest:pointer; destlen:pointer; source:pointer;sourceLne:longint):longint;external;
{$ELSE}
function compress(dest:pointer; destLen: pointer; const source:pointer; sourceLen:longint):longint; cdecl; external 'libz.so' name 'compress';
function uncompress(dest:pointer; destlen:pointer; source:pointer;sourceLne:longint):longint; cdecl; external 'libz.so' name 'uncompress';
{$ENDIF}

const
  _z_errmsg: array[0..9] of PChar = (
    'need dictionary',      // Z_NEED_DICT      (2)
    'stream end',           // Z_STREAM_END     (1)
    '',                     // Z_OK             (0)
    'file error',           // Z_ERRNO          (-1)
    'stream error',         // Z_STREAM_ERROR   (-2)
    'data error',           // Z_DATA_ERROR     (-3)
    'insufficient memory',  // Z_MEM_ERROR      (-4)
    'buffer error',         // Z_BUF_ERROR      (-5)
    'incompatible version', // Z_VERSION_ERROR  (-6)
    '');
    
//needed by zlib
procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
begin
  Move(source^, dest^, count);
end;

{$IFDEF _WIN_}
//needed by zlib
procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
begin
  FillChar(P^, count, B);
end;

//needed by zlib
function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
begin
  GetMem(Result, Items*Size);
end;

//needed by zlib
procedure zcfree(AppData, Block: Pointer);
begin
  FreeMem(Block);
end;
{$ENDIF}

type
  PByte=^byte;
  PLongInt=^longint;

////////////////////////////////////////////////////////////////////////////////
// allocates a buffer and compress it
function my_compress_alloc(const packet:PByte;_len:PLongint; complen:PLongint):PByte;
var
  compbuf:PByte;
  tmp:Longint;
begin
  //how much we need
  complen^ :=  trunc(_len^ * 120 / 100 + 12); // should be integer
  getmem(compbuf,complen^);
  if (compbuf=nil)then //out of memory?
    begin
      result:=nil;
      exit;
    end;
  if (compress(compbuf,complen, packet, _len^ ) <> 0) then //compress it
    begin
      freemem(compbuf); //we got an error
      result:=nil;
      exit;
    end;
  if (complen^ >= _len^) then //compressed packet is bigger than the uncompressed one ?
    begin
      complen^:=0;
      freemem(compbuf);
      result:=nil;
      exit;
    end;
  tmp:=_len^; //return the compressed packet
  _len^:=complen^;
  complen^:=tmp;
  result:=compbuf;
end;

////////////////////////////////////////////////////////////////////////////////
//compression function
// it calls my_compress_alloc to check whenever the new packet(compressed)
// is bigger than the original one
function my_compress(packet:PByte; _len:PLongint; complen:PLongint):boolean;
var
  compbuf:PByte;
begin
  if (_len^ < MIN_COMPRESS_LENGTH) then //do we need compression?
    complen^:=0
  else
    begin
      compbuf:=my_compress_alloc(packet,_len,complen);
      if (compbuf=nil) then //doesnt look like compression will help
        begin
          if complen^<>0 then
            result:=true
          else
            result:=false;
          exit;
        end;
      _memcpy(packet,compbuf,_len^); //switch the result
      freemem(compbuf);
    end;
  result:=true;
end;

////////////////////////////////////////////////////////////////////////////////
//uncompression function
function my_uncompress(packet:PByte; _len:PLongint; complen:PLongint):boolean;
var
  compbuf:PByte;
begin
  if (complen^<>0)then //do we have anything to uncompress
    begin
      getmem(compbuf,complen^);
      if (compbuf=nil)then //out of memory
        begin
          result:=false;
          exit;
        end;
      if (uncompress(compbuf, complen, packet, _len^) <>0)then //try to uncompress
        begin
          freemem(compbuf);
          result:=false;
          exit;
        end;
      _len^ := complen^; //give back the uncompressed packet
      _memcpy(packet,compbuf,_len^);
      freemem(compbuf);
    end;
  result:=true;
end;
{$ENDIF} //HAVE_COMPRESS

//------------------------------------------------------------------------------
{ TMysqlNet }
//------------------------------------------------------------------------------

////////////////////////////////////////////////////////////////////////////////
// class constructor
constructor TMysqlNet.create;
begin
  inherited;
  //create a vio
  fvio:= TMysqlVIO.Create;
end;

////////////////////////////////////////////////////////////////////////////////
// class destructor
destructor TMysqlNet.destroy;
begin
  if assigned(fvio) then
    begin
      fvio.Free;
      fvio:=nil;
    end;
  if fbuff<>nil then
    begin
      freemem(fbuff);
      fbuff:=nil;
    end;
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////
// maps vio last_error to net last_error
function TMysqlNet.Getlast_error: string;
begin
  result:=fvio.last_error;
end;

////////////////////////////////////////////////////////////////////////////////
// maps vio last_errno to net last_errno
function TMysqlNet.Getlast_errorno: cardinal;
begin
  result:=fvio.last_errno;
end;