umysqlclient.pas

MYSQL 连接控件 MYSQL 连接控件

                          (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.FieldType:= byte(pchar(aFieldVal)[6]);
        field.flags:= (byte(pchar(aFieldVal)[7]))+
                      (byte(pchar(aFieldVal)[8]))shl 8;
        if (field.FieldType in [FIELD_TYPE_BLOB,FIELD_TYPE_TINY_BLOB,FIELD_TYPE_MEDIUM_BLOB,FIELD_TYPE_LONG_BLOB]) and (field.flags and BLOB_FLAG=0) then
           field.flags := field.flags or BLOB_FLAG;
        field.decimals:= byte(pchar(aFieldVal)[9]);
        if (field.FieldType<=FIELD_TYPE_INT24) AND ((field.FieldType<>FIELD_TYPE_TIMESTAMP) OR (field.Length=14) OR (field.Length=8)) OR (field.FieldType=FIELD_TYPE_YEAR) then
          field.flags:=field.flags or NUM_FLAG;
//        aFieldVal:=TPPCA(row.data)[7];
//        if False and (aFieldVal<>nil)and(data.fields=7) then //if there are 7 fields on PMysql_Data
//          field.def:=strnew(aFieldVal);
      end else begin
         //table
         aFieldVal:=TPPCA(row.data)[0];
         field.Table:=StrNew(aFieldVal);
         //name
         aFieldVal:=TPPCA(row.data)[1];
         field.Name:=strnew(aFieldVal);
         //length
         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.FieldType:= byte(pchar(aFieldVal)[0]);
         //NUM_FLAG is not send from server so it needs to be set
         if (field.FieldType<=FIELD_TYPE_INT24) AND ((field.FieldType<>FIELD_TYPE_TIMESTAMP) OR (field.Length=14) OR (field.Length=8)) OR (field.FieldType=FIELD_TYPE_YEAR) then
           field.flags:=field.flags or NUM_FLAG;
         //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;
         //default value
         field.def:=nil;
         aFieldVal:=TPPCA(row.data)[5];
         if (aFieldVal<>nil)and(data.fields=6) then //if there are 6 fields on PMysql_Data
           field.def:=strnew(aFieldVal);
         field.Max_Length:= 0; //for the moment we don't know the max_length
      end;
      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;
    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;
  i: byte;
begin
  //anything to be read?
  length1 := fnet.net_safe_read;
  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();
      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
      if (fserver_capabilities and CLIENT_TRANSACTIONS=CLIENT_TRANSACTIONS) then
        begin
          fserver_status:=byte(pchar(pos1)[0])+byte(pchar(pos1)[0])shl 8;
          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 protocol41 then i := 7
  else i := 5;
  fields:=read_rows(nil,i,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);
  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));
    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);
    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;
  result:=ResultClass.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;
  ffields:=nil;
  ffield_count:=0;
  fstatus:=MYSQL_STATUS_READY;
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:=ResultClass.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,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;
  //create a row for use
  result.frow:=allocmem((ffield_count)*sizeof(pchar));
  result.fcurrent_row:=result.frow;
  if (result.frow=nil) then //out of memory?
    begin
      FreeMem(result.flengths);
      FreeAndNil(result);
      result:=nil;
      exit;
    end;
  result.ffields:=ffields;
  for i:=0 to result.ffieldscount-1 do
    TPPCA(result.frow)[i]:=nil;
  result.frowscount:=0;
  result.ffieldscount:=ffield_count;
  fstatus:=MYSQL_STATUS_USE_RESULT; //block other queryes
  fusedresult:=result; //set the link
  result.Next;//read first row
  result.fBOF:=true; //next has reset it ..
  ffields:=nil;
  ffield_count:=0;
end;

////////////////////////////////////////////////////////////////////////////////
// internal free of a previous query
procedure TMysqlClient.free_old_query;
var
  i:longint;
  afp:TMysql_fieldDef;
begin
  if (f