umysqlclient.pas

RO模拟器!!适合玩仙境传说的玩家们呦~

////////////////////////////////////////////////////////////////////////////////
// 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;
     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
     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);
     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
     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;
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:=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);
     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:=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,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 (ffields<>nil) then
     begin
          for i:=0 to ffield_count-1 do //free the fields content
          begin
               afp:=TPFDA(ffields)[i];
               strdispose(afp.Name);
               strdispose(afp.Table);
               //strdispose(afp.Def);//*** removed
               afp.Name:=nil;
               afp.Table:=nil;
               //afp.Def:=nil;//*** removed
          end;
          freemem(ffields); //free fields pointer
     end;
     ffields:=nil;
     ffield_count:=0;
end;

////////////////////////////////////////////////////////////////////////////////
// another connect but without parameters (it uses the properties which are
// assumed to be set to the right value
function TMysqlClient.connect: boolean;
begin
     result:=connect(fhost,fuser,fpasswd,fdb,fport,funix_socket,ftrysock,fclient_flag);
end;

////////////////////////////////////////////////////////////////////////////////
// set the host if we are not connected
procedure TMysqlClient.SetHost(const Value: string);
begin
     if (FHost<>value) and fnet.net_connected then
        fnet.net_close;
     FHost := Value;
end;

////////////////////////////////////////////////////////////////////////////////
// sets db and if we are connected calls setdb
procedure TMysqlClient.SetDb(const Value: string);
begin
     fdb:=Value;
     if fnet.net_connected then
        select_db(value)
end;

////////////////////////////////////////////////////////////////////////////////
// sets password if we are not connected
procedure TMysqlClient.SetPasswd(const Value: string);
begin
     if (fpasswd<>value) and fnet.net_connected then
        fnet.net_close;
     FPasswd := Value;
end;

////////////////////////////////////////////////////////////////////////////////
// sets port if we are not connected
procedure TMysqlClient.SetPort(const Value: cardinal);
begin
     if (FPort<>value) and fnet.net_connected then
        fnet.net_close;
     FPort := Value;
end;

////////////////////////////////////////////////////////////////////////////////
// sets unix socket if we are not connected
procedure TMysqlClient.SetUnixSocket(const Value: string);
begin
     if (funix_socket<>value) and (fnet.net_connected) and fnamed_pipe then
        fnet.net_close;
     funix_socket := Value;
end;

////////////////////////////////////////////////////////////////////////////////
// sets user if we are not connected
procedure TMysqlClient.SetUser(const Value: string);
begin
     if (FUser<>value) and fnet.net_connected then
        fnet.net_close;
     FUser := Value;
end;

////////////////////////////////////////////////////////////////////////////////
// sets client flags if we are not connected
procedure TMysqlClient.SetClientFlag(const Value: cardinal);
begin
     if (fclient_flag<>value) and fnet.net_connected then
        fnet.net_close;
     fclient_flag := Value;
end;

////////////////////////////////////////////////////////////////////////////////
// returns last error number
function TMysqlClient.GetLastErrorNo: cardinal;
begin
     result:=fnet.last_errno;
end;

////////////////////////////////////////////////////////////////////////////////
// returns true if we are connected
function TMysqlClient.GetConnected: boolean;
begin
     result:=fnet.net_connected;
end;

////////////////////////////////////////////////////////////////////////////////
// make sure