umysqlvio.pas

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

                   ;
          end
          else
          begin //we had errors ... let's clean it
               SSL_shutdown(fssl);
               SSL_free(fssl);
               if fnewcon<>nil then
                  dispose(fnewcon);
               fssl:= nil;
          end;
     end;
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////
// checks whenever vio is blocking
function TMysqlVio.vio_blocking(onoff: boolean): longint;
var r:longint;
    old_fcntl:longint;
    {$IFDEF _WIN_}
    arg:cardinal;
    {$ENDIF}
begin
     if (ftype <> VIO_CLOSED) then //is vio connected?
     begin
     r:=0;
     {$IFNDEF _WIN_} //if it is on linux
     if (fsd >= 0) then
     begin
          old_fcntl:=ffcntl_mode;
          if (onoff) then
             ffcntl_mode :=ffcntl_mode and ($7FFFFFFE)
          else
              ffcntl_mode := ffcntl_mode or 1;
          if (old_fcntl <> ffcntl_mode) then
             r := fcntl(fsd, F_SETFL, ffcntl_mode);
     end;
     {$ELSE} //if it is not on linux
     if (ftype <> VIO_TYPE_NAMEDPIPE) then //pipes don't need blocking
     begin
          old_fcntl:=ffcntl_mode;
          if (onoff) then
          begin //set blocking
               arg := 0;
               ffcntl_mode := ffcntl_mode and $7FFFFFFE
          end
          else
          begin //reset blocking
               arg := 1;
               ffcntl_mode := ffcntl_mode or 1;
          end;
          if (old_fcntl<>ffcntl_mode) then
             r:=ioctlsocket(fsd,FIONBIO, longint(arg));
     end;
     {$ENDIF}
     result:=r;
     end
     else //vio not connected
         result:=-1;
end;

////////////////////////////////////////////////////////////////////////////////
// closes the socket/pipe
function TMysqlVio.vio_close: longint;
begin
     result:=0;
     {$IFDEF HAVE_SSL}
     if assigned(fssl) then
     begin //did we used ssl?
          //free it
          result := SSL_shutdown(fssl);
          SSL_free(fssl);
          if fnewcon<>nil then
             dispose(fnewcon);
          fssl:= nil;
     end;
     {$ENDIF}
{$IFDEF _WIN_}
     if (ftype=VIO_TYPE_NAMEDPIPE) then
        result:=longint(CloseHandle(fhPipe))
     else
{$ENDIF}
         if (ftype <> VIO_CLOSED) then
         begin
              result:=0;
              if (shutdown(fsd,2)<>0) then
                 result:=-1;
              {$IFDEF _WIN_}
              if (closesocket(fsd)<>0) then
                 result:=-1;
              {$ENDIF}
         end;
     ftype:=VIO_CLOSED;
     fsd:=-1;
     FHPipe:=-1;
     ffcntl_mode:=0;
end;

////////////////////////////////////////////////////////////////////////////////
// checks whenever the communication was intrerupted
function TMysqlVio.vio_intrerupted: boolean;
begin
     {$IFDEF _WIN_}
     result:=WSAGetLastError = WSAEINTR;
     {$ELSE}
     result:=errno = EINTR;
     {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
// main vio function it creates the pipe, connects the socket
// will return -x on error ??
// _type represent the kind of vio we open (ssl not supported on connect)
// host and unix_socket are obvious
// connect_timeout is used only on named pipes
// trysock is used when you try a pipe and if in error you want to try socket
function TMysqlVio.vio_open( _type:TEnumVioType; host:string='localhost'; unix_socket:string={$IFDEF _WIN_}MYSQL_NAMEDPIPE{$ELSE}MYSQL_UNIX_ADDR{$ENDIF}; port:longint=0; connect_timeout:cardinal=0; trysock:boolean=true): longint;
var sock:longint;
    {$IFDEF _WIN_}
    hPipe:longint;
    arg:cardinal;
    szPipeName:string[255];
    i:integer;
    dwMode:longword;
    {$ENDIF}
    sock_addr:TSockAddr;
    ip_addr:cardinal;
    hp:phostent;
    lhost:string; //store temp values
    lunix_socket:string; //store temp values
{$IFNDEF _WIN_}
    haserr:boolean;
    Unixaddr:TUnixSockAddr;
{$ENDIF}
begin
     if ftype=VIO_CLOSED then
     begin
     ftimeout:=connect_timeout;
     if not fNoTimeOut then // we use timeout
     if ftimeout=0 then //is it 0 seconds?
        ftimeout:=NET_READ_TIMEOUT;
     if _type=VIO_TYPE_SSL then
     begin
          result:=-2; //ssl not supported yet
          exit;
     end;
     //only if using winsock
     {$IFDEF _WIN_}
     if (_type = VIO_TYPE_TCPIP)or(trysock) then //do we need winsock?
        if fWsaData.wVersion=0 then // has it been initialized before
           if (WSAStartup ($0101, fWsaData)<>0) then
              begin
                   result:=-1; //we can't start winsock - one should never get here
                   exit;
              end;
     hpipe:=INVALID_HANDLE_VALUE;
     {$ENDIF}
     lhost:=host;
     lunix_socket:=unix_socket;
     if (_type = VIO_TYPE_NAMEDPIPE) then
     begin
          //one may pass wrong host info
          if (host='') or (host<>LOCAL_HOST_NAMEDPIPE) then
          {$IFDEF _WIN_}
          host:=LOCAL_HOST_NAMEDPIPE;
          {$ELSE}
          host:='localhost';
          {$ENDIF}
          if (unix_socket='') or
          {$IFDEF _WIN_}
          (unix_socket<>MYSQL_NAMEDPIPE)
          {$ELSE}
          (unix_socket<>MYSQL_UNIX_ADDR)
          {$ENDIF}
          then
          {$IFDEF _WIN_}
          unix_socket:=MYSQL_NAMEDPIPE;
          {$ELSE}
          unix_socket:=MYSQL_UNIX_ADDR;
          {$ENDIF}
     end;
     {$IFDEF _WIN_}
     if (_type = VIO_TYPE_NAMEDPIPE) and
        (((host<>'') and (host=LOCAL_HOST_NAMEDPIPE))or
        ((unix_socket<>'') and(unix_socket=MYSQL_NAMEDPIPE)))
        then //we try a named pipe
     begin
          szPipeName:='\\'+host+'\pipe\'+unix_socket;
          for i:=0 to 100 do //try 100 times to connect - one may remove this
          begin
               //try open the pipe
               hPipe := CreateFile(pchar(longint(@szPipeName)+1),
                        GENERIC_READ or GENERIC_WRITE,
		        0,nil,OPEN_EXISTING,0,0 );
               if ( hPipe<> INVALID_HANDLE_VALUE) then //success?
                  break;
               if (GetLastError <> ERROR_PIPE_BUSY) then //we got another error than pipe busy?
               begin
                    //we can stop trying
                    flast_errno:=CR_NAMEDPIPEOPEN_ERROR;
                    flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[host, unix_socket,GetLastError]);
                    if not trysock then //should we try socket?
                    begin
                         result:=-9;
                         exit;
                    end
                    else
                        break;
               end;
               //let's wait for a while .. maybe the pipe will not be busy
               if (not WaitNamedPipe(pchar(longint(@szPipeName)+1), connect_timeout*1000) )then
               begin
                    flast_errno:=CR_NAMEDPIPEWAIT_ERROR;
                    flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[host,unix_socket,GetLastError]);
                    if not trysock then //should we try socket?
                    begin
                         result:=-9;
                         exit;
                    end
                    else
                        break;
               end;
          end;
          //we just tryed 100 times .. still not there?
          if (hPipe = INVALID_HANDLE_VALUE) then
          begin
               flast_errno:=CR_NAMEDPIPEOPEN_ERROR;
               flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[host,unix_socket,GetLastError]);
               if not trysock then //should we try socket?
                  begin
                       result:=-9;
                       exit;
                  end;
          end;
          if hPipe<>INVALID_HANDLE_VALUE then //are we connected or just wait to try socket
          begin
          dwMode := PIPE_READMODE_BYTE or PIPE_WAIT;
          if ( not SetNamedPipeHandleState(hPipe, dwMode, nil, nil) ) then //set up pipe for reading
          begin
               //we can't set it up .. there must be something wrong
               //we can close the pipe
               CloseHandle( hPipe );
               hPipe:=INVALID_HANDLE_VALUE;
               flast_errno:=CR_NAMEDPIPESETSTATE_ERROR;
               flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[host, unix_socket,GetLastError]);
               if not trysock then //should we try socket?
                  begin
                       result:=-9;
                       exit;
                  end;
          end;
          end;
          if (hPipe=INVALID_HANDLE_VALUE) then //all that work .. and we failed to create the pipe
          begin
               if not trysock then //should we try socket?
                  begin
                       result:=-9;
                       exit;
                  end;
          end
          else
          begin //we created the pipe ... yesss!!!
               ftype:=VIO_TYPE_NAMEDPIPE;
               fsd:=0;
               fhPipe:=hPipe;
               result:=0;
               exit;
          end;
     end;
     if ((hPipe = INVALID_HANDLE_VALUE)and (_type=VIO_TYPE_NAMEDPIPE))or(trysock) then //only if we failed creating the pipe and we can try sockets
     {$ELSE} //unix socket (unix named pipe)
     if (_type = VIO_TYPE_SOCKET) and
        (((host<>'') and ((uppercase(host)='LOCALHOST')or(host='127.0.0.1'))) or(unix_socket = MYSQL_UNIX_ADDR)) then
     begin
          sock := socket(AF_UNIX,SOCK_STREAM,0); //grab a socket
          haserr:=false;
          if (sock = SOCKET_ERROR) then
          begin
               last_errno:=CR_SOCKET_CREATE_ERROR;
               last_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[errno]);
               haserr:=true; //we got an error
               if not trysock then //should we try socket?
               begin
                    result:=-9;
                    exit;
               end;
          end;
          if not haserr then //any errors so far?
          begin
               fillchar(UNIXaddr,sizeof(TUnixSockAddr),#0);
               UNIXaddr.sun_family := AF_UNIX;
               move(pchar(@unix_socket[1])^,pchar(@UNIXaddr.sun_path[0])^,length(unix_socket));
               //this should do a select for timeout
               if connect(sock,TSockAddr(pointer(@UNIXaddr)^), sizeof(TUnixSockAddr)) <0 then
               begin
                    last_errno:=CR_CONNECTION_ERROR;
                    last_error:= format(client_errors[(flast_errno)-CR_MIN_ERROR],[unix_socket,errno]);
                    haserr:=true;
                    if not trysock then //should we try socket?
                    begin
                         result:=-9;