umysqlclient.pas

用delphi连接mysql的组件

    end;
  //4 bytes value
  result:= byte(pchar(packet)[1])+ (byte(pchar(packet)[2]) shl 8)+ (byte(pchar(packet)[3]) shl 16)+ (byte(pchar(packet)[4]) shl 24);
  packet:=packet+9;
end;

////////////////////////////////////////////////////////////////////////////////
// length decoder this one returns int64 values
// refer mysql docs to see why 251,252,253
function net_field_length_ll(var packet: Integer): int64;
var
  a:int64;
begin
  if ( pchar(packet)[0] < chr(251)) then //1 byte value
    begin
      result:= (byte(pchar(packet)[0]));
      inc(packet);
      exit;
    end;
  if ( pchar(packet)[0] = chr(251)) then //Null length
    begin
      inc(packet);
      result:=NULL_LENGTH;
      exit;
    end;
  if ( pchar(packet)[0] = chr(252)) then //2 bytes value
    begin
      result:=byte(pchar(packet)[1])+ (byte(pchar(packet)[2]) shl 8);
      packet:=packet+3;
      exit;
    end;
  if ( pchar(packet)[0] = chr(253)) then //3 bytes value
    begin
      result:= byte(pchar(packet)[1])+ (byte(pchar(packet)[2]) shl 8)+(byte(pchar(packet)[3]) shl 16);
      packet:=packet+4;
      exit
    end;
  packet:=packet+9; //8 bytes value
  result:= (byte(pchar(packet)[1]))+
           (byte(pchar(packet)[2]) shl 8)+
           (byte(pchar(packet)[3]) shl 16)+
           (byte(pchar(packet)[4]) shl 24);
  a:= (byte(pchar(packet)[5]))+
      (byte(pchar(packet)[6]) shl 8)+
      (byte(pchar(packet)[7]) shl 16)+
      (byte(pchar(packet)[8]) shl 24);
  result:=a+result shl 32;
end;

//------------------------------------------------------------------------------
{ TMysqlClient }
//------------------------------------------------------------------------------

////////////////////////////////////////////////////////////////////////////////
// class constructor
constructor TMysqlClient.create;
begin
  inherited;
  fnet:=TMysqlNet.create;
  //init internal variables
  fhost:='';
  fuser:='';
  fpasswd:='';
  funix_socket:='';
  fdb:='';
  fport:=3306;
  fscramble_buff:='';
  fusedresult:=nil;
  fthread_id:=0;
  faffected_rows:=0;
  finsert_id:=0;
  FWarningCount:=0;
  fstatus:=MYSQL_STATUS_READY;
  freconnect:=true;
  ftrySock:=false;
  fnamed_pipe:=false;
  fconnect_timeout:=NET_READ_TIMEOUT; //1 second
  fcompress:={$IFDEF HAVE_COMPRESS}true;{$ELSE}false{$ENDIF};
  fclient_flag:=CLIENT_CAPABILITIES;
  fserver_version:='';
  fserver_capabilities:=0;
  fserver_status:=SERVER_STATUS_AUTOCOMMIT;
  fserver_language:=0;
  fextra_info:=0;
  finfo:='';
  ffield_count:=0;
  ffields:=nil;
  fuse_ssl:=false;
  FUse410Password:=false;
  FNullLength:= 0;
  FThreaded:=false;
  FCriticalSection:=nil;
  {$IFDEF HAVE_THREADSAFE}
  if IsMultiThread then
    begin
      FCriticalSection:= TCriticalSection.Create;
      FThreaded:= true;
    end;
  {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
// class destructor
destructor TMysqlClient.destroy;
begin
  if FThreaded then
     FCriticalSection.Enter;
  close;
  if assigned(fnet) then
    freeandnil(fnet);
  //may need to free some things
  if FThreaded then
     FCriticalSection.Free;
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////
// Changes current user to mysql server
// returns true if success
function TMysqlClient.change_user(NewUser: string; NewPasswd: string; NewDb: string=''): boolean;
var
  buff:array[0..NAME_LEN+USERNAME_LENGTH+100]of char;
  ii,ij:longint;
  somp:pchar;
  su,sd,sp:string;
begin
  if FThreaded then
     FCriticalSection.Enter;
  try
    fillchar(buff,NAME_LEN+USERNAME_LENGTH+100,#0);
    //put new user in buffer
    if (NewUser<>'') then
      begin
        ii:=length(NewUser);
        if ii>32 then //is it longer than 32
          ii:=32;
        move(pchar(@NewUser[1])^,pchar(@buff[0])^,ii);
        ii:=ii+1;
      end
    else
        ii:=1;
    //then the password
    if (NewPasswd<>'') then
      begin
        if (fserver_capabilities and CLIENT_SECURE_CONNECTION = CLIENT_SECURE_CONNECTION) then
          begin
            if FUse410Password then
              begin
                for ij:=0 to 7 do
                  begin
                    buff[ii]:='x';
                    inc(ii);
                  end;
                inc(ii);
              end
            else
              begin
                buff[ii]:=chr(20);
                inc(ii);
                newscramble(pchar(@buff[ii]), pchar(@fscramble_buff[1]), pchar(@NewPasswd[1]));
                inc(ii,20);
              end;
          end
        else
          begin
            somp:=mysql_scramble(NewPasswd,copy(fscramble_buff,1,8));
            ij:=length(somp);
            move(somp[0],pchar(@buff[ii])^,ij);
            strdispose(somp);
            ii:=ii+ij+1;
          end;
      end
    else
      inc(ii);
    //if we have a new db
    if (Newdb<>'')then
      begin
        ij:=length(Newdb);
        move(pchar(@Newdb[1])^,pchar(@buff[ii])^,ij);
        ii:=ii+ij;
      end;
    inc(ii);

    //let's try to change user
    if simple_command(COM_CHANGE_USER, buff,ii,true,freconnect)<>0 then
      result:=false //we have an error
    else
      begin 
        su:=fuser;
        sp:=fpasswd;
        sd:=fdb;
        fuser:=NewUser;
        fpasswd:=NewPasswd;
        fdb:=NewDb;
        if not mysql_authenticate then
          begin
            fuser:=su;
            fpasswd:=sp;
            fdb:= sd;
            result:=false;
          end
        else
          result:=true;
      end;
  finally
    if FThreaded then
      FCriticalSection.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
//attempt to create a new db on server
//one may need rights 
function TMysqlClient.create_db(const db: string): boolean;
begin
  if FThreaded then
    FCriticalSection.Enter;
  try
    if db<>'' then
      result:=simple_command(COM_CREATE_DB,pchar(@db[1]), length(db),false,freconnect)=0
    else
      result:=false;
  finally
    if FThreaded then
      FCriticalSection.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// tells to server to drop a db
function TMysqlClient.drop_db(const adb: string): boolean;
begin
  if FThreaded then
    FCriticalSection.Enter;
  try
    if adb<>'' then
      result:=simple_command(COM_DROP_DB,pchar(@adb[1]),length(adb),false,freconnect)=0
    else
      result:=false;
  finally
    if FThreaded then
      FCriticalSection.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// tells to server to dump debug details
function TMysqlClient.dump_debug_info: boolean;
begin
  if FThreaded then
    FCriticalSection.Enter;
  try
    result:=simple_command(COM_DEBUG,'',0,false,freconnect)=0;
  finally
    if FThreaded then
      FCriticalSection.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// tells to the server to kill a process (must have privileges to do that)
function TMysqlClient.kill(pid: Integer): boolean;
var
  buff:array[0..3]of char;
begin
  if FThreaded then
    FCriticalSection.Enter;
  try
    buff[0]:=chr(pid AND $FF);
    buff[1]:=chr((pid shr 8) AND $FF);
    buff[2]:=chr((pid shr 16) AND $FF);
    buff[3]:=chr((pid shr 24) AND $FF);
    result:=simple_command(COM_PROCESS_KILL,buff,4,false,freconnect)=0;
  finally
    if FThreaded then
      FCriticalSection.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// pings the server to check the connection if still alive
// one may use this after some inactivity to check if the connection is still alive
function TMysqlClient.ping: boolean;
begin
  if FThreaded then
    FCriticalSection.Enter;
  try
    result:=simple_command(COM_PING,'',0,false,freconnect)=0;
  finally
    if FThreaded then
      FCriticalSection.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// real connect to server
// returns true if success
function TMysqlClient.connect(ahost:string; auser:string = ''; apasswd:string = ''; adb:string = ''; aport:cardinal = 3306; aunix_socket:string = ''; atrysocket:boolean = false; aclient_flag:longint = CLIENT_CAPABILITIES):boolean;
var
  buff:string[NAME_LEN+USERNAME_LENGTH+100];
  curpos:longint;
  i:longint;
  pkt_length:longint;
  somp:pchar;
  {$IFDEF HAVE_SSL}
  apc:pchar;
  {$ENDIF}
begin
  if FThreaded then
    FCriticalSection.Enter;
  try
    result:=true;
    if not fnet.net_connected then
      begin
        if (ahost='')and(fhost='') then
          begin //no host specified
            result:=false;
            exit;
          end;
        if aHost<>'' then //new host?
          fhost:=ahost;
        fuser:=auser;
        fpasswd:=apasswd;
        fdb:=adb;
        fport:=aport;
        funix_socket:=aunix_socket;
        fclient_flag:=aclient_flag;
        ftrysock:=atrysocket;

        fillchar(buff,NAME_LEN+USERNAME_LENGTH+100,#0);
        //let's try to connect
        if fnamed_pipe then
          begin
            {$IFDEF _WIN_}
            fnet.net_open(VIO_TYPE_NAMEDPIPE,fhost,funix_socket,fport,fconnect_timeout,ftrysock);
            {$ELSE}
            fnet.net_open(VIO_TYPE_SOCKET,fhost,funix_socket,fport,fconnect_timeout,ftrysock);
            {$ENDIF}
            if (fnet.vio_type<>VIO_CLOSED) then
              begin
                if (fnet.vio_type=VIO_TYPE_NAMEDPIPE) then //did we managed to open the pipe?
                  begin //set the names
                    if (fhost='') or (fhost<>LOCAL_HOST_NAMEDPIPE) then
                      {$IFDEF _WIN_}
                      fhost:=LOCAL_HOST_NAMEDPIPE;
                      {$ELSE}
                      fhost:='localhost';
                      {$ENDIF}
                    if (funix_socket='') or{$IFDEF _WIN_}(funix_socket<>MYSQL_NAMEDPIPE){$ELSE}(funix_socket<>MYSQL_UNIX_ADDR){$ENDIF} then
                      {$IFDEF _WIN_}
                      funix_socket:=MYSQL_NAMEDPIPE;
                      {$ELSE}
                      funix_socket:=MYSQL_UNIX_ADDR;
                      {$ENDIF}
                  end; //if not mark we don't use named pipe
                if (fnet.vio_type<>VIO_TYPE_NAMEDPIPE)and(fnet.vio_type<>VIO_TYPE_SOCKET) then
                  begin
                    fnamed_pipe:=false;
                    funix_socket:='';
                  end;
              end;
          end
        else
          begin
            fnet.net_open(VIO_TYPE_TCPIP,fhost,funix_socket,fport,fconnect_timeout,true);