⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umysqlvio.pas

📁 MYSQL 连接控件 MYSQL 连接控件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
                    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;
                        exit;
                      end;
                  end
              end;
            if not haserr then
              begin
                ftype:=VIO_TYPE_SOCKET;
                fsd:=sock;
                fhPipe:=0;
                result:=0;//no errors and we are connected (we can start talking to the server)
                flast_error:='';
                flast_errno:=0;
                fastsend; //attempt to use fastsend
                keepalive(TRUE);
                exit;
              end;
          end;
        {$ENDIF}
        begin
          //restore values if we cahnged them trying the pipe
          host:=lhost;
          unix_socket:=lunix_socket;
          if (port=0)then
            port:=mysql_port;
          if (host='') then
            host:='localhost';
          sock := socket(AF_INET,SOCK_STREAM,0); //try grab a socket
          if (sock = SOCKET_ERROR) then //error?
            begin
              flast_errno:=CR_IPSOCK_ERROR;
              {$IFDEF _WIN_}
              flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[WSAGetLastError]);
              {$ELSE}
              flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[errno]);
              {$ENDIF}
              result:=-8;//we failed the socket creation
              exit;
            end;
          {$IFNDEF _WIN_}
          ffcntl_mode := fcntl(fsd, F_GETFL);
          {$ENDIF}
          {$IFDEF _WIN_}
          arg:=0;
          ioctlsocket(fsd,FIONBIO,longint(arg));
          {$ENDIF}
          //try to resolve the host
          fillchar(sock_addr,sizeof(sock_addr),#0);
          sock_addr.sin_family := AF_INET;
          ip_addr := {$IFOPT R+}cardinal{$ENDIF}(inet_addr(pchar(host))); // thanks Jiri Barton
          if (ip_addr <> INADDR_NONE) then
            sock_addr.sin_addr:=in_addr(ip_addr)
          else
            begin
              hp:=gethostbyname(pchar(host));
              if (hp=nil) then
                begin
                  flast_errno:=CR_UNKNOWN_HOST;
                  {$IFDEF _WIN_}
                  flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[host, WSAGetLastError]);
                  {$ELSE}
                  flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR],[host, errno]);
                  {$ENDIF}
                  result:=-7; //we can't connect
                  exit;
                end;
              ip_addr:=byte(hp.h_addr^[0])+(byte(hp.h_addr^[1])shl 8)+(byte(hp.h_addr^[2])shl 16)+(byte(hp.h_addr^[3])shl 24);
              sock_addr.sin_addr:=in_addr(ip_addr);
              hp.h_length:=10;
            end;
          sock_addr.sin_port := htons(port);
          fsd:=sock;
          ftype:=VIO_TYPE_TCPIP;
          vio_blocking(false); //do not wait to connect as we'll get an error on read timed-out
          //we resolved the address .. let's try to connect
          if (connect(sock,TSockAddr(sock_addr), sizeof(sock_addr)) <0)
             {$IFDEF _WIN_}and
             (WSAGetLastError <>WSAEWOULDBLOCK){$ELSE} {and ??? errno = EWOUDLBLOCK}{$ENDIF} then
            begin
              fsd:=0;
              ftype:=VIO_CLOSED;
              ffcntl_mode:=0; //reset mode
              flast_errno:= CR_CONN_HOST_ERROR;
              {$IFDEF _WIN_}
              flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR], [host, WSAGetLastError]);
              {$ELSE}
              flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR], [host, errno]);
              {$ENDIF}
              result:=-6; //we can't connect
              exit;
            end;
          fastsend; //attempt to use fastsend
          keepalive(TRUE);
          //are we really connected?
          if (ftimeout<>0) and (not vio_poll_read(ftimeout)) then
            begin //if we don't get anything during time out
              fsd:=0;
              ftype:=VIO_CLOSED;
              ffcntl_mode:=0; //reset mode
              flast_errno:= CR_CONN_HOST_ERROR;
              {$IFDEF _WIN_}
              flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR], [host, WSAGetLastError]);
              {$ELSE}
              flast_error:=format(client_errors[(flast_errno)-CR_MIN_ERROR], [host, errno]);
              {$ENDIF}
              result:=-7; //we can't connect
              exit;
            end;
          if fNoTimeOut and (ftype = VIO_TYPE_TCPIP) then
            vio_blocking(true);
        end;
      fhPipe:=0;
      result:=0;//no errors and we are connected (we can start talking to the server)
      flast_error:='';
      flast_errno:=0;
    end
  else //vio allready open
    result:=-20;
end;

////////////////////////////////////////////////////////////////////////////////
// poll read via select
// waits a specific interval to read something
function TMysqlVio.vio_poll_read(timeout: cardinal): boolean;
var
  fds:TPollFD;
  res:longint;
begin
  if (ftype = VIO_TYPE_NAMEDPIPE) then
    begin
      result:=true;
      exit;
    end;
  if (ftype <> VIO_CLOSED) then //is vio connected?
    begin
      fds.fd:=fsd;
      fds.revents:=0;
      fds.events:=POLLIN;
      {$IFDEF NEVERENABLEME}
      if timeout=0 then
        res:=poll({$IFNDEF _WIN_}@{$ENDIF}fds,{$IFNDEF _WIN_}1,{$ENDIF}100)//0.1 seconds for timed out on clear net
      else
        {$ENDIF}
        res:=poll({$IFNDEF _WIN_}@{$ENDIF}fds,{$IFNDEF _WIN_}1,{$ENDIF}timeout*1000);
      if res<0 then
        result:=false //don't return true on errors
      else
        if res=0 then
          result:=true
        else
          if fds.revents AND POLLIN = POLLIN then
            result:=false
          else
            result:=true;
    end
  else //vio is not connected return false
    result:=false;
  {$IFNDEF _WIN_}
  result:=not result;
  {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
// reads "size" bytes into a buffer "buf" from socket/pipe
function TMysqlVio.vio_read(buf: pointer; const sz: Integer): longint;
{$IFDEF _WIN_}
var
  len1:longword;
{$ENDIF}
begin
  if (ftype <> VIO_CLOSED) then //vio is connected we can receive
    begin
      {$IFDEF HAVE_SSL}
      if (ftype =VIO_TYPE_SSL) then //if vio is ssl
        begin
          //errno = 0;
          result := SSL_read(fssl, buf^, sz);
          if ( result<= 0) then
            result:=- SSL_get_error(fssl, result); //- because the errors are positive and it may look as we send "errno" bytes
          exit;
        end;
      {$ENDIF}
      {$IFDEF _WIN_}
      //extra check since in windows we can use pipes rather than sockets
      if (ftype = VIO_TYPE_NAMEDPIPE)then
        begin
          //if it is pipe we read from it
          if not(ReadFile(fhPipe, buf^, sz, len1, nil)) then
            result:=-1
          else
            result:=len1;
        end
      else //we read via socket
        //don't wait forever to read
        if fNoTimeOut then //no pool - one should not use this unless very reliable connection
          result := recv(fsd, buf^, sz,0)
        else
          if vio_poll_read(ftimeout) then                                       //22-03-2002
            result:=recv(fsd, buf^, sz,0)
          else                                                                  //22-03-2002
            result:=-1;                                                         //22-03-2002
      {$ELSE}
      //we don't have pipes on linux .. so just read from socket
      errno:=0;
      //don't wait forever to read
      if fNoTimeOut then //no pool - one should not use this unless very reliable connection
        result := recv(fsd, buf^, sz,0)
      else
        if vio_poll_read(ftimeout) then                                         //22-03-2002
          result := recv(fsd, buf^, sz,0)
        else                                                                    //22-03-2002
          result:=-1;                                                           //22-03-2002
      {$ENDIF}
    end
  else //vio not connected returns -1
    result:=-1;
end;

////////////////////////////////////////////////////////////////////////////////
// returns true if we should try again to read/write
function TMysqlVio.vio_should_retry: boolean;
var
  en:longint;
begin
  if (ftype <> VIO_CLOSED) then //vio is connected
    begin
      //get last error
      {$IFDEF _WIN_}
      en:=WSAGetLastError;
      {$ELSE}
      en:=errno;
      {$ENDIF}
      //check if we should retry
      {$IFDEF _WIN_}
      result:= (en=WSAEINPROGRESS)or(en=WSAEINTR)or(en=WSAEWOULDBLOCK);
      {$ELSE}
      result:= (en = EAGAIN) or (en = EINTR);
      {$ENDIF}
    end
  else //vio is not connected .. no point to retry
    result:=false;
end;

////////////////////////////////////////////////////////////////////////////////
// writes "size" bytes from a buffer "buf" to socket/pipe
function TMysqlVio.vio_write(buf: pointer; size: Integer): longint;
{$IFDEF _WIN_}
var
  len1:longword;
{$ENDIF}
begin
  if (ftype <> VIO_CLOSED) then //if vio is connected
    begin
      {$IFDEF HAVE_SSL}
      if (ftype =VIO_TYPE_SSL) then //if vio is ssl
        begin
          result := SSL_write(fssl, pchar(buf^)^, size);
          exit;
        end;
      {$ENDIF}
      {$IFDEF _WIN_}
      //extra check since in windows we can use pipes rather than sockets
      if (ftype = VIO_TYPE_NAMEDPIPE) then
        begin
          //if it is pipe we write into it
          if not(WriteFile(fhPipe, pchar(buf^)^, size, len1, nil)) then
            result:=-1
          else
            result:=len1;
        end
      else //we send via socket
        result:=send(fsd, pchar(buf^)^, size,0);
      {$ELSE}
      //we don't have pipes on linux .. so just write to socket
      errno:=0;
      result := send(fsd, pchar(buf^)^, size,0);
      {$ENDIF}
    end
  else //vio not connected returns -1 allways
    result:=-1;
end;

////////////////////////////////////////////////////////////////////////////////
// set wVersion to 0 as initial value
// any other value in finalization will call WSACleanup
// Note: only for windows
initialization
begin
  {$IFDEF _WIN_}
  fWsaData.wVersion:=0;
  {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
// if wVersion is <> 0 we need to clean winsock
// Note: only for windows
finalization
begin
  {$IFDEF _WIN_}
  if fWsaData.wVersion<>0 then
    WSACleanup;
  {$ENDIF}
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -