2013-08-20 12:35

''''''RSOCKET.INC''''''Copyright 2002,2003 Global Services
'''by doctorelectron@cwdom.dm  FreeWare,just give attribution if you use it!!
'''Last Updated: June 6,2003

     DECLARE FUNCTION closesocket LIB "wsock32.dll" ALIAS "closesocket"_
      (S AS LONG) AS LONG
     DECLARE FUNCTION connectx LIB "wsock32.dll" ALIAS "connect" (S AS LONG,_
      sockaddr AS LONG,namelen AS INTEGER) AS LONG
     DECLARE FUNCTION gethostbyaddr LIB "wsock32.dll" ALIAS "gethostbyaddr"_
      (addr AS LONG,length AS LONG,protocol AS LONG) AS LONG
     DECLARE FUNCTION gethostbyname LIB "wsock32.dll" ALIAS "gethostbyname"_
      (BYVAL name AS STRING) AS LONG
     DECLARE FUNCTION getpeernamex LIB "wsock32.dll" ALIAS "getpeername"_
      (S AS LONG,BYVAL name AS LONG,namelen AS LONG) AS LONG
     DECLARE FUNCTION htons LIB "wsock32.dll" ALIAS "htons" (hostshort AS INTEGER)_
      AS INTEGER
     DECLARE FUNCTION inet_addr LIB "wsock32.dll" ALIAS "inet_addr"_
      (BYVAL cp AS STRING) AS LONG
     DECLARE FUNCTION inet_ntoa LIB "wsock32.dll" ALIAS "inet_ntoa"_
      (inaddr AS LONG) AS LONG
     DECLARE FUNCTION ioctlsocket LIB "wsock32.dll" ALIAS "ioctlsocket"_
      (S AS LONG,cmd AS LONG,arg AS LONG) AS LONG
     DECLARE FUNCTION selectx LIB "wsock32.dll" ALIAS "select" (nfds AS LONG,_
      readfds AS LONG,writefds AS LONG,exceptfds AS LONG,_
      timeout AS LONG) AS LONG
     DECLARE FUNCTION shutdown LIB "wsock32.dll" ALIAS "shutdown"_
      (S AS LONG,how AS LONG) AS LONG
     DECLARE FUNCTION socket LIB "wsock32.dll" ALIAS "socket" (af AS LONG,_
      type_specification AS LONG,protocol AS LONG) AS LONG

     DECLARE FUNCTION send LIB "wsock32.dll" ALIAS "send" (S AS LONG,_
      buf AS STRING,LEN AS LONG,flags AS LONG) AS LONG
     DECLARE FUNCTION recv LIB "wsock32.dll" ALIAS "recv" (S AS LONG,_
      buf AS STRING,LEN AS LONG,flags AS LONG) AS LONG
     DECLARE FUNCTION sendto LIB "wsock32.dll" ALIAS "sendto" (S AS LONG,_
      buf AS LONG,LEN AS LONG,flags AS LONG,_
      ptrAddress AS LONG,LenAddr AS LONG) AS LONG
     DECLARE FUNCTION recvfrom LIB "wsock32.dll" ALIAS "recvfrom" (S AS LONG,_
      buf AS LONG,LEN AS LONG,flags AS LONG,_
      ptrAddress AS LONG,LenAddr AS LONG) AS LONG
     DECLARE SUB CopyMemory LIB "kernel32.dll" ALIAS "RtlMoveMemory"_
      (hpvDest AS LONG,hpvSource AS LONG,cbCopy AS LONG)




     $IFNDEF __WIN32API
      DECLARE FUNCTION lstrlen LIB "kernel32.dll" ALIAS "lstrlenA"_
       (BYVAL lpString AS LONG) AS LONG
      DECLARE FUNCTION lstrcpy LIB "kernel32.dll" ALIAS "lstrcpyA"_
       (BYVAL lpString1 AS LONG,BYVAL lpString2 AS LONG) AS LONG

      $IFNDEF __RQINC2
       DECLARE FUNCTION WSAGetLastError LIB "wsock32.dll" ALIAS "WSAGetLastError"_
        () AS LONG

      $ENDIF
     $ENDIF

     DIM arg AS LONG,num AS LONG,ptr1 AS LONG,ptr2 AS LONG
     DIM bs(15&) AS BYTE
     DIM struc(0& TO 3&) AS LONG
     DIM FD_SET(0& TO 1&) AS LONG,TimeType(0& TO 1&) AS LONG
     DIM str1 AS STRING

     TYPE RSocket EXTENDS QSOCKET

      FUNCTION GetPeerName(S AS LONG) AS STRING
       Result="": arg=16&
       num=getpeernamex(S,VARPTR(bs(0&)),VARPTR(arg))
       IF num<0& THEN EXIT FUNCTION
       IF arg<1& THEN EXIT FUNCTION
       Result=STR$(bs(4&))+"."+STR$(bs(5&))+"."+STR$(bs(6&))+"."+STR$(bs(7&))
      END FUNCTION

      FUNCTION AddrByName(strName AS STRING) AS STRING
       Result=""
       ptr1=gethostbyname(strName)
       IF ptr1=0& THEN EXIT FUNCTION  'Can't get Host by Name
       CopyMemory @struc(0&),ptr1,16&
       IF RIGHT$(HEX$(struc(2&)),2&) <> "02" THEN
        EXIT FUNCTION	'A non-IP address was returned.
       ELSE
        CopyMemory @ptr2,struc(3&),4&
        CopyMemory @num,ptr2,4&
        ptr1=inet_ntoa(num)
        str1=SPACE$(lstrlen(ptr1))
        num=lstrcpy(VARPTR(str1),ptr1)
       END IF
       Result=str1
      END FUNCTION

      FUNCTION NameByAddr(strIP AS STRING) AS STRING
       Result=""
       num=inet_addr(strIP)
       IF num=&HFFFFFFFF THEN EXIT FUNCTION
       ptr1=gethostbyaddr(@num,4&,2&)
       IF ptr1=0& THEN
        EXIT FUNCTION    'Could not get name for the IP
       ELSE
        CopyMemory @struc(0&),ptr1,16&
        str1=SPACE$(lstrlen(struc(0&)))
        num=lstrcpy(VARPTR(str1),struc(0&))
        Result=RTRIM$(str1)
       END IF
      END FUNCTION

      FUNCTION S AS LONG
       Result=socket(RSocket.Family,RSocket.TYPE,RSocket.Protocol)
      END FUNCTION

      FUNCTION CLOSE(S AS LONG) AS LONG
       Result=closesocket(S)
      END FUNCTION

      FUNCTION NonBlock(S AS LONG) AS LONG
       arg=1&: Result=ioctlsocket(S,&H8004667E,@arg)
      END FUNCTION

      FUNCTION Block(S AS LONG) AS LONG
       arg=0&: Result=ioctlsocket(S,&H8004667E,@arg)
      END FUNCTION

      FUNCTION Connect(S AS LONG,Remote AS STRING,Port AS INTEGER) AS LONG
       Result=-1&
       Struc(0)=RSocket.Family
       num=htons(Port)
       ptr1=VARPTR(Struc(0))+2&
       CopyMemory ptr1,VARPTR(num),2&
       struc(1&)=inet_addr(Remote)
       IF struc(1&)=&HFFFFFFFF THEN EXIT FUNCTION
       struc(2&)=0&: struc(3&)=0&
       Result=connectx(S,VARPTR(struc(0&)),16&)
      END FUNCTION

      FUNCTION IsConnected(S AS LONG,Secs AS LONG) AS LONG
       Result=-1&
       FD_SET(0)=1&: FD_SET(1)=S: arg=0&: TimeType(0&)=Secs: TimeType(1&)=0&
       num=selectx(0&,arg,arg,VARPTR(FD_SET(0&)),VARPTR(TimeType(0&)))
       IF FD_SET(0&)=1& THEN EXIT FUNCTION
       FD_SET(0&)=1&: FD_SET(1&)=S
       Result=selectx(0&,arg,VARPTR(FD_SET(0&)),arg,VARPTR(TimeType(0&)))
      END FUNCTION

      FUNCTION EndConnection(S AS LONG) AS LONG
       Result=shutdown(S,2&)
      END FUNCTION

      FUNCTION LastError AS STRING
       arg=WSAGetLastError
       SELECT CASE arg
       CASE 10004&: Result="Interrupted system call."
       CASE 10009&: Result="Bad socket number."
       CASE 10013&: Result="Permission Denied."
       CASE 10014&: Result="Bad Address."
       CASE 10022&: Result="Invalid Argument."
       CASE 10024&: Result="Too many sockets."
       CASE 10035&: Result="Operation would block."
       CASE 10036&: Result="Operation now in progress."
       CASE 10037&: Result="Operation already in progress."
       CASE 10038&: Result="Socket operation on nonsocket."
       CASE 10039&: Result="Destination address required."
       CASE 10040&: Result="Message too long."
       CASE 10041&: Result="Protocol wrong type for socket."
       CASE 10042&: Result="Protocol not available."
       CASE 10043&: Result="Protocol not supported."
       CASE 10044&: Result="Socket type not supported."
       CASE 10045&: Result="Operation not supported on socket."
       CASE 10046&: Result="Protocol family not supported."
       CASE 10047&: Result="Address family not supported by protocol family."
       CASE 10048&: Result="Address already in use."
       CASE 10049&: Result="Can't assign requested address."
       CASE 10050&: Result="Network is down."
       CASE 10051&: Result="Network is unreachable."
       CASE 10052&: Result="Network dropped connection."
       CASE 10053&: Result="Software caused connection abort."
       CASE 10054&: Result="Connection reset by peer."
       CASE 10055&: Result="No buffer space available."
       CASE 10056&: Result="Socket is already connected."
       CASE 10057&: Result="Socket is not connected."
       CASE 10058&: Result="Can't send after socket shutdown."
       CASE 10059&: Result="Too many references: can't splice."
       CASE 10060&: Result="Connection timed out."
       CASE 10061&: Result="Connection refused."
       CASE 10062&: Result="Too many levels of symbolic links."
       CASE 10063&: Result="File name too long."
       CASE 10064&: Result="Host is down."
       CASE 10065&: Result="No route to host."
       CASE 10066&: Result="Directory not empty."
       CASE 10067&: Result="Too many processes."
       CASE 10068&: Result="Too many users."
       CASE 10069&: Result="Disk quota exceeded."
       CASE 10070&: Result="Stale NFS file handle."
       CASE 10071&: Result="Too many levels of remote in path."
       CASE 10091&: Result="Network subsystem is unusable."
       CASE 10092&: Result="Winsock DLL cannot support this application."
       CASE 10093&: Result="Winsock not initialized."
       CASE 10101&: Result="Disconnect."
       CASE 11001&: Result="Host not found."
       CASE 11002&: Result="Nonauthoritative host not found."
       CASE 11003&: Result="Nonrecoverable error."
       CASE 11004&: Result="Valid name,no data record of requested type."
       CASE ELSE:  Result="Unknown error."
       END SELECT
       Result=STR$(arg)+" "+Result
      END FUNCTION

      FUNCTION WriteLine(S AS LONG,str AS STRING) AS LONG
       str1=str+CHR$(13?)+CHR$(10?)
       Result=send(S,str1,LEN(str1),0&)
      END FUNCTION

     END TYPE

2013-08-20 12:35