umysqlclient.pas

用delphi连接mysql的组件

            end
          else
            begin
              field.charsetnr:= 0;
              { should never happend ?}
              field.length:= 0;
              field.Field_Type:= 0; 
              field.flags:= 0;
              field.decimals:= 0;
            end;
        end
      else
        begin
          //length
          field.charsetnr:= 0;
          aFieldVal:=TPPCA(row.data)[2];
          if aFieldVal<>nil then
            field.length:= (byte(pchar(aFieldVal)[0]))+
                           (byte(pchar(aFieldVal)[1]))shl 8+
                           (byte(pchar(aFieldVal)[2]))shl 16;
          //field type
          aFieldVal:=TPPCA(row.data)[3];
          if aFieldVal<>nil then
            field.Field_Type:= byte(pchar(aFieldVal)[0]);
          //flags and decimals
          aFieldVal:=TPPCA(row.data)[4];
          if aFieldVal<>nil then
            begin
              if (long_flag_protocol) then
                begin
                  field.flags:= (byte(pchar(aFieldVal)[0]))+
                                (byte(pchar(aFieldVal)[1]))shl 8;
                  field.decimals:=byte(pchar(aFieldVal)[2]);
                end
              else
                begin
                  field.flags:= byte(pchar(aFieldVal)[0]);
                  field.decimals:=byte(pchar(aFieldVal)[1]);
                end;
            end;
        end;
      //NUM_FLAG is not send from server so it needs to be set
      if (field.Field_Type<=FIELD_TYPE_INT24) AND ((field.Field_Type<>FIELD_TYPE_TIMESTAMP) OR (field.Length=14) OR (field.Length=8)) OR (field.Field_Type=FIELD_TYPE_YEAR) then
        field.flags:=field.flags or NUM_FLAG;
      //default value
      field.def:=nil;
      if (data.fields=6)or((data.fields=8) and anew) then
        begin
          if anew then
            aFieldVal:=TPPCA(row.data)[7]
          else
            aFieldVal:=TPPCA(row.data)[5];
          if (aFieldVal<>nil) then //if there are 6 fields on PMysql_Data
            field.def:=strnew(aFieldVal);
        end;
      field.Max_Length:= 0; //for the moment we don't know the max_length
      { set the lengths }
      if field.name <> nil then
        field.name_length:= StrLen(field.name)
      else
        field.name_length:= 0;
      if field.org_name <> nil then
        field.org_name_length:= StrLen(field.org_name)
      else
        field.org_name_length:= 0;
      if field.table <> nil then
        field.table_length:= StrLen(field.table)
      else
        field.table_length:= 0;
      if field.org_table <> nil then
        field.org_table_length:= StrLen(field.org_table)
      else
        field.org_table_length:= 0;
      if field.db <> nil then
        field.db_length:= StrLen(field.db)
      else
        field.db_length:= 0;
      if field.catalog <> nil then
        field.catalog_length:= StrLen(field.catalog)
      else
        field.catalog_length:= 0;
      if field.def <> nil then
        field.def_length:= StrLen(field.def)
      else
        field.def_length:= 0;
      
      row := row.next; //next field def
      field:=@TPFDA(field)[1];
    end;
  free_rows(data); //we can now free data since all values are in fields
end;

////////////////////////////////////////////////////////////////////////////////
// closes the connection to mysql server
procedure TMysqlClient.close;
var
  rec:boolean;
begin
  if FThreaded then
    FCriticalSection.Enter;
  try
    //init internal variables
    fscramble_buff:='';
    fthread_id:=0;
    faffected_rows:=0;
    finsert_id:=0;
    FWarningCount:=0;
    fstatus:=MYSQL_STATUS_READY;
    fserver_version:='';
    fserver_capabilities:=0;
    fserver_status:=SERVER_STATUS_AUTOCOMMIT;
    fserver_language:=0;
    fextra_info:=0;
    finfo:='';
    if fnet.net_connected then //are we connected?
      begin
        free_old_query; //if we have anything in buffer
        fstatus:=MYSQL_STATUS_READY;
        rec:=freconnect; //preserve reconnect state
        freconnect:=false;
        simple_command(COM_QUIT,'',0,true,freconnect); //tell the server we go
        fnet.net_close;
        freconnect:=rec;
        //should init all server variables
      end;
    if assigned(fusedresult) then
      begin
        fusedresult.fhandle:=nil; //break the link
        fusedresult:=nil;
      end;
  finally
    if FThreaded then
      FCriticalSection.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// reads a query result
function TMysqlClient.read_query_result:longint;
var
  pos1:longint;
  field_count:longint;
  fields:pointer;
  length1:longint;
  error:longint;
  ae:boolean;
begin
  //anything to be read?
  length1 := fnet.net_safe_read(fclient_flag);
  if (length1= packet_error) then
    begin
      result:=-1;
      exit;
    end;
  free_old_query; //if we had something before

  pos1:=fnet.read_pos;
  field_count:= net_field_length(pos1); //how many fields?

  while (field_count = NULL_LENGTH) do //send file to server
    begin
      error:=send_file_to_server(pchar(pos1));
      length1:=fnet.net_safe_read(fclient_flag);
      if ( length1= packet_error) or (error<>0)then //any errors?
        begin
          result:=-1;
          exit;
        end;
      pos1:=fnet.read_pos; //maybe we need to send another file
      field_count:= net_field_length(pos1);
    end;
  //no fields ... it was an executed query (eg insert)
  if (field_count = 0) then
    begin
      faffected_rows:= net_field_length_ll(pos1); //affected rows
      finsert_id:=net_field_length_ll(pos1); //last insert id
      //we can check for server status
      { new protocol }
      if fclient_flag and CLIENT_RESERVED = CLIENT_RESERVED then
        begin
          fserver_status:=byte(pchar(pos1)[0])+byte(pchar(pos1)[1])shl 8;
          FWarningCount:=byte(pchar(pos1)[2])+byte(pchar(pos1)[3])shl 8;
          pos1:=pos1+4;
        end
      else
        if (fserver_capabilities and CLIENT_TRANSACTIONS=CLIENT_TRANSACTIONS) then
          begin
            fserver_status:=byte(pchar(pos1)[0])+byte(pchar(pos1)[1])shl 8;
            FWarningCount:= 0;
            pos1:=pos1+2;
          end;
      //aditional info
      if (pos1 < fnet.read_pos+length1) and (net_field_length(pos1)<>0) then
        finfo:=pchar(pos1);
      result:=0; //no errors
      exit;
    end;
  //we can switch the server in transaction
  if not (fserver_status and SERVER_STATUS_AUTOCOMMIT=SERVER_STATUS_AUTOCOMMIT) then
    fserver_status:=fserver_status or SERVER_STATUS_IN_TRANS;
  //get the extra info
  fextra_info:= net_field_length_ll(pos1);
  //now we can read result fields
  if fclient_flag and CLIENT_RESERVED = CLIENT_RESERVED then
    fields:=read_rows(nil,7,ae)
  else
    fields:=read_rows(nil,5,ae);
  if fields=nil then
    begin //out of memory?
      result:=-1;
      exit;
    end;
  //time to decode the fields
  ffields:=unpack_fields(fields,field_count,fserver_capabilities and CLIENT_LONG_FLAG=CLIENT_LONG_FLAG, fclient_flag and CLIENT_RESERVED = CLIENT_RESERVED);
  if (ffields=nil)then //out of memory?
    begin
      result:=-1;
      exit;
    end;
  //time to mark the waiting for result
  fstatus:=MYSQL_STATUS_GET_RESULT;
  ffield_count:=field_count;
  result:=0; //no errors
end;


////////////////////////////////////////////////////////////////////////////////
// lists the processes on the server
function TMysqlClient.list_processes: TMysqlResult;
var
  fields1:PMysql_Data;
  _pos:pchar;
  ae:boolean;
begin
  if FThreaded then
    FCriticalSection.Enter;
  try
    result:=nil;
    //send the command
    if (simple_command(COM_PROCESS_INFO,'',0,false,freconnect)<>0)then //if any errors
      exit;
    free_old_query; //if we had anything before
    //we can read the fields
    _pos:=pchar(fnet.read_pos);
    ffield_count:= net_field_length(longint(_pos));
    if fclient_flag and CLIENT_RESERVED = CLIENT_RESERVED then
      fields1:=read_rows(nil,7,ae)
    else
      fields1:=read_rows(nil,5, ae);
    if (fields1 = nil)then
      exit;
    //decode them
    ffields:=unpack_fields(fields1,ffield_count,fserver_capabilities and CLIENT_LONG_FLAG=CLIENT_LONG_FLAG, fclient_flag and CLIENT_RESERVED = CLIENT_RESERVED);
    if (ffields=nil) then
      exit;
    //we have the fields
    //we can now read the result
    fstatus:=MYSQL_STATUS_GET_RESULT;
    result:=store_result;
  finally
    if FThreaded then
      FCriticalSection.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// internal stores the query result
function TMysqlClient.store_result: TMysqlResult;
var
  ae:boolean;
begin
  result:=nil;
  //do we have anything to store?
  if (ffields=nil) then
    exit;
  //is the right order?
  if (fstatus <> MYSQL_STATUS_GET_RESULT) then
    begin
      fnet.last_errno:=CR_COMMANDS_OUT_OF_SYNC;
      fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
      exit;
    end;
  try
  result:=TMysqlResult.create(self,rtStored);
  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;
  //grab some memory for lengths - we use only one set of rowslengths for entire recordset
  getmem(result.flengths,ffield_count*sizeof(cardinal));
  if (result.flengths=nil)then //out of memory?
    begin
      fnet.last_errno:=CR_OUT_OF_MEMORY;
      fnet.last_error:= client_errors[(fnet.last_errno)-CR_MIN_ERROR];
      FreeAndNil(result);
      exit;
    end;
  //we can read the records
  result.fdata:=read_rows(ffields,ffield_count, ae);
  if result.fdata=nil then
    begin
      FreeAndNil(result);
      exit;
    end;
  result.fdata_cursor:=result.fdata.data;
  if result.fdata_cursor<>nil then
    begin
      result.fcurrent_row:=result.fdata_cursor.data;
      result.fEOF:=false;
      result.fRecNo:=0;
    end
  else
    begin
      result.fcurrent_row:=nil;
      result.fEOF:=true;
    end;
  result.ffields:=ffields;
  result.ffieldscount:=result.fdata.fields;
  result.frowscount:=result.fdata.rows;
  if ae then
    result.fLastRow:=-1 //means there was an error when reading
  else
    result.fLastRow:=1; //1 means the last row has been read without any errors
  faffected_rows:= result.frowscount;
  finally
    ffields:=nil;
    ffield_count:=0;
    fstatus:=MYSQL_STATUS_READY;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// internal creates a new result in use mode
// this means you read one row at a time ... very large memory savings if you
// don't need the entyre recordset ... ideal for processing data
function TMysqlClient.use_result: TMysqlResult;
var
  i:integer;
begin
  result:=nil;
  //is there anything to store?
  if (ffields=nil) then
    exit;
  //is it in the right order?
  if (fstatus <> MYSQL_STATUS_GET_RESULT) then
    begin
      fnet.last_errno:=CR_COMMANDS_OUT_OF_SYNC;
      fnet.last_error:=client_errors[(fnet.last_errno)-CR_MIN_ERROR];
      exit;
    end;
  //let's create a new result
  result:=TMysqlResult.create(self,rtUsed);
  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;
  //grab some memory for lengths
  getmem(result.flengths,ffie