umysqlnet.pas

用delphi连接mysql的组件

        end;
      fwrite_pos:=longint(fbuff);
      fread_pos:=longint(fbuff);
      fmax_packet:=net_buffer_length;
    end;
  result:=true;
end;

////////////////////////////////////////////////////////////////////////////////
// real write to vio (lowest level in net)
//todo clean this code
function TMysqlNet.net_real_write(packet1: pchar; len1: Integer): longint;
var
  leng:longint;
  retr_count:cardinal;
  net_blocking:boolean;
  {$IFDEF HAVE_COMPRESS}
  complen:cardinal;
  b:pchar;
  header_length:byte;
  {$ENDIF}
  p1:longint;
  en:longint;
  pac:pchar;
begin
  if fVio.VIO_type<>VIO_CLOSED then //are we connected?
    begin
      pac:=packet1; //get some memory ???
      retr_count:=0;
      net_blocking := not (fvio.fcntl_mode and 1=1);
      freading_or_writing:=2;
      {$IFDEF HAVE_COMPRESS}
      if (fcompress)then //are we using compression?
        begin
          header_length:=NET_HEADER_SIZE+COMP_HEADER_SIZE;
          b:=StrAlloc(len1 + NET_HEADER_SIZE + COMP_HEADER_SIZE);
          if b=nil then
            begin
              freading_or_writing:=0;
              result:=1;
              exit;
            end;
          p1:=longint(b)+header_length;
          move(pac[0],pointer(p1)^,len1);
          if not(my_compress(pbyte(longint(b)+header_length),@len1,@complen)) then //try compress it
            complen:=0;
          b[NET_HEADER_SIZE]:= chr(complen); //write compressed header
          b[NET_HEADER_SIZE+1]:= chr((complen) shr 8);
          b[NET_HEADER_SIZE+2]:= chr((complen) shr 16);
          b[0]:= chr(len1); //write packet header
          b[1]:= chr((len1) shr 8);
          b[2]:= chr((len1) shr 16);
          b[3]:=chr(fpkt_nr);
          if fpkt_nr=255 then
            fpkt_nr:=0
          else
            inc(fpkt_nr);
          len1:=len1+ header_length;
          pac:=b;
        end;
      {$ENDIF}
      p1:=longint(@pac);
      en:=longint(@pac)+len1;
      while (p1 <> en) do //walk the packet to send
        begin
          leng:=fvio.vio_write(pchar(p1),(en-p1)); //write
          if (leng<= 0) then //we got an error
            begin
              if (fvio.fcntl_mode and 1=1) then //are we in blocking mode?
                begin
                  fvio.vio_blocking(true);
                  inc(retr_count);
                  if (retr_count <= RETRY_COUNT) then
                    continue;
                end;
              if (fvio.vio_should_retry) then //should retry?
                begin
                  inc(retr_count);
                  if (retr_count <= RETRY_COUNT) then
                    continue;
                end;
              if (fvio.vio_intrerupted) then //try on more time
                continue;
              break;
            end;
          p1:=p1+leng;
        end;
      {$IFDEF HAVE_COMPRESS}
      if pac<>packet1 then
        strdispose(pac);
      {$ENDIF}
      fvio.vio_blocking(net_blocking);
      freading_or_writing:=0;
      if p1<>en then //did we send everything
        result:=2
      else
         result:=0;
    end
  else
    result:=-1; //we are not connected
end;

////////////////////////////////////////////////////////////////////////////////
// if we get a bigger packet than what the buffer can store we need to resize it
// returns true on no error
function TMysqlNet.net_realloc(len1: cardinal): boolean;
var
  pkt_length:cardinal;
begin
  if (len1 >= max_allowed_packet) then //arent we over the max packet size?
    begin
      fvio.last_errno:=ER_NET_PACKET_TOO_LARGE;
      result:=false;
      exit;
    end;
  pkt_length := (len1+IO_SIZE-1) AND (NOT(IO_SIZE-1)); //rather than doing it in bytes we do it in chunks of 4k
  reallocmem(fbuff,pkt_length);
  if (fbuff=nil)then //did realloc worked?
    begin
      result:=false;
      exit;
    end;
  //point read/write to the new buffer
  fwrite_pos:=longint(fbuff);
  fread_pos:=longint(fbuff);
  fmax_packet:=pkt_length; //set the new max packet
  result:=true;
end;

////////////////////////////////////////////////////////////////////////////////
// a special read which just checks for errors from server
function TMysqlNet.net_safe_read(fclient_flag: integer): longint;
var
  len1:longint;
  p:pchar;
begin
  len1:=my_net_read; //try to read
  if (len1 = packet_error) or (len1 = 0) then
    begin //we got an error
      fvio.vio_close;//end_server
      //this may need to be replaced to reconnect
      //rather than server lost and stop
      if fvio.last_errno = ER_NET_PACKET_TOO_LARGE then
        fvio.last_errno:=CR_NET_PACKET_TOO_LARGE
      else
        fvio.last_errno:=CR_SERVER_LOST;
      //maybe we need this in both cases
      fvio.last_error:=client_errors[(fvio.last_errno)-CR_MIN_ERROR];
      result:=packet_error;
      exit;
    end;
  if (pchar(fread_pos)[0] = #255)then //was it an error from server?
    begin
      if (len1 > 3) then
        begin
          p:=pchar(fread_pos+1);
          if (fprotocol_version > 9) then
            begin
              fvio.last_errno:=byte(p[0])+byte(p[1])shl 8;
              p:=p+2;
              len1:=len1-2;
              if fclient_flag and CLIENT_RESERVED = CLIENT_RESERVED then
                if p[0] = '#' then
                  begin
                    { todo store mysql state here }
                    p:= p+6;
                    len1:= len1-6;
                  end;
            end
          else
            begin
              fvio.last_errno:=CR_UNKNOWN_ERROR;
              dec(len1);
            end;
          if len1<MYSQL_ERRMSG_SIZE-1 then //save the error
            fvio.last_error:=copy(p,1,len1)
          else
            fvio.last_error:=copy(p,1,MYSQL_ERRMSG_SIZE-1);
        end
      else
        begin
          fvio.last_errno:=CR_UNKNOWN_ERROR;
          fvio.last_error:=client_errors[(fvio.last_errno)-CR_MIN_ERROR];
        end;
      result:=packet_error;
      exit;
    end;
  result:=len1; //no errors return the size
end;

////////////////////////////////////////////////////////////////////////////////
// writes a packet into the buffer (this will not send over net)
function TMysqlNet.net_write_buff(packet: pchar; len1: Integer): longint;
var
  left_length:longint;
begin
  left_length:=((longint(fbuff)+fmax_packet) - fwrite_pos); //how much space left in buffer?
  while (len1 > left_length) do
    begin
      move(packet[0],pointer(fwrite_pos)^,left_length); //send chunks of buffer size
      if (net_real_write(fbuff,fmax_packet)<>0)then
        begin
          result:=1; //on error stop sending
          exit;
        end;
      fwrite_pos:=longint(fbuff); //move at beginning of the buffer
      packet:=packet+left_length; //move the packet
      len1:=len1-left_length; //left length to send
      left_length:=fmax_packet; //maximum chunk size
    end;
  move(packet[0],pointer(fwrite_pos)^,len1); //move the last part of the packet
  fwrite_pos:=fwrite_pos+len1; // move the write cursor into the buffer to point to the new position (this didnt cleared the buffer)
  result:=0; //no errors
end;

////////////////////////////////////////////////////////////////////////////////
// same as write_buff except we have a command id in front and flush the buffer
// right away
function TMysqlNet.net_write_command(command: char; const packet: pchar;
  len1: cardinal): longint;
var
  buff:array[0..NET_HEADER_SIZE] of char;
begin
  if (len1 >= MAX_PACKET_LENGTH) then
    begin
      last_errno:=ER_NET_PACKET_TOO_LARGE;
      result:=1;
      exit;
    end;
  buff[0]:= chr(len1+1);
  buff[1]:= chr((len1+1) shr 8);
  buff[2]:= chr((len1+1) shr 16);
  if fcompress then //if using compress packet no in header is 0
    buff[3]:= #0
  else
    begin
      buff[3]:=chr(fpkt_nr); //else write the packet no
      if fpkt_nr=255 then
        fpkt_nr:=0
      else
        inc(fpkt_nr); //increment it
    end;
  buff[4]:=command;
  if net_write_buff(buff,5)<>0 then //send the header
    result:=1
  else
    if net_write_buff(packet,len1)<>0 then //send the packet
      result:=1
    else
      if net_flush<>0 then //flush the buffer
        result:=1
      else
        result:=0;
end;

////////////////////////////////////////////////////////////////////////////////
// sets the compress flag (enabled only when using compression)
procedure TMysqlNet.setcompress(const Value: boolean);
begin
  {$IFDEF HAVE_COMPRESS}
  fcompress := Value;
  {$ELSE}
  fcompress:=false;
  {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
// maps vio last_error to net last_error
procedure TMysqlNet.Setlast_error(const Value: string);
begin
  fvio.last_error := Value;
end;

////////////////////////////////////////////////////////////////////////////////
// maps vio last_errno to net last_errno
procedure TMysqlNet.Setlast_errorno(const Value: cardinal);
begin
  fvio.last_errno:=Value;
end;

////////////////////////////////////////////////////////////////////////////////
// maps vio type to net vio type
function TMysqlNet.GetVioType: TEnumVioType;
begin
  result:=fvio.VIO_type;
end;

{$IFDEF HAVE_SSL}
////////////////////////////////////////////////////////////////////////////////
// tells vio to go to ssl
procedure TMysqlNet.SwitchToSSL(const key_file:pchar;const cert_file:pchar;const ca_file:pchar;const ca_path:pchar;var cipher:pchar; timeout:cardinal);
begin
  fvio.SwitchToSSL(key_file,cert_file,ca_file,ca_path,cipher,timeout);
  if fvio.VIO_type<>VIO_TYPE_SSL then
    net_close; //we can't switch to ssl ... close the net
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////
// get it from vio
function TMysqlNet.GetNoTimeOut: Boolean;
begin
  result:=fvio.NoTimeOut;
end;

////////////////////////////////////////////////////////////////////////////////
// make sure it gets to vio
procedure TMysqlNet.SetNoTimeOut(const Value: Boolean);
begin
  fvio.NoTimeOut:=Value;
end;

end.