umysqlclient.pas

用delphi连接mysql的组件

    begin
      fserver_status:=fserver_status and not SERVER_STATUS_IN_TRANS;
      result:=false;
      exit;
    end;
  //fnet.net_close;
  if not connect then
    result:=false
  else
    result:=true;
end;

////////////////////////////////////////////////////////////////////////////////
// internal send file to server for use with load data infile on client machine
function TMysqlClient.send_file_to_server(const filename: string): longint;
var
  readcount:longint;
  buf:array[0..IO_SIZE*15-1] of char;
  f:file;
  tmp:byte;
begin
  //todo     fn_format(buf,filename,"","",4);
  assignfile(f,filename);
  tmp:=filemode; //old filemode
  filemode:=0; //read only
  {$I-}
  reset(f,1); //try to open the file
  {$I+}
  if (IOResult<> 0) then
    begin
      fnet.last_errno:=0;// EE_FILENOTFOUND
      fnet.last_error:=copy(format('File ''%s'' not found (Errcode: %d)',[filename,IOResult]),1,length(fnet.last_error));
      fnet.my_net_write('',0); //send empty packet to server
      fnet.net_flush;
      result:=-1;
      filemode:=tmp;
      exit;
    end;
  blockread(f,buf,sizeof(buf),readcount); //let's send the file
  while (readcount > 0) do //while we still have things in file
    begin
      if (fnet.my_net_write(buf,readcount)<>0) then //maybe we have errors?
        begin
          fnet.last_errno:=CR_SERVER_LOST;
          fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
          closefile(f);
          result:=-1;
          filemode:=tmp;
          exit;
        end;
      blockread(f,buf,sizeof(buf),readcount); //read next chunk
    end;
  closefile(f); //close the file
  if (fnet.my_net_write('',0)<>0) or (fnet.net_flush<>0) then //send empty packet to mark eof
    begin
      fnet.last_errno:=CR_SERVER_LOST;
      fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
      result:=-1;
      filemode:=tmp;
      exit;
    end;
  if (readcount < 0) then //did by any chance we had an error while reading?
    begin
      fnet.last_errno:=2;//EE_READ
      fnet.last_error:=copy(format('Error reading file ''%s'' (Errcode: %d)',[filename,IOResult]),1,sizeof(fnet.last_error)-1);
      result:=-1;
      filemode:=tmp;
      exit;
    end;
  filemode:=tmp; //restore filemode
  result:=0;
end;

////////////////////////////////////////////////////////////////////////////////
//returns client version
function TMysqlClient.GetClientInfo: string;
begin
  result:=MYSQL_SERVER_VERSION;
end;

////////////////////////////////////////////////////////////////////////////////
// returns protocol version - one should read this only after connecting
// or else will be 0
function TMysqlClient.Getprotocol_version: cardinal;
begin
  result:=fnet.protocol_version;
end;

////////////////////////////////////////////////////////////////////////////////
//internal function to send a command to the server
function TMysqlClient.simple_command(command: TEnumServerCommand;
  arg: pchar; lengt: Integer; skipp_check: boolean; retry:boolean): longint;
var
  pl:longint;
begin
  result:= -1; //mark error unless ok
  if not fnet.net_connected then //are we connected?
    begin
      if not(reconnect) then //attempt to reconnect
        begin
          //preserve the error on connect
          //fnet.last_errno:=CR_SERVER_GONE_ERROR;
          //fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
          exit;
        end
    end;
  if (fstatus <> MYSQL_STATUS_READY) then //can we execute this command?
    begin
      fnet.last_errno:=CR_COMMANDS_OUT_OF_SYNC;
      fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
      exit;
    end;
  fnet.last_error:=''; //init for command
  fnet.last_errno:=0;
  finfo:='';
  faffected_rows:= 0;
  finsert_id:=0;
  FWarningCount:= 0;
  fnet.net_clear;
  if (fnet.net_write_command(chr(ord(command)),pchar(arg),lengt )<>0) then //let's try to send
    begin
      fnet.net_close;//end_server
      free_old_query;
      if reconnect or (fnet.net_write_command(chr(ord(command)),pchar(arg),lengt)<>0)then //another attempt to reconnect end send
        begin
          //failed
          fnet.last_errno:=CR_SERVER_GONE_ERROR;
          fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
          exit;
        end;
    end;
  result:=0; //no error
  if (not skipp_check) then //if we need to check if server got it
    begin
      pl:=fnet.net_safe_read(fclient_flag); //read length of next packet
      if pl = packet_error then //if there is something
        begin
          if fnet.last_errno=CR_SERVER_LOST then
            close;
          if retry then //one more time, but in order to not make it infinite loop this time will not retry
            result:=simple_command(command,arg,lengt,skipp_check,false) //this time we do not retry
          else
            result:=-1;
        end
      else
        result:=0; //ok
    end;
end;

////////////////////////////////////////////////////////////////////////////////
// returns last error string (mapped on NET, actually down to VIO)
function TMysqlClient.GetLastError: string;
begin
  result:=fnet.last_error;
end;

////////////////////////////////////////////////////////////////////////////////
// reads one row from the server
// returns 0 if no error
// returns 1 if there arent anymore rows
function TMysqlClient.read_one_row(fields:longint;row:TMysql_Row;lengths:PCardinal): longint;
var
  field:longint;
  pkt_len, _len:longint;
  _pos, prev_pos:PChar;
begin
  // is there anything to read?
  pkt_len:=fnet.net_safe_read(fclient_flag);
  if (pkt_len=packet_error) then
    begin
      result:=-1;
      exit;
    end;
  // is it the last row?
  if (pkt_len < 8) and(pchar(fnet.read_pos)[0] = #254) then
    begin
      { new protocol }
      if fclient_flag and CLIENT_RESERVED = CLIENT_RESERVED then
        begin
          FWarningCount:=byte(pchar(fnet.read_pos)[1])+byte(pchar(fnet.read_pos)[2])shl 8;
          fserver_status:=byte(pchar(fnet.read_pos)[3])+byte(pchar(fnet.read_pos)[4])shl 8;
        end;
      result:=1;
      exit;
    end;
  //free row content
  for field:=0 to fields -1 do
    strdispose(TPPCA(row)[field]);
  //read next row
  prev_pos:= nil;
  _pos:=pchar(fnet.read_pos);
  // for each field value
  for field:=0 to fields-1 do
    begin
      //get field value size
      _len:=net_field_length(longint(_pos));
      if (_len=NULL_LENGTH) then
        begin
          TPPCA(row)[field] := nil;
          TPCA(lengths)[field]:= FNullLength;                                            
        end
      else
        begin
          TPPCA(row)[field]:=StrAlloc(_len+1);
          //copy field content
          if _len>0 then
            move(_pos[0],TPPCA(row)[field]^,_len);
          TPPCA(row)[field][_len]:=#0;// if one uses pchar
          _pos:=_pos+_len;
          TPCA(lengths)[field]:=_len+1;
        end;
      if (prev_pos<>nil)and(prev_pos[0]<>#0)then //if previous field value didnt ended by #0
        prev_pos[0]:=#0;
      prev_pos:=_pos; //move to next
    end;
  prev_pos[0]:=#0; //set the last #0
  result:=0;
end;

////////////////////////////////////////////////////////////////////////////////
// reads rows from the server
// returns data if no error
// returns nil if there were any errors
function TMysqlClient.read_rows(mysql_fields: PMysql_FieldDef; fields: Integer; var hadErrors:boolean): PMYSQL_DATA;
var
  pkt_len, field, len1:longint;
  cp:pchar;
  prev_ptr:PMysql_Rows;
  cur:PMysql_Rows;
begin
  result:=nil;
  hadErrors:=true;
  pkt_len:=fnet.net_safe_read(fclient_flag); //is there any data?
  if (pkt_len= packet_error) then
    exit;
  new(result);
  if (result=nil) then //out of memory?
    begin
      fnet.last_errno:=CR_OUT_OF_MEMORY;
      fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
      exit;
    end;
  result.data:=nil;
  prev_ptr:= nil;
  result.rows:=0;
  result.fields:=fields;
  cp:=pchar(fnet.read_pos);
  while not (( byte(cp[0]) = 254) and (pkt_len < 8)) do //do this until we get last row
    begin
      //here you could add a progress or something
      //like an event onNewRow <-disadvantage you can't tell how many left
      inc(result.rows); //we have new row
      //let's grab some memory for the new row
      new(cur);
      if cur<>nil then
        cur.data:=allocmem((fields)*sizeof(pchar));
      if (cur=nil) or (cur.data=nil) then
        begin //mmm.. we are running out of memory
          free_rows(result);
          fnet.last_errno:=CR_OUT_OF_MEMORY;
          fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
          result:=nil;
          exit;
        end;
      cur.Next:=nil; //so far we assume no more rows
      cur.prior:=prev_ptr; //double link
      if prev_ptr<>nil then
        prev_ptr.Next:= cur //preserve next link
      else
        result.data:=cur;//it is the first / head
      prev_ptr:=cur;
      for field:=0 to fields-1 do //for each field
        begin
          len1:=net_field_length(longint(cp));
          if (len1 = NULL_LENGTH) then //if it is an empty field
            TPPCA(cur.data)[field]:= nil
          else
            begin
              //let's grab some memory
              TPPCA(cur.data)[field]:=StrAlloc(len1+1);
              //copy field content
              if len1>0 then
                move(cp[0],TPPCA(cur.data)[field]^,len1);
              TPPCA(cur.data)[field][len1]:=#0;// if one uses pchar
	            cp:=pchar(longint(cp)+len1); //we can move to next field
	            if (mysql_fields<>nil) then //if we passed fields structure
                if  TPFDA(mysql_fields)[field].Max_Length < cardinal(len1) then
                  TPFDA(mysql_fields)[field].Max_Length := cardinal(len1);
            end;
        end;
      pkt_len:=fnet.net_safe_read(fclient_flag); //let's try to read next row /if any
	      if ( pkt_len= packet_error) then
        begin //maybe we got an error
          free_rows(result); //we can free the rows
          result:=nil;
          exit;
        end;
      cp:=pchar(fnet.read_pos); //here we go again .. next row
    end;
  { new protocol }
  if fclient_flag and CLIENT_RESERVED = CLIENT_RESERVED then
    begin
      FWarningCount:=byte(pchar(cp)[1])+byte(pchar(cp)[2])shl 8;
      fserver_status:=byte(pchar(cp)[3])+byte(pchar(cp)[4])shl 8;
    end;
  hadErrors:=false;
end;

////////////////////////////////////////////////////////////////////////////////
// internal decode of PMysql_Data into fields structure
function TMysqlClient.unpack_fields(data: PMYSQL_DATA; fields: Integer;long_flag_protocol:boolean; anew: boolean): PMysql_FieldDef;
var
  field:PMysql_FieldDef;
  row:PMysql_Rows;
  aFieldVal:pchar;
begin
  //let's grab some memory
  getmem(result,sizeof(TMysql_FieldDef)*fields);
  field:=result;
  if (result=nil) then //out of memory?
    exit;
  row:=data.data; //first row=first field def
  while row<>nil do
    begin
      if anew then
        begin
          aFieldVal:=TPPCA(row.data)[0];
          field.catalog:=StrNew(aFieldVal);
          aFieldVal:=TPPCA(row.data)[1];
          field.db:=StrNew(aFieldVal);
          aFieldVal:=TPPCA(row.data)[3];
          field.org_table:=StrNew(aFieldVal);
          aFieldVal:=TPPCA(row.data)[5];
          field.org_name:=StrNew(aFieldVal);
        end
      else
        begin
          field.catalog:=nil;
          field.db:=nil;
          field.org_table:=nil;
          field.org_name:=nil;
        end;
     
      //table
      if anew then
        aFieldVal:=TPPCA(row.data)[2]
      else
        aFieldVal:=TPPCA(row.data)[0];
      field.Table:=StrNew(aFieldVal);
      //name
      if anew then
        aFieldVal:=TPPCA(row.data)[4]
      else
        aFieldVal:=TPPCA(row.data)[1];
      field.Name:=strnew(aFieldVal);
      if anew then
        begin
          aFieldVal:=TPPCA(row.data)[6];
          if aFieldVal <> nil then
            begin
              field.charsetnr:= byte(pchar(aFieldVal[0])) + byte(pchar(aFieldVal[1])) shl 8;
              field.length:= byte(pchar(aFieldVal[2])) + byte(pchar(aFieldVal[3])) shl 8 + byte(pchar(aFieldVal[4])) shl 16 + byte(pchar(aFieldVal[5])) shl 24;
              field.Field_Type:= byte(pchar(aFieldVal[6])); 
              field.flags:= byte(pchar(aFieldVal[7])) + byte(pchar(aFieldVal[8])) shl 8;
              field.decimals:= byte(pchar(aFieldVal[9]));