umysqlnet.pas

用delphi连接mysql的组件

////////////////////////////////////////////////////////////////////////////////
// returns true if we have a connection to the server
function TMysqlNet.GetNetConnected: boolean;
begin
  result:=fvio.VIO_type<>VIO_CLOSED;
end;

////////////////////////////////////////////////////////////////////////////////
// reads a packet from VIO and decompress it if needed
function TMysqlNet.my_net_read: longint;
var
  len1, complen: longint;
  {$IFDEF HAVE_COMPRESS}
  len2:longint;
  p:pchar;
  {$ENDIF}
begin
  complen:=0;
  {$IFDEF HAVE_COMPRESS}
  len1:=0;
  if not(fcompress) then //if we use compression
  {$ENDIF}
    begin
      len1 := my_real_read (complen); //is there anything to read?
      fread_pos := longint(fbuff) + fwhere_b; //where are we?
      if (len1 <> packet_error) then
        pchar(fread_pos)[len1]:=#0;
      result:=len1;
      exit; //<- not needed
    end;
  {$IFDEF HAVE_COMPRESS}
  if (fremain_in_buf<>0) then
    pchar(fbuff)[fbuf_length - fremain_in_buf]:=fsave_char; //restore the saved char
  while true do
    begin
      if (fremain_in_buf<>0) then
        begin
          p := pchar(longint(fbuff) + fbuf_length - fremain_in_buf);
          if (fremain_in_buf >= 4) then //read next packet
            begin
              len2 :=byte(p[0])+(byte(p[1])shl 8)+(byte(p[2])shl 16);
              if (len2 <= fremain_in_buf - 4) then
                begin
                  len1:=len2;
                  fremain_in_buf :=fremain_in_buf - (len2 + 4);
                  fread_pos:=longint(p) + 4;
                  break;
                end;
            end;
          if (fbuf_length <> fremain_in_buf)then
            begin
              move(p[0],pointer(fbuff)^,fremain_in_buf);
              fbuf_length:=fremain_in_buf;
            end;
          fwhere_b:=fbuf_length;
        end
      else
        begin
          fwhere_b:=0;
          fbuf_length:=0;
        end;
      len1:=my_real_read(complen); //another read
      if (len1 = packet_error) then
        break;
      if not(my_uncompress(pbyte(longint(fbuff) + fwhere_b),@len1, @complen)) then //now we can uncompress
        begin
          len1:= packet_error;
          break;
        end;
      fbuf_length:=fbuf_length+len1;
      fremain_in_buf:=fremain_in_buf+len1;
    end;
  if (len1 <> packet_error) then
    begin
      fsave_char:= pchar(fread_pos)[len1]; //save the next char (first on new packet)
      pchar(fread_pos)[len1]:=#0; //and make it #0 for pchar operations
    end;
  result:=len1;
  {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
// writes a packet to vio
function TMysqlNet.my_net_write(const packet: PCHAR;
  len1: cardinal): longint;
var
  buf:array[0..NET_HEADER_SIZE-1]of char;
begin
  if (len1 >= MAX_PACKET_LENGTH) then
    begin
      last_errno:=ER_NET_PACKET_TOO_LARGE;
      result:=1;
      exit;
    end;
  buf[0]:= chr(len1);
  buf[1]:= chr((len1) shr 8);
  buf[2]:= chr((len1) shr 16);
  if fcompress then //if compressed packet no. is 0
    buf[3]:= #0
  else
    begin
      buf[3]:=chr(fpkt_nr); //inc packet no.
      if fpkt_nr=255 then
        fpkt_nr:=0
      else
        inc(fpkt_nr);
    end;
  if net_write_buff(buf,NET_HEADER_SIZE)<>0 then //write the header
    result:=1
  else
    result:=net_write_buff(packet,len1); //write the packet
end;

////////////////////////////////////////////////////////////////////////////////
// low level read
//todo clean this code
function TMysqlNet.my_real_read(var complen: Integer): longint;
var
  p:longint;
  leng:longint;
  retr_count:longint;
  i,len1:longint;
  net_blocking:boolean;
  remain:longint;
  helping:longint;
begin
  if fVio.VIO_type<>VIO_CLOSED then //are we connected to read?
    begin
      retr_count:=0;
      len1:=packet_error;
      net_blocking:=not (fvio.fcntl_mode and 1=1); //save blocking mode
      if fcompress then //calculate next packet size
        remain:=NET_HEADER_SIZE+COMP_HEADER_SIZE
      else
         remain:=NET_HEADER_SIZE;
      freading_or_writing:=1; //mark reading
      p := longint(fbuff) + fwhere_b;
      complen := 0;
      for i:=0 to 1 do //try twice
        begin
          while (remain > 0) do  //do we have anything anymore to read?
            begin
              leng:=fvio.vio_read(pchar(p),remain); //let's read
              if (leng <= 0) then //we got an error?
                begin
                  if (fvio.vio_should_retry) then
                    begin
                      inc(retr_count);
                      if (retr_count<= RETRY_COUNT) then //shall we retry?
                        continue;
                    end;
                  if (fvio.vio_intrerupted) then //just intrerupted
                    continue;
                  len1:= packet_error; //oops ...error
                  fvio.vio_blocking(net_blocking); //restore blocking mode
                  freading_or_writing:=0;
                  result:=len1;
                  exit;
                end;
              remain := remain-leng; //we read some
              p:=p+leng;
            end;
          if (i = 0)then //first try?
            begin
              if (pchar(fbuff)[fwhere_b + 3] <> chr(fpkt_nr)) then //wrong packet?
                begin
                  len1:= packet_error;
                  fvio.vio_blocking(net_blocking); //restore blocking mode
                  freading_or_writing:=0;
                  result:=len1;
                  exit;
               end;
              if fpkt_nr=255 then
                fpkt_nr:=0
              else
                inc(fpkt_nr);
              {$IFDEF HAVE_COMPRESS}
              if (fcompress) then  //calculate compressed size
                complen:=byte(pchar(fbuff)[fwhere_b + NET_HEADER_SIZE])+(byte(pchar(fbuff)[fwhere_b + NET_HEADER_SIZE+1]) shl 8)+(byte(pchar(fbuff)[fwhere_b + NET_HEADER_SIZE+2])shl 16);
              {$ENDIF}
              len1:=byte(pchar(fbuff)[fwhere_b])+(byte(pchar(fbuff)[fwhere_b+1]) shl 8)+(byte(pchar(fbuff)[fwhere_b+2])shl 16);
              if len1>complen then
                helping := len1+ fwhere_b
              else
                helping := complen + fwhere_b;

              if (helping >= fmax_packet) then //do we have enough space to read the packet?
                if not(net_realloc(helping+1)) then //make some
                  begin //out of memory?
                    len1:= packet_error;
                    fvio.vio_blocking(net_blocking); //restore blocking mode
                    freading_or_writing:=0;
                    result:=len1;
                    exit;
                  end;
              p:=longint(fbuff) + fwhere_b;
              remain := len1;
            end;
        end;
      fvio.vio_blocking(net_blocking); //restore blocking mode
      freading_or_writing:=0;
      result:=len1;
    end
  else
    result:=-1;
end;

////////////////////////////////////////////////////////////////////////////////
// clears the net making it read for use into a new command
// if there is any previos packets waiting just ignore them
procedure TMysqlNet.net_clear;
{$IFDEF _WIN_}
{$IFDEF NEVERENABLEME}
var
  count:longint;
  tmp:integer;
  is_blocking:boolean;
{$ENDIF}
{$ENDIF}
begin
  {$IFDEF _WIN_}
  {$IFDEF NEVERENABLEME}
  tmp:=fvio.ftimeout; //save timeoutvalue
  fvio.ftimeout:=0;//make it quick
  is_blocking:=not (fvio.fcntl_mode and 1=1);
  if (is_blocking) then
    fvio.vio_blocking(false);
  if not(not (fvio.fcntl_mode and 1=1))then
    begin
      count:=fvio.vio_read(fbuff,fmax_packet);
      while (count > 0) do
        count:=fvio.vio_read(fbuff,fmax_packet);
      if (is_blocking) then
        fvio.vio_blocking(true);
    end;
  fvio.ftimeout:=tmp; //restore timeoutvalue
  {$ENDIF}
  {$ENDIF}
  fpkt_nr:=0;
  fwrite_pos:=longint(fbuff);
end;

////////////////////////////////////////////////////////////////////////////////
//closes vio and release the buffer memory
function TMysqlNet.net_close: longint;
begin
  result:=0;
  if fVio.VIO_type<>VIO_CLOSED then
    begin
      result:=fvio.vio_close;
      freemem(fbuff);
      fbuff:=nil;
      fmax_packet:=0;
    end;
end;

////////////////////////////////////////////////////////////////////////////////
// send any packets that could be waiting in buffer
function TMysqlNet.net_flush: longint;
var
  error:longint;
begin
  error:=0;
  if (longint(fbuff) <> fwrite_pos) then //do we have anything in buffer?
    begin
      error:=net_real_write(fbuff,(fwrite_pos - longint(fbuff)));
      fwrite_pos:=longint(fbuff);
    end;
  result:=error;
end;

////////////////////////////////////////////////////////////////////////////////
// opens vio for read/write and allocates memory for buffer
function TMysqlNet.net_open(VioType: TEnumVioType; host, unix_socket: string;
  port: Integer; connect_timeout: cardinal; trysock: boolean): longint;
begin
  result:=0;
  if fVio.VIO_type=VIO_CLOSED then
    begin
      result:=fVio.vio_open(VioType,host,unix_socket,port,connect_timeout,trysock);
      if result=0 then //we are connected
        begin
          //get a buffer for reading/writing
          if (fbuff <> nil) then
            freemem(fbuff);
          getmem(fbuff,net_buffer_length);
          fmax_packet:=net_buffer_length;
          fwrite_pos:=longint(fbuff);
          fread_pos := longint(fbuff);
          fpkt_nr:=0;
          fcompress:=false;
          fbuf_length:=net_buffer_length;
          fwhere_b := 0;
          fremain_in_buf:=0;
          fprotocol_version:=10;
          freading_or_writing:=0;
          fsave_char:=#0;
        end;
    end;
end;

////////////////////////////////////////////////////////////////////////////////
// if after a big row operation we want to release some memory this does it
// it just reallocs the buffer to be "net_buffer_length" size
// returns true on no error
function TMysqlNet.net_pack: boolean;
begin
  if freading_or_writing=0 then //if we are not reading/writing
  if fbuf_length>net_buffer_length then
    begin
      reallocmem(fbuff,net_buffer_length);
      if (fbuff=nil)then
        begin
          result:=false;
          exit;