umysqlclient.pas

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

////////////////////////////////////////////////////////////////////////////////
// length decoder 
// refer mysql docs to see why 251,252,253
function net_field_length(var packet: Integer): longint;
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;
     //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;

////////////////////////////////////////////////////////////////////////////////
// added to not import the entyre math unit
function Floor(X: Extended): longint;
begin
  Result := Trunc(X);
  if (X < 0) and (Result<>X) then
    Result:=Result-1;
end;

////////////////////////////////////////////////////////////////////////////////
// calculates the hash of a pchar (used for password)
procedure hashPassword(pass:pchar; var res0,res1:longint);
var nr,add,nr2,tmp:int64;
    i:longint;
    e1:int64;
    len:longint;
begin
     nr:=1345345333;
     add:=7;
     nr2:=$12345671;
     len:=length(pass)-1;
     for i:=0 to len do
     begin
          if (Pass[i] = #20) or (Pass[i] = #9)then
             continue;
          tmp := $ff AND byte(Pass[i]);
          e1:=(((nr and 63) +add)*tmp)+(nr shl 8);
          nr:=nr xor e1;
          nr2:=nr2+((nr2 shl 8) xor nr);
          add :=add+tmp;
     end;
     res0 := nr AND $7fffffff;
     res1 := nr2 AND $7fffffff;
end;

////////////////////////////////////////////////////////////////////////////////
// encryption of password
function mysql_scramble( pass:string; hashseed:string):pchar;
var hp0,hp1:longint;
    hm0,hm1:longint;
    maxValue,seed, seed2 :int64;
    dRes: double;
    i:longint;
    e:byte;
    len1:longint;
begin
    if(pass = '') or (hashseed='')then
    begin
         result:=nil;
         exit;
    end;
    len1:=length(hashseed)-1;
    result:=stralloc(9);
    hashPassword(pchar(pass),hp0,hp1);
    hashPassword(pchar(hashSeed),hm0,hm1);
    maxValue:= $3FFFFFFF;
    seed  := ( hp0 xor hm0 )mod maxValue ;
    seed2 := ( hp1 xor hm1 )mod maxValue ;
    for i:=0 to len1 do
    begin
         seed  := ( seed * 3 + seed2  )mod maxValue ;
         seed2 := ( seed + seed2 + 33 )mod maxValue ;
         dRes := Seed / maxValue;
         result[i] := char( floor( dRes * 31 ) + 64 );
    end;
    seed  := ( seed * 3 + seed2  )mod maxValue ;
    dRes := Seed / maxValue;
    e := floor( dRes * 31 );
    for i := 0 to len1 do
        result[i] := chr( byte (result[i]) xor e);
    result[len1+1]:=#0; //should not be needed
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;
     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;
end;

////////////////////////////////////////////////////////////////////////////////
// class destructor
destructor TMysqlClient.destroy;
begin
     close;
     if assigned(fnet) then
        freeandnil(fnet);
     //may need to free some things
     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..512]of char;
    i,j:longint;
    somp:pchar;
begin
     fillchar(buff,512,#0);
     //put new user in buffer
     if (NewUser<>'') then
     begin
          i:=length(NewUser);
          if i>32 then //is it longer than 32
             i:=32;
          move(NewUser,pchar(@buff)^,i);
          inc(i);
     end
     else
          i:=1;
     //then the password
     if (NewPasswd<>'') then
     begin
          somp:=mysql_scramble(NewPasswd,fscramble_buff);
          j:=length(somp);
          move(somp[0],pchar(@buff[i])^,j);
          strdispose(somp);
          i:=i+j+1;
     end
     else
          inc(i);
     //if we have a new db
     if (Newdb<>'')then
     begin
          j:=length(Newdb);
          move(Newdb,pchar(@buff[i])^,j);
          i:=i+j+1;
     end
     else
          inc(i);
     //let's try to change user
     if simple_command(COM_CHANGE_USER, buff,i,false,freconnect)<>0 then
        result:=false //we have an error
     else
     begin //success
          fuser:=NewUser;
          fpasswd:=NewPasswd;
          fdb:= Newdb;
          result:=true; //no errors
     end;
end;

////////////////////////////////////////////////////////////////////////////////
//attempt to create a new db on server
//one may need rights 
function TMysqlClient.create_db(const db: string): boolean;
begin
     result:=simple_command(COM_CREATE_DB,db, length(db),false,freconnect)=0;
end;

////////////////////////////////////////////////////////////////////////////////
// tells to server to drop a db
function TMysqlClient.drop_db(const adb: string): boolean;
begin
     result:=simple_command(COM_DROP_DB,adb,length(adb),false,freconnect)=0;
end;

////////////////////////////////////////////////////////////////////////////////
// tells to server to dump debug details
function TMysqlClient.dump_debug_info: boolean;
begin
     result:=simple_command(COM_DEBUG,'',0,false,freconnect)=0;
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
     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;
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
     result:=simple_command(COM_PING,'',0,false,freconnect)=0;
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
     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