⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umysqlnet.pas

📁 RO模拟器!!适合玩仙境传说的玩家们呦~
💻 PAS
📖 第 1 页 / 共 3 页
字号:

////////////////////////////////////////////////////////////////////////////////
// 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;
     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;
    complen:cardinal;
    b:pchar;
    p1:longint;
    en:longint;
    header_length:byte;
    pac:pchar;
begin
     if fVio.VIO_type<>VIO_CLOSED then //are we connected?
     begin
     pac:=stralloc(len1); //get some memory ???
     move(packet1[0],pac^,len1);
     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);
          inc(fpkt_nr);
          len1:=len1+ header_length;
          strdispose(pac);
          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.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}
     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: 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;
               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
     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
              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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -