1:
2:
3:
4:
5:

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, System.ComponentModel, Borland.Vcl.StdCtrls, uMysqlVio, uMysqlCT, uMysqlClient, uMysqlHelpers;

  {$I mysqlinc.inc}					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:
1187:
1188:
1189:
1190:
1191:
1192:
1193:
1194:
1195:
1196:
1197:
1198:
1199:
1200:
1201:
1202:
1203:
1204:
1205:
1206:
1207:
1208:
1209:
1210:
1211:
1212:
1213:
1214:
1215:
1216:
1217:
1218:
1219:
1220:
1221:
1222:
1223:
1224:
1225:

{--------------------------------------------------------------------------------
Licencing issues:
23-March-2002      ©Cristian Nicola
Note:
 Mysql is copyright by MySQL AB. Refer to their site ( http://www.mysql.com )
for licencing issues.
 Zlib is copyright by Jean-loup Gailly and Mark Adler. Refer to their site for
licencing issues. ( http://www.info-zip.org/pub/infozip/zlib/ )

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

NOTES:
  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. If you are using it for a commercial software it must be open source and
     it must include full source code of this library in an unaltered fashion
     or you would need to ask for permission to use it. This library will be
     considered donationware which means if you want to contribute with any money
     or hardware you are more than welcome.
  4. This notice may not be removed or altered from any source distribution.

  Cristian Nicola
  n_cristian@hotmail.com

If you use the mysqldirect library in a product, i would appreciate *not*
receiving lengthy legal documents to sign. The sources are provided
for free but without warranty of any kind.  The library has been
entirely written by Cristian Nicola after libmysql of MYSQL AB.
--------------------------------------------------------------------------------}
unit uMysqlVio;
////////////////////////////////////////////////////////////////////////////////
// VIO = Virtual Input Output
// supposed to hide low level read/write from the other 2 levels
// this will be controled and used by "net" no one should ever need to use it directly

interface

{$I mysqlinc.inc}

uses
  {$IFDEF _WIN_}windows, {$ENDIF}sysutils, uMysqlErrors, uMysqlCT {$IFDEF HAVE_SSL},uMysqlSSL{$ENDIF};

type
  TMysqlVio = class (TObject)
  private
    FSd                 : longint;
    FHPipe              : longint;
    ffcntl_mode         : longint;
    ftype               : TEnumVioType;
    flast_error         : string[MYSQL_ERRMSG_SIZE];
    flast_errno         : cardinal;
    {$IFDEF HAVE_SSL}
    fssl                : pointer;
    fnewcon             : pointer;
    {$ENDIF}
    {$IFDEF NEVERENABLEME}public{$ENDIF}
    ftimeout            : longint;                                              //22-03-2002
    {$IFDEF NEVERENABLEME}private{$ENDIF}
    fNoTimeOut          : boolean;                
    procedure Setlast_error(const Value: string);
    procedure SetNoTimeOut(const Value: boolean);
    function Getlast_error: string;
    function fastsend:longint;
    function keepalive(onoff:boolean):longint;
    function vio_poll_read(timeout:cardinal):boolean;
    {$IFDEF HAVE_SSL}
    function new_VioSSLConnectorFd(const key:pchar;const cert:pchar;const ca:pchar;const capath:pchar;const cipher:pchar):pointer;
    {$ENDIF}
  public
    property fcntl_mode : longint read ffcntl_mode;
    property last_error : string read Getlast_error write Setlast_error;
    property last_errno : cardinal read flast_errno write flast_errno;
    property VIO_type : TEnumVioType read ftype;
    property NoTimeOut : Boolean read fNoTimeOut write SetNoTimeOut;
    constructor create;
    destructor destroy; override;
    function vio_read (buf:pointer; const sz:longint):longint;
    function vio_write (buf:pointer; size:longint):longint;
    function vio_blocking(onoff:boolean):longint;
    function vio_intrerupted:boolean;
    function vio_should_retry:boolean;
    function 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;
    function vio_close:longint;
    {$IFDEF HAVE_SSL}
    procedure SwitchToSSL(const key:pchar;const cert:pchar;const ca:pchar;const capath:pchar;var cipher:pchar; timeout:cardinal);
    {$ENDIF}
  end;

////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////

const
  //poll constants
  IPPROTO_IP      = 0;
  IP_TOS          = {$IFDEF _WIN_}8;{$ELSE}1;{$ENDIF} //need check
  SOL_SOCKET      = {$IFDEF _WIN_}$ffff;{$ELSE}1;{$ENDIF} //need check
  SO_KEEPALIVE    = {$IFDEF _WIN_}$0008;{$ELSE}$0009;{$ENDIF} //need check
  IPPROTO_TCP     = 6;
  TCP_NODELAY     = $0001;
  FD_SETSIZE      = {$IFDEF _WIN_}64;{$ELSE}1024;{$ENDIF} //need check
  POLLIN          = 1;
  POLLPRI         = 2;
  POLLOUT         = 4;
  POLLERR         = 8;
  POLLHUP         = 16;
  POLLNVAL        = 32;
  POLLRDNORM      = POLLIN;
  POLLRDBAND      = POLLPRI;
  POLLWRNORM      = POLLOUT;
  POLLWRBAND      = POLLOUT;
  POLL_CAN_READ     = (POLLIN or POLLRDNORM );
  POLL_CAN_WRITE    = (POLLOUT or POLLWRNORM or POLLWRBAND );
  POLL_HAS_EXCP     = (POLLRDBAND or POLLPRI );
  POLL_EVENTS_MASK  = (POLL_CAN_READ or POLL_CAN_WRITE or POLL_HAS_EXCP);
  {$IFDEF _WIN_}
  IOC_IN        = $80000000;
  IOCPARM_MASK  = $7f;
  FIONBIO       = IOC_IN or { set/clear non-blocking i/o }
                  ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
                  (Longint(Byte('f')) shl 8) or 126;
  {$ENDIF}

type
  //poll types for poll reading
  PFDSet = ^TFDSet;
  TFDSet = record
    fd_count: longint;
    fd_array: array[0..FD_SETSIZE-1] of longint;
  end;
  PTimeVal = ^TimeVal;
  TimeVal = record
    tv_sec: Longint;
    tv_usec: Longint;
  end;

  TPollFD = record
    fd:longint;
    events:smallint;
    revents:smallint;
  end;
  {$IFNDEF _WIN_}
  PPollFD = ^TPollFD;
  {$ENDIF}

const
  AF_UNIX         = 1;
  AF_INET         = 2;
  SOCK_STREAM     = 1;
  SOCKET_ERROR    = -1;
  INADDR_NONE     = $FFFFFFFF;
{$IFNDEF _WIN_}
  F_SETFL = 4;
  F_GETFL = 3;
  __NFDBITS = 8 * sizeof(longword);
  EAGAIN  = 11;        {  Try again  }
  EINTR   = 4;        {  Interrupted system call  }
{$ENDIF}

{$IFDEF _WIN_}
  WSABASEERR          = 10000;
  WSAEINTR            = (WSABASEERR+4);
  WSAEWOULDBLOCK      = (WSABASEERR+35);
  WSAEINPROGRESS      = (WSABASEERR+36);
  WSADESCRIPTION_LEN  = 256;
  WSASYS_STATUS_LEN   = 128;
{$ENDIF}
  INVALID_HANDLE_VALUE  = -1;

type
  PHostEnt = ^HostEnt;
  HostEnt = record
    h_name: PChar;
    h_aliases: ^PChar;
    h_addrtype: {$IFDEF _WIN_}Smallint;{$ELSE}longint;{$ENDIF}
    h_length: {$IFDEF _WIN_}Smallint;{$ELSE}cardinal;{$ENDIF}
    case Byte of
      0: (h_addr_list: ^PChar);
      1: (h_addr: ^PChar);
  end;

  SunB = packed record
    s_b1, s_b2, s_b3, s_b4: char;
  end;
  SunW = packed record
    s_w1, s_w2: word;
  end;
  in_addr = record
    case longint of
      0: (S_un_b: SunB);
      1: (S_un_w: SunW);
      2: (S_addr: longint);
  end;

type
{$IFNDEF _WIN_}
  TSockAddr = record
    case Integer of
      0: (sa_family: word;
          sa_data: packed array[0..13] of Byte);
      1: (sin_family: word;
          sin_port: word;
          sin_addr: in_addr;
          sin_zero: packed array[0..7] of Byte);
  end;
  TUnixSockAddr = record
    sun_family:word;              //* address family AF_LOCAL/AF_UNIX */
    sun_path:array[0..107]of char; //* 108 bytes of socket address     */
  end;
{$ELSE}
  TSockAddr = record
    case longint of
      0: (sin_family: word;
          sin_port: word;
          sin_addr: in_addr;
          sin_zero: array[0..7] of Char);
      1: (sa_family: word;
          sa_data: array[0..13] of Char)
  end;
{$ENDIF}

{$IFDEF _WIN_}
type
  WSAData = record
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PChar;
  end;
//winsock imports
function setsockopt(s: longint; level, optname: longint; optval: PChar; optlen: longint): longint; stdcall; external 'wsock32.dll' name 'setsockopt';
function ioctlsocket(s: longint; cmd: LongWORD; var arg: longint): longint; stdcall; external 'wsock32.dll' name 'ioctlsocket';
function send(s: longint; var Buf; len, flags: longint): longint; stdcall; external 'wsock32.dll' name 'send';
function recv(s: longint; var Buf; len, flags: longint): longint; stdcall; external 'wsock32.dll' name 'recv';
function WSAGetLastError: longint; stdcall; external 'wsock32.dll' name 'WSAGetLastError';
function __WSAFDIsSet(s: longint; var FDSet: TFDSet): LongBool; stdcall; external 'wsock32.dll' name '__WSAFDIsSet';
function select(nfds: longint; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): Longint; stdcall; external 'wsock32.dll' name 'select';
function shutdown(s: longint; how: longint): longint; stdcall; external 'wsock32.dll' name 'shutdown';
function closesocket(s: longint): longint; stdcall; external 'wsock32.dll' name 'closesocket';
function WSACleanup: longint; stdcall; external 'wsock32.dll' name 'WSACleanup';
function WSAStartup(wVersionRequired: word; var WSData: WSAData): longint; stdcall; external 'wsock32.dll' name 'WSAStartup';
function socket(af, Struct, protocol: longint): longint; stdcall; external 'wsock32.dll' name 'socket';
function inet_addr(cp: PChar): longint; stdcall; external 'wsock32.dll' name 'inet_addr';
function gethostbyname(name: PChar): PHostEnt; stdcall; external 'wsock32.dll' name 'gethostbyname';
function htons(hostshort: longint): longint; stdcall; external 'wsock32.dll' name 'htons';
function connect(s: longint; var name: TSockAddr; namelen: longint): longint; stdcall; external 'wsock32.dll' name 'connect';

type
  //windows pipes type
  POverlapped = ^_Overlapped;
  _OVERLAPPED = record
    Internal: longWORD;
    InternalHigh: longWORD;
    Offset: longWORD;
    OffsetHigh: longWORD;
    hEvent: longword;
  end;
  PSecurityAttributes = ^TSecurity_Attributes;
  TSECURITY_ATTRIBUTES = record
    nLength: LongWORD;
    lpSecurityDescriptor: Pointer;
    bInheritHandle: LongBOOL;
  end;
const
  //windows pipes constants
  GENERIC_READ        = LongWORD($80000000);
  GENERIC_WRITE       = $40000000;
  OPEN_EXISTING       = 3;
  ERROR_PIPE_BUSY     = 231;
  PIPE_READMODE_BYTE  = 0;
  PIPE_WAIT           = 0;
//windows pipes functions
function WriteFile(hFile: longword; const Buffer; nNumberOfBytesToWrite: longword; var lpNumberOfBytesWritten: longword; lpOverlapped: POverlapped): longbool; stdcall; external 'kernel32.dll' name 'WriteFile';
function ReadFile(hFile: longword; var Buffer; nNumberOfBytesToRead: longword; var lpNumberOfBytesRead: longword; lpOverlapped: POverlapped): longbool; stdcall; external 'kernel32.dll' name 'ReadFile';
function CloseHandle(hObject: longword): longbool; stdcall;external 'kernel32.dll' name 'CloseHandle';
function CreateFile(lpFileName: PChar; dwDesiredAccess, dwShareMode: LongWORD; lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: LongWORD; hTemplateFile: longword): longword; stdcall; external 'kernel32.dll' name 'CreateFileA';
function GetLastError: LongWORD;  stdcall; external 'kernel32.dll' name 'GetLastError';
function WaitNamedPipe(lpNamedPipeName: PChar; nTimeOut: LongWORD): LongBOOL; stdcall; external 'kernel32.dll' name 'WaitNamedPipeA';
function SetNamedPipeHandleState(hNamedPipe: longword; var lpMode: LongWORD; lpMaxCollectionCount, lpCollectDataTimeout: Pointer): LongBOOL; stdcall; external 'kernel32.dll' name 'SetNamedPipeHandleState';
{$ENDIF}

{$IFNDEF _WIN_}
function fcntl(Handle: Integer; Command: Integer; Arg: Longint): Integer; external 'libc.so.6' name 'fcntl';overload;
function fcntl(Handle: Integer; Command: Integer): Integer; cdecl; external 'libc.so.6' name 'fcntl';overload;
function recv(fd: longint; var buf; n: longword; flags: Integer): Integer; cdecl;external 'libc.so.6' name 'recv';
function send(fd: longint; const buf; n: longword; flags: Integer): Integer; cdecl;external 'libc.so.6' name 'send';
function setsockopt(fd: longint; level, optname: Integer; optval: Pointer; optlen: cardinal): Integer; cdecl;external 'libc.so.6' name 'setsockopt';
function shutdown(fd: longint; how: Integer): Integer; cdecl;external 'libc.so.6' name 'shutdown';
function closesocket(handle: longint): Integer; cdecl;external 'libc.so.6' name 'close';
function connect(fd: longint; const addr: tsockaddr; len: cardinal): Integer; cdecl;external 'libc.so.6' name 'connect';
function socket(domain, _type, protocol: Integer): longint; cdecl; external 'libc.so.6' name 'socket';
function inet_addr(cp: PChar): longword; cdecl;external 'libc.so.6' name 'inet_addr';
function gethostbyname(name: PChar): PHostEnt; cdecl;external 'libc.so.6' name 'gethostbyname';
function htons(hostshort: word): word; cdecl;external 'libc.so.6' name 'htons';
function poll(fds: PPollFD; nfds: LongWord; timeout: Integer): Integer; cdecl;external 'libc.so.6' name 'poll';
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////

{$IFNDEF _WIN_}
var
  errno:longint;
{$ENDIF}
////////////////////////////////////////////////////////////////////////////////
{$IFDEF _WIN_}
var
  fwsaData:WSADATA; // on windows winsock
{$ENDIF}

{$IFDEF _WIN_}
////////////////////////////////////////////////////////////////////////////////
procedure FD_SET(Socket: longint; var FDSet: TFDSet);
begin
  if FDSet.fd_count < FD_SETSIZE then
    begin
      FDSet.fd_array[FDSet.fd_count] := Socket;
      Inc(FDSet.fd_count);
    end;
end;

////////////////////////////////////////////////////////////////////////////////
// poll implementation using select
// not needed on linux
function poll(fds:TPollFD; timeout:longint):longint;
var
  err,count,n:longint;
  rfd,wfd,efd,ifd:tfdset;
  timebuf:timeval;
  tbuff:ptimeval;
  events,fd:longint;
  revents:longint;
begin
  tbuff :=nil;
  n:=0;
  ifd.fd_count:=0;
  rfd.fd_count:=0;
  wfd.fd_count:=0;
  efd.fd_count:=0;
  events := fds.events;
  fd := fds.fd;
  fds.revents := 0;
  if not((fd < 0) or (__WSAFDIsSet(fd, ifd))) then
    begin
      if (fd > n) then
        n := fd;
      if (events and POLL_CAN_READ)=POLL_CAN_READ then
        FD_SET(fd, rfd);
      if (events and POLL_CAN_WRITE)=POLL_CAN_WRITE then
        FD_SET(fd, wfd);
      if (events and POLL_HAS_EXCP)=POLL_HAS_EXCP then
        FD_SET(fd, efd);
    end;
  if(timeout >= 0) then
    begin
      timebuf.tv_sec := timeout div 1000;
      timebuf.tv_usec := (timeout div 1000) * 1000;
      tbuff := @timebuf;
    end;
  err := select(n+1,@rfd,@wfd,@efd,tbuff);
  if(err < 0) then
    begin
      result:=err;
      exit;
    end;
  count := 0;
  revents := (fds.events and POLL_EVENTS_MASK);
  fd := fds.fd;
  if(fd >= 0) then
    begin
      if (__WSAFDIsSet(fd, ifd))then
        revents := POLLNVAL
      else
        begin
          if not(__WSAFDIsSet(fd, rfd)) then
            revents :=revents and not POLL_CAN_READ;
          if not(__WSAFDIsSet(fd, wfd)) then
            revents :=revents and not POLL_CAN_WRITE;
          if not(__WSAFDIsSet(fd, efd)) then
            revents :=revents and not POLL_HAS_EXCP;
        end;
      fds.revents := revents;
      if (fds.revents <> 0) then
        inc(count);
    end;
  if count>0 then
    result:=count
  else
    result:=-1; //no socket has changed
end;
{$ENDIF}

{------------------------------------------------------------------------------}
{ TMysqlVio }
{------------------------------------------------------------------------------}

////////////////////////////////////////////////////////////////////////////////
// class constructor
constructor TMysqlVio.create;
begin
  inherited;
  FSd :=-1;
  FHPipe :=-1;
  ffcntl_mode :=0;
  ftype :=VIO_CLOSED;
  flast_error:='';
  flast_errno:=0;
  fNoTimeOut:=true;
  {$IFDEF HAVE_SSL}
  fssl:=nil;
  fnewcon:=nil;
  {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
// class destructor
destructor TMysqlVio.destroy;
begin
  if (ftype<>VIO_CLOSED)then //if vio open
    vio_close; //close it
  inherited destroy;
end;

////////////////////////////////////////////////////////////////////////////////
// attempt to use fast send
function TMysqlVio.fastsend: longint;
var
  nodelay:longint;
begin
  result:=0;
  if setsockopt(fsd, IPPROTO_IP, IP_TOS, nil, 0)<>0 then
    begin
      nodelay:=1;
      if (setsockopt(fsd, IPPROTO_TCP, TCP_NODELAY, pchar(@nodelay),sizeof(nodelay)))<>0 then
        result:= -1;
    end;
end;

////////////////////////////////////////////////////////////////////////////////
// get last error text value
function TMysqlVio.Getlast_error: string;
begin
  result:=Flast_error;
end;

////////////////////////////////////////////////////////////////////////////////
// sets/resets keepalive on socket
function TMysqlVio.keepalive(onoff: boolean): longint;
var
  opt:longint;
begin
  opt:=0;
  if (onoff) then
    opt:=1;
  result:=setsockopt(fsd, SOL_SOCKET, SO_KEEPALIVE, pchar(@opt),sizeof(opt));
end;

{$IFDEF HAVE_SSL}
////////////////////////////////////////////////////////////////////////////////
// attempt to create a ssl connector
function TMysqlVio.new_VioSSLConnectorFd(const key, cert, ca, capath,
  cipher: pchar): pointer;
var
  ptr:^st_VioSSLConnectorFd;
  dh:pointer;
begin
  result:=nil;
  new(ptr);
  ptr.ssl_context_:=nil;
  ptr.ssl_method_:=nil;
  //do we have the algorithms loaded?
  if not(ssl_algorithms_added) then
    begin
      ssl_algorithms_added := TRUE;
      OpenSSL_add_all_algorithms; //load them
    end;
  //do we have the error strings?
  if not(ssl_error_strings_loaded)then
    begin
      ssl_error_strings_loaded := TRUE;
      SSL_load_error_strings; //load them
    end;
  ptr.ssl_method_ := TLSv1_client_method; //get the methods
  ptr.ssl_context_ := SSL_CTX_new(ptr.ssl_method_); //get the context
  if (ptr.ssl_context_ = nil) then //empty contex?
    begin
      dispose(ptr);
      exit;
    end;
  if (cipher<>nil)then //did we passed any ciphers?
    SSL_CTX_set_cipher_list(ptr.ssl_context_, cipher);
  //let's check the context
  SSL_CTX_set_verify(ptr.ssl_context_, 1{SSL_VERIFY_PEER}, addr(vio_verify_callback));
  //set the cert stuff
  if (vio_set_cert_stuff(ptr.ssl_context_, cert, key) = -1) then
    begin
      dispose(ptr);
      exit;
    end;
  //verify the locations
  if (SSL_CTX_load_verify_locations( ptr.ssl_context_, ca,capath)=0) then
    if (SSL_CTX_set_default_verify_paths(ptr.ssl_context_)=0) then
      begin
        dispose(ptr);
        exit;
      end;
  //get a new dh
  dh:=get_dh512;
  //check it
  SSL_CTX_ctrl(ptr.ssl_context_,3{SSL_CTRL_SET_TMP_DH},0,dh);
  DH_free(dh);
  result:=ptr;
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////
// set no use of timeout
procedure TMysqlVio.SetNoTimeOut(const Value: boolean);
begin
  if not Value then // we use timeout
    if ftimeout=0 then //is it 0 seconds?
      ftimeout:=NET_READ_TIMEOUT;
  fNoTimeOut:=Value;
  if fNoTimeOut and (ftype = VIO_TYPE_TCPIP) then
    vio_blocking(true);
end;

////////////////////////////////////////////////////////////////////////////////
// set last error text value
procedure TMysqlVio.Setlast_error(const Value: string);
begin
  Flast_error := Value;
end;

{$IFDEF HAVE_SSL}
////////////////////////////////////////////////////////////////////////////////
// attempt to use ssl
procedure TMysqlVio.SwitchToSSL(const key:pchar;const cert:pchar;const ca:pchar;const capath:pchar;var cipher:pchar; timeout:cardinal);
var
  newcon:^st_VioSSLConnectorFd;
  l:longint;
  server_cert:pointer;
  s:string;
begin
  //are we connected? or are we using named pipe?
  if (ftype<>VIO_CLOSED) and (ftype<>VIO_TYPE_NAMEDPIPE) then
    begin
      //grab a connector
      if cipher='' then
        newcon:= new_VioSSLConnectorFd(key, cert, ca, capath, cipher)
      else
        newcon:= new_VioSSLConnectorFd(key, cert, ca, capath, nil);
      fnewcon:=newcon;
      //new ssl
      fssl := SSL_new(st_VioSSLConnectorFd(newcon^).ssl_context_);
      if (fssl=nil) then
        begin //errors?
          dispose(newcon);
          fnewcon:=nil;
          exit;
        end;
      ftype:=VIO_CLOSED;
      SSL_clear(fssl);
      vio_blocking(FALSE);
      SSL_SESSION_set_timeout(SSL_get_session(fssl), timeout);
      SSL_set_fd (fssl, fsd);
      SSL_set_connect_state(fssl);
      l:=0;
      while( SSL_state(fssl) <> $03 ) do
        begin
          l:=SSL_do_handshake( fssl );
          if l<=0 then
            begin
              if not (SSL_get_error( fssl, l ) in [2,3]) then
                break;
            end
          else
            break;
        end;
      if l=1 then
        begin //success
          ftype:=VIO_TYPE_SSL;
          fastsend; //attempt to use fastsend
          keepalive(TRUE);
          cipher:=SSL_CIPHER_get_name(SSL_get_current_cipher(fssl));
          //now we can do some checking on server
          server_cert := SSL_get_peer_certificate (fssl);
          if (server_cert <> nil) then
            begin
              s := X509_NAME_oneline (X509_get_subject_name (server_cert), nil, 0);
              //showmessage('info subject: '+ s);

              s := X509_NAME_oneline (X509_get_issuer_name  (server_cert), nil, 0);
              //showmessage('info issuer: '+ s);

              // We could do all sorts of certificate verification stuff here before deallocating the certificate. */
              X509_free (server_cert);
            end
          else
            //showmessage('info Server does not have certificate.');
            ;
        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;
var
  b: array[0..255] of byte;
  _i: integer;
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,1)<>0) then
        result:=-1;
      vio_blocking(false);
      repeat
        {$IFDEF _WIN_}
        sleep(1);
        {$ENDIF}
        _i:= vio_read(@b[0], 256);
      until (_i <= 0);
      if (closesocket(fsd)<>0) then
        result:=-1;
    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;
  szPipeName:string[255];
  i:integer;
  dwMode:longword;
  {$ELSE}
  haserr:boolean;
  Unixaddr:TUnixSockAddr;
  {$ENDIF}
  sock_addr:TSockAddr;
  ip_addr:cardinal;
  hp:phostent;
  lhost:string; //store temp values
  lunix_socket:string; //store temp values
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;
                        closesocket(sock);
                        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_}
          vio_blocking(false);
          {$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
                        closesocket(sock);
                    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
              closesocket(sock);
              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
              closesocket(sock);
              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.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:

[Pascal Warnung] prWindowsMM2007.dpr(17): W1005 Unit 'Borland.Vcl.Forms' ist plattformspezifisch
[Pascal Warnung] uWindowsMM2007.pas(6): W1005 Unit 'Borland.Vcl.Windows' ist plattformspezifisch
[Pascal Warnung] uWindowsMM2007.pas(6): W1005 Unit 'Borland.Vcl.Messages' ist plattformspezifisch
[Pascal Warnung] uWindowsMM2007.pas(6): W1005 Unit 'Borland.Vcl.Graphics' ist plattformspezifisch
[Pascal Warnung] uWindowsMM2007.pas(6): W1005 Unit 'Borland.Vcl.Controls' ist plattformspezifisch
[Pascal Warnung] uWindowsMM2007.pas(6): W1005 Unit 'Borland.Vcl.Forms' ist plattformspezifisch
[Pascal Warnung] uWindowsMM2007.pas(7): W1005 Unit 'Borland.Vcl.Dialogs' ist plattformspezifisch
[Pascal Warnung] uWindowsMM2007.pas(7): W1005 Unit 'Borland.Vcl.StdCtrls' ist plattformspezifisch
[Pascal Warnung] uMysqlVio.pas(57): W1005 Unit 'Borland.Vcl.Windows' ist plattformspezifisch
[Pascal Fehler] uMysqlVio.pas(93): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(94): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(189): E2397 Unsicherer Zeiger nur beim Compilieren mit {$UNSAFECODE ON} zulässig
[Pascal Fehler] uMysqlVio.pas(190): E2397 Unsicherer Zeiger nur beim Compilieren mit {$UNSAFECODE ON} zulässig
[Pascal Warnung] uMysqlVio.pas(193): W1046 Unsicherer Typ 'HostEnt'
[Pascal Fehler] uMysqlVio.pas(194): E2397 Unsicherer Zeiger nur beim Compilieren mit {$UNSAFECODE ON} zulässig
[Pascal Fehler] uMysqlVio.pas(195): E2397 Unsicherer Zeiger nur beim Compilieren mit {$UNSAFECODE ON} zulässig
[Pascal Warnung] uMysqlVio.pas(205): W1046 Unsicherer Typ 'in_addr'
[Pascal Warnung] uMysqlVio.pas(228): W1046 Unsicherer Typ 'TSockAddr'
[Pascal Fehler] uMysqlVio.pas(232): E2418 Typ 'Array' muss initialisiert werden- in Variant-Record nicht zulässig
[Pascal Fehler] uMysqlVio.pas(234): E2418 Typ 'Array' muss initialisiert werden- in Variant-Record nicht zulässig
[Pascal Fehler] uMysqlVio.pas(247): E2397 Unsicherer Zeiger nur beim Compilieren mit {$UNSAFECODE ON} zulässig
[Pascal Fehler] uMysqlVio.pas(250): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(256): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(262): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(263): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(280): E2397 Unsicherer Zeiger nur beim Compilieren mit {$UNSAFECODE ON} zulässig
[Pascal Fehler] uMysqlVio.pas(292): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(293): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(295): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(297): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(298): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(342): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(370): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(372): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(446): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(467): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(666): E2197 Konstantenobjekt kann nicht als Var-Parameter weitergegeben werden
[Pascal Fehler] uMysqlVio.pas(709): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(752): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(805): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(822): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(959): E2003 Undefinierter Bezeichner: 'fillchar'
[Pascal Fehler] uMysqlVio.pas(961): E2089 Ungültige Typumwandlung
[Pascal Fehler] uMysqlVio.pas(964): E2089 Ungültige Typumwandlung
[Pascal Fehler] uMysqlVio.pas(966): E2089 Ungültige Typumwandlung
[Pascal Fehler] uMysqlVio.pas(979): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(979): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(979): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(979): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(980): E2089 Ungültige Typumwandlung
[Pascal Fehler] uMysqlVio.pas(1079): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(1102): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(1110): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(1113): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(1160): E2410 Unsichere Zeigervariablen, Parameter oder Konstanten sind nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(1180): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fehler] uMysqlVio.pas(1186): E2396 Unsicherer Code ist nur in unsicheren Prozeduren zulässig
[Pascal Fataler Fehler] uWindowsMM2007.pas(7): F2063 Verwendete Unit 'uMysqlVio.pas' kann nicht compiliert werden