AuroNet/CSocketMaster.cls

   1 VERSION 1.0 CLASS
   2 BEGIN
   3   MultiUse = -1  'True
   4   Persistable = 0  'NotPersistable
   5   DataBindingBehavior = 0  'vbNone
   6   DataSourceBehavior  = 0  'vbNone
   7   MTSTransactionMode  = 0  'NotAnMTSObject
   8 END
   9 Attribute VB_Name = "CSocketMaster"
  10 Attribute VB_GlobalNameSpace = False
  11 Attribute VB_Creatable = True
  12 Attribute VB_PredeclaredId = False
  13 Attribute VB_Exposed = False
  14 '********************************************************************************
  15 '
  16 'Name.......... CSocketMaster
  17 'File.......... CSocketMaster.cls
  18 'Version....... 1.2
  19 'Dependencies.. Requires modSocketMaster.bas code module
  20 'Description... Winsock api implementation class
  21 'Author........ Emiliano Scavuzzo <anshoku@yahoo.com>
  22 'Date.......... June, 28th 2004
  23 'Copyright (c) 2004 by Emiliano Scavuzzo
  24 'Rosario, Argentina
  25 '
  26 'Based on CSocket by Oleg Gdalevich
  27 'Subclassing based on WinSubHook2 by Paul Caton <Paul_Caton@hotmail.com>
  28 '
  29 '********************************************************************************
  30 Option Explicit
  31 '==============================================================================
  32 'API FUNCTIONS
  33 '==============================================================================
  34 Private Declare Function api_socket _
  35                 Lib "ws2_32.dll" _
  36                 Alias "socket" (ByVal af As Long, _
  37                                 ByVal s_type As Long, _
  38                                 ByVal Protocol As Long) As Long
  39 Private Declare Function api_GlobalLock _
  40                 Lib "kernel32" _
  41                 Alias "GlobalLock" (ByVal hMem As Long) As Long
  42 Private Declare Function api_GlobalUnlock _
  43                 Lib "kernel32" _
  44                 Alias "GlobalUnlock" (ByVal hMem As Long) As Long
  45 Private Declare Function api_htons _
  46                 Lib "ws2_32.dll" _
  47                 Alias "htons" (ByVal hostshort As Integer) As Integer
  48 Private Declare Function api_ntohs _
  49                 Lib "ws2_32.dll" _
  50                 Alias "ntohs" (ByVal netshort As Integer) As Integer
  51 Private Declare Function api_connect _
  52                 Lib "ws2_32.dll" _
  53                 Alias "connect" (ByVal s As Long, _
  54                                  ByRef name As sockaddr_in, _
  55                                  ByVal namelen As Long) As Long
  56 Private Declare Function api_gethostname _
  57                 Lib "ws2_32.dll" _
  58                 Alias "gethostname" (ByVal host_name As String, _
  59                                      ByVal namelen As Long) As Long
  60 Private Declare Function api_gethostbyname _
  61                 Lib "ws2_32.dll" _
  62                 Alias "gethostbyname" (ByVal host_name As String) As Long
  63 Private Declare Function api_bind _
  64                 Lib "ws2_32.dll" _
  65                 Alias "bind" (ByVal s As Long, _
  66                               ByRef name As sockaddr_in, _
  67                               ByVal namelen As Long) As Long
  68 Private Declare Function api_getsockname _
  69                 Lib "ws2_32.dll" _
  70                 Alias "getsockname" (ByVal s As Long, _
  71                                      ByRef name As sockaddr_in, _
  72                                      ByRef namelen As Long) As Long
  73 Private Declare Function api_getpeername _
  74                 Lib "ws2_32.dll" _
  75                 Alias "getpeername" (ByVal s As Long, _
  76                                      ByRef name As sockaddr_in, _
  77                                      ByRef namelen As Long) As Long
  78 Private Declare Function api_inet_addr _
  79                 Lib "ws2_32.dll" _
  80                 Alias "inet_addr" (ByVal cp As String) As Long
  81 Private Declare Function api_send _
  82                 Lib "ws2_32.dll" _
  83                 Alias "send" (ByVal s As Long, _
  84                               ByRef buf As Any, _
  85                               ByVal buflen As Long, _
  86                               ByVal flags As Long) As Long
  87 Private Declare Function api_sendto _
  88                 Lib "ws2_32.dll" _
  89                 Alias "sendto" (ByVal s As Long, _
  90                                 ByRef buf As Any, _
  91                                 ByVal buflen As Long, _
  92                                 ByVal flags As Long, _
  93                                 ByRef toaddr As sockaddr_in, _
  94                                 ByVal tolen As Long) As Long
  95 Private Declare Function api_getsockopt _
  96                 Lib "ws2_32.dll" _
  97                 Alias "getsockopt" (ByVal s As Long, _
  98                                     ByVal level As Long, _
  99                                     ByVal optname As Long, _
 100                                     optval As Any, _
 101                                     optlen As Long) As Long
 102 Private Declare Function api_setsockopt _
 103                 Lib "ws2_32.dll" _
 104                 Alias "setsockopt" (ByVal s As Long, _
 105                                     ByVal level As Long, _
 106                                     ByVal optname As Long, _
 107                                     optval As Any, _
 108                                     ByVal optlen As Long) As Long
 109 Private Declare Function api_recv _
 110                 Lib "ws2_32.dll" _
 111                 Alias "recv" (ByVal s As Long, _
 112                               ByRef buf As Any, _
 113                               ByVal buflen As Long, _
 114                               ByVal flags As Long) As Long
 115 Private Declare Function api_recvfrom _
 116                 Lib "ws2_32.dll" _
 117                 Alias "recvfrom" (ByVal s As Long, _
 118                                   ByRef buf As Any, _
 119                                   ByVal buflen As Long, _
 120                                   ByVal flags As Long, _
 121                                   ByRef from As sockaddr_in, _
 122                                   ByRef fromlen As Long) As Long
 123 Private Declare Function api_WSACancelAsyncRequest _
 124                 Lib "ws2_32.dll" _
 125                 Alias "WSACancelAsyncRequest" (ByVal hAsyncTaskHandle As Long) As Long
 126 Private Declare Function api_listen _
 127                 Lib "ws2_32.dll" _
 128                 Alias "listen" (ByVal s As Long, _
 129                                 ByVal backlog As Long) As Long
 130 Private Declare Function api_accept _
 131                 Lib "ws2_32.dll" _
 132                 Alias "accept" (ByVal s As Long, _
 133                                 ByRef addr As sockaddr_in, _
 134                                 ByRef addrlen As Long) As Long
 135 Private Declare Function api_inet_ntoa _
 136                 Lib "ws2_32.dll" _
 137                 Alias "inet_ntoa" (ByVal inn As Long) As Long
 138 Private Declare Function api_ioctlsocket _
 139                 Lib "ws2_32.dll" _
 140                 Alias "ioctlsocket" (ByVal s As Long, _
 141                                      ByVal cmd As Long, _
 142                                      ByRef argp As Long) As Long
 143 Private Declare Function api_closesocket _
 144                 Lib "ws2_32.dll" _
 145                 Alias "closesocket" (ByVal s As Long) As Long
 146 'Private Declare Function api_gethostbyaddr Lib "ws2_32.dll" Alias "gethostbyaddr" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
 147 '==============================================================================
 148 'CONSTANTS
 149 '==============================================================================
 150 Public Enum SockState
 151     sckClosed = 0
 152     sckOpen
 153     sckListening
 154     sckConnectionPending
 155     sckResolvingHost
 156     sckHostResolved
 157     sckConnecting
 158     sckConnected
 159     sckClosing
 160     sckError
 161 End Enum
 162 Private Const SOMAXCONN As Long = 5
 163 Public Enum ProtocolConstants
 164     sckTCPProtocol = 0
 165     sckUDPProtocol = 1
 166 End Enum
 167 Private Const MSG_PEEK  As Long = &H2
 168 '==============================================================================
 169 'EVENTS
 170 '==============================================================================
 171 Public Event CloseSck()
 172 Public Event Connect()
 173 Public Event ConnectionRequest(ByVal requestID As Long)
 174 Public Event DataArrival(ByVal bytesTotal As Long)
 175 Public Event error(ByVal Number As Integer, Description As String, ByVal sCode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
 176 Public Event SendComplete()
 177 Public Event SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
 178 '==============================================================================
 179 'MEMBER VARIABLES
 180 '==============================================================================
 181 Private m_lngSocketHandle       As Long                 'socket handle
 182 Private m_enmState              As SockState            'socket state
 183 Private m_strTag                As String               'tag
 184 Private m_strRemoteHost         As String               'remote host
 185 Private m_lngRemotePort         As Long                 'remote port
 186 Private m_strRemoteHostIP       As String               'remote host ip
 187 Private m_lngLocalPort          As Long                 'local port
 188 Private m_lngLocalPortBind      As Long                 'temporary local port
 189 Private m_strLocalIP            As String               'local IP
 190 Private m_enmProtocol           As ProtocolConstants    'protocol used (TCP / UDP)
 191 Private m_lngMemoryPointer  As Long 'memory pointer used as buffer when resolving host
 192 Private m_lngMemoryHandle   As Long 'buffer memory handle
 193 Private m_lngSendBufferLen  As Long 'winsock buffer size for sends
 194 Private m_lngRecvBufferLen  As Long 'winsock buffer size for receives
 195 Private m_strSendBuffer As String   'local incoming buffer
 196 Private m_strRecvBuffer As String   'local outgoing buffer
 197 Private m_blnAcceptClass As Boolean 'if True then this is an Accept socket class
 198 Private m_colWaitingResolutions As Collection   'hosts waiting to be resolved by the system
 199
 200 '  ****  WARNING WARNING WARNING WARNING ******
 201 'This sub MUST be the first on the class. DO NOT attempt
 202 'to change it's location or the code will CRASH.
 203 'This sub receives system messages from our WndProc.
 204 Public Sub WndProc(ByVal hWnd As Long, _
 205                    ByVal uMsg As Long, _
 206                    ByVal wParam As Long, _
 207                    ByVal lParam As Long)
 208     '<EhHeader>
 209     On Error GoTo WndProc_Err
 210
 211     '</EhHeader>
 212     Select Case uMsg
 213
 214         Case RESOLVE_MESSAGE
 215             PostResolution wParam, HiWord(lParam)
 216
 217         Case SOCKET_MESSAGE
 218             PostSocket LoWord(lParam), HiWord(lParam)
 219     End Select
 220
 221     '<EhFooter>
 222     Exit Sub
 223 WndProc_Err:
 224     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.WndProc"
 225     Resume Next
 226     '</EhFooter>
 227 End Sub
 228
 229 Private Sub Class_Initialize()
 230     'socket's handle default value
 231     '<EhHeader>
 232     On Error GoTo Class_Initialize_Err
 233     '</EhHeader>
 234     m_lngSocketHandle = INVALID_SOCKET
 235     'initiate resolution collection
 236     Set m_colWaitingResolutions = New Collection
 237     'initiate processes and winsock service
 238     modSocketMaster.InitiateProcesses
 239     '<EhFooter>
 240     Exit Sub
 241 Class_Initialize_Err:
 242     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Class_Initialize"
 243     Resume Next
 244     '</EhFooter>
 245 End Sub
 246
 247 Private Sub Class_Terminate()
 248     'clean hostname resolution system
 249     '<EhHeader>
 250     On Error Resume Next
 251     '</EhHeader>
 252     CleanResolutionSystem
 253
 254     'destroy socket if it exists
 255     If Not m_blnAcceptClass Then DestroySocket
 256     'clean processes and finish winsock service
 257     modSocketMaster.FinalizeProcesses
 258     'clean resolution collection
 259     Set m_colWaitingResolutions = Nothing
 260 End Sub
 261
 262 '==============================================================================
 263 'PROPERTIES
 264 '==============================================================================
 265 Public Property Get RemotePort() As Long
 266     '<EhHeader>
 267     On Error GoTo RemotePort_Err
 268     '</EhHeader>
 269     RemotePort = m_lngRemotePort
 270     '<EhFooter>
 271     Exit Property
 272 RemotePort_Err:
 273     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemotePort"
 274     Resume Next
 275     '</EhFooter>
 276 End Property
 277
 278 Public Property Let RemotePort(ByVal lngPort As Long)
 279     '<EhHeader>
 280     On Error GoTo RemotePort_Err
 281
 282     '</EhHeader>
 283     If m_enmProtocol = sckTCPProtocol And m_enmState <> sckClosed Then
 284         Err.Raise sckInvalidOp, "CSocketMaster.RemotePort", "Invalid operation at current state"
 285     End If
 286
 287     If lngPort < 0 Or lngPort > 65535 Then
 288         Err.Raise sckInvalidArg, "CSocketMaster.RemotePort", "The argument passed to a function was not in the correct format or in the specified range."
 289     Else
 290         m_lngRemotePort = lngPort
 291     End If
 292
 293     '<EhFooter>
 294     Exit Property
 295 RemotePort_Err:
 296     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemotePort"
 297     Resume Next
 298     '</EhFooter>
 299 End Property
 300
 301 Public Property Get RemoteHost() As String
 302     '<EhHeader>
 303     On Error GoTo RemoteHost_Err
 304     '</EhHeader>
 305     RemoteHost = m_strRemoteHost
 306     '<EhFooter>
 307     Exit Property
 308 RemoteHost_Err:
 309     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemoteHost"
 310     Resume Next
 311     '</EhFooter>
 312 End Property
 313
 314 Public Property Let RemoteHost(ByVal strHost As String)
 315     '<EhHeader>
 316     On Error GoTo RemoteHost_Err
 317
 318     '</EhHeader>
 319     If m_enmProtocol = sckTCPProtocol And m_enmState <> sckClosed Then
 320         Err.Raise sckInvalidOp, "CSocketMaster.RemoteHost", "Invalid operation at current state"
 321     End If
 322
 323     m_strRemoteHost = strHost
 324     '<EhFooter>
 325     Exit Property
 326 RemoteHost_Err:
 327     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemoteHost"
 328     Resume Next
 329     '</EhFooter>
 330 End Property
 331
 332 Public Property Get RemoteHostIP() As String
 333     '<EhHeader>
 334     On Error GoTo RemoteHostIP_Err
 335     '</EhHeader>
 336     RemoteHostIP = m_strRemoteHostIP
 337     '<EhFooter>
 338     Exit Property
 339 RemoteHostIP_Err:
 340     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemoteHostIP"
 341     Resume Next
 342     '</EhFooter>
 343 End Property
 344
 345 Public Property Get LocalPort() As Long
 346     '<EhHeader>
 347     On Error GoTo LocalPort_Err
 348
 349     '</EhHeader>
 350     If m_lngLocalPortBind = 0 Then
 351         LocalPort = m_lngLocalPort
 352     Else
 353         LocalPort = m_lngLocalPortBind
 354     End If
 355
 356     '<EhFooter>
 357     Exit Property
 358 LocalPort_Err:
 359     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.LocalPort"
 360     Resume Next
 361     '</EhFooter>
 362 End Property
 363
 364 Public Property Let LocalPort(ByVal lngPort As Long)
 365     '<EhHeader>
 366     On Error GoTo LocalPort_Err
 367
 368     '</EhHeader>
 369     If m_enmState <> sckClosed Then
 370         Err.Raise sckInvalidOp, "CSocketMaster.LocalPort", "Invalid operation at current state"
 371     End If
 372
 373     If lngPort < 0 Or lngPort > 65535 Then
 374         Err.Raise sckInvalidArg, "CSocketMaster.LocalPort", "The argument passed to a function was not in the correct format or in the specified range."
 375     Else
 376         m_lngLocalPort = lngPort
 377     End If
 378
 379     '<EhFooter>
 380     Exit Property
 381 LocalPort_Err:
 382     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.LocalPort"
 383     Resume Next
 384     '</EhFooter>
 385 End Property
 386
 387 Public Property Get State() As SockState
 388     '<EhHeader>
 389     On Error GoTo State_Err
 390     '</EhHeader>
 391     State = m_enmState
 392     '<EhFooter>
 393     Exit Property
 394 State_Err:
 395     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.State"
 396     Resume Next
 397     '</EhFooter>
 398 End Property
 399
 400 Public Property Get LocalHostName() As String
 401     '<EhHeader>
 402     On Error GoTo LocalHostName_Err
 403     '</EhHeader>
 404     LocalHostName = GetLocalHostName
 405     '<EhFooter>
 406     Exit Property
 407 LocalHostName_Err:
 408     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.LocalHostName"
 409     Resume Next
 410     '</EhFooter>
 411 End Property
 412
 413 Public Property Get LocalIP() As String
 414     '<EhHeader>
 415     On Error GoTo LocalIP_Err
 416
 417     '</EhHeader>
 418     If m_enmState = sckConnected Then
 419         LocalIP = m_strLocalIP
 420     Else
 421         LocalIP = GetLocalIP
 422     End If
 423
 424     '<EhFooter>
 425     Exit Property
 426 LocalIP_Err:
 427     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.LocalIP"
 428     Resume Next
 429     '</EhFooter>
 430 End Property
 431
 432 Public Property Get BytesReceived() As Long
 433     '<EhHeader>
 434     On Error GoTo BytesReceived_Err
 435
 436     '</EhHeader>
 437     If m_enmProtocol = sckTCPProtocol Then
 438         BytesReceived = Len(m_strRecvBuffer)
 439     Else
 440         BytesReceived = GetBufferLenUDP
 441     End If
 442
 443     '<EhFooter>
 444     Exit Property
 445 BytesReceived_Err:
 446     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.BytesReceived"
 447     Resume Next
 448     '</EhFooter>
 449 End Property
 450
 451 Public Property Get SocketHandle() As Long
 452     '<EhHeader>
 453     On Error GoTo SocketHandle_Err
 454     '</EhHeader>
 455     SocketHandle = m_lngSocketHandle
 456     '<EhFooter>
 457     Exit Property
 458 SocketHandle_Err:
 459     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SocketHandle"
 460     Resume Next
 461     '</EhFooter>
 462 End Property
 463
 464 Public Property Get Tag() As String
 465     '<EhHeader>
 466     On Error GoTo Tag_Err
 467     '</EhHeader>
 468     Tag = m_strTag
 469     '<EhFooter>
 470     Exit Property
 471 Tag_Err:
 472     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Tag"
 473     Resume Next
 474     '</EhFooter>
 475 End Property
 476
 477 Public Property Let Tag(ByVal strTag As String)
 478     '<EhHeader>
 479     On Error GoTo Tag_Err
 480     '</EhHeader>
 481     m_strTag = strTag
 482     '<EhFooter>
 483     Exit Property
 484 Tag_Err:
 485     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Tag"
 486     Resume Next
 487     '</EhFooter>
 488 End Property
 489
 490 Public Property Get Protocol() As ProtocolConstants
 491     '<EhHeader>
 492     On Error GoTo Protocol_Err
 493     '</EhHeader>
 494     Protocol = m_enmProtocol
 495     '<EhFooter>
 496     Exit Property
 497 Protocol_Err:
 498     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Protocol"
 499     Resume Next
 500     '</EhFooter>
 501 End Property
 502
 503 Public Property Let Protocol(ByVal enmProtocol As ProtocolConstants)
 504     '<EhHeader>
 505     On Error GoTo Protocol_Err
 506
 507     '</EhHeader>
 508     If m_enmState <> sckClosed Then
 509         Err.Raise sckInvalidOp, "CSocketMaster.Protocol", "Invalid operation at current state"
 510     Else
 511         m_enmProtocol = enmProtocol
 512     End If
 513
 514     '<EhFooter>
 515     Exit Property
 516 Protocol_Err:
 517     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Protocol"
 518     Resume Next
 519     '</EhFooter>
 520 End Property
 521
 522 'Destroys the socket if it exists and unregisters it
 523 'from control list.
 524 Private Sub DestroySocket()
 525     '<EhHeader>
 526     On Error GoTo DestroySocket_Err
 527
 528     '</EhHeader>
 529     If Not m_lngSocketHandle = INVALID_SOCKET Then
 530         Dim lngResult As Long
 531         lngResult = api_closesocket(m_lngSocketHandle)
 532
 533         If lngResult = SOCKET_ERROR Then
 534             m_enmState = sckError
 535             Dim lngErrorCode As Long
 536             lngErrorCode = Err.LastDllError
 537             Err.Raise lngErrorCode, "CSocketMaster.DestroySocket", GetErrorDescription(lngErrorCode)
 538         Else
 539             modSocketMaster.UnregisterSocket m_lngSocketHandle
 540             m_lngSocketHandle = INVALID_SOCKET
 541         End If
 542     End If
 543
 544     '<EhFooter>
 545     Exit Sub
 546 DestroySocket_Err:
 547     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.DestroySocket"
 548     Resume Next
 549     '</EhFooter>
 550 End Sub
 551
 552 Public Sub CloseSck()
 553     '<EhHeader>
 554     On Error GoTo CloseSck_Err
 555
 556     '</EhHeader>
 557     If m_lngSocketHandle = INVALID_SOCKET Then Exit Sub
 558     m_enmState = sckClosing
 559     CleanResolutionSystem
 560     DestroySocket
 561     m_lngLocalPortBind = 0
 562     m_strRemoteHostIP = ""
 563     m_strRecvBuffer = ""
 564     m_strSendBuffer = ""
 565     m_lngSendBufferLen = 0
 566     m_lngRecvBufferLen = 0
 567     m_enmState = sckClosed
 568     '<EhFooter>
 569     Exit Sub
 570 CloseSck_Err:
 571     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.CloseSck"
 572     Resume Next
 573     '</EhFooter>
 574 End Sub
 575
 576 'Tries to create a socket if there isn't one yet and registers
 577 'it to the control list.
 578 'Returns TRUE if it has success
 579 Private Function SocketExists() As Boolean
 580     '<EhHeader>
 581     On Error GoTo SocketExists_Err
 582     '</EhHeader>
 583     SocketExists = True
 584     Dim lngResult As Long
 585     Dim lngErrorCode As Long
 586
 587     'check if there is a socket already
 588     If m_lngSocketHandle = INVALID_SOCKET Then
 589
 590         'decide what kind of socket we are creating, TCP or UDP
 591         If m_enmProtocol = sckTCPProtocol Then
 592             lngResult = api_socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
 593         Else
 594             lngResult = api_socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
 595         End If
 596
 597         If lngResult = INVALID_SOCKET Then
 598             m_enmState = sckError
 599             SocketExists = False
 600             lngErrorCode = Err.LastDllError
 601             Dim blnCancelDisplay As Boolean
 602             blnCancelDisplay = True
 603             RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.SocketExists", "", 0, blnCancelDisplay)
 604
 605             If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.SocketExists"
 606         Else
 607             m_lngSocketHandle = lngResult
 608             'set and get some socket options
 609             ProcessOptions
 610             SocketExists = modSocketMaster.RegisterSocket(m_lngSocketHandle, ObjPtr(Me), True)
 611         End If
 612     End If
 613
 614     '<EhFooter>
 615     Exit Function
 616 SocketExists_Err:
 617     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SocketExists"
 618     Resume Next
 619     '</EhFooter>
 620 End Function
 621
 622 'Tries to connect to RemoteHost if it was passed, or uses
 623 'm_strRemoteHost instead. If it is a hostname tries to
 624 'resolve it first.
 625 Public Sub Connect(Optional RemoteHost As Variant, _
 626                    Optional RemotePort As Variant)
 627     '<EhHeader>
 628     On Error GoTo Connect_Err
 629
 630     '</EhHeader>
 631     If m_enmState <> sckClosed Then
 632         Err.Raise sckInvalidOp, "CSocketMaster.Connect", "Invalid operation at current state"
 633     End If
 634
 635     If Not IsMissing(RemoteHost) Then
 636         m_strRemoteHost = CStr(RemoteHost)
 637     End If
 638
 639     'for some reason we get a GPF if we try to
 640     'resolve a null string, so we replace it with
 641     'an empty string
 642     If m_strRemoteHost = vbNullString Then
 643         m_strRemoteHost = ""
 644     End If
 645
 646     'check if RemotePort is a number between 1 and 65535
 647     If Not IsMissing(RemotePort) Then
 648         If IsNumeric(RemotePort) Then
 649             If CLng(RemotePort) > 65535 Or CLng(RemotePort) < 1 Then
 650                 Err.Raise sckInvalidArg, "CSocketMaster.Connect", "The argument passed to a function was not in the correct format or in the specified range."
 651             Else
 652                 m_lngRemotePort = CLng(RemotePort)
 653             End If
 654
 655         Else
 656             Err.Raise sckUnsupported, "CSocketMaster.Connect", "Unsupported variant type."
 657         End If
 658     End If
 659
 660     'create a socket if there isn't one yet
 661     If Not SocketExists Then Exit Sub
 662
 663     'Here we bind the socket
 664     If Not BindInternal Then Exit Sub
 665
 666     'If we are using UDP we just exit silently.
 667     'Remember UDP is a connectionless protocol.
 668     If m_enmProtocol = sckUDPProtocol Then
 669         m_enmState = sckOpen
 670         Exit Sub
 671     End If
 672
 673     'try to get a 32 bits long that is used to identify a host
 674     Dim lngAddress As Long
 675     lngAddress = ResolveIfHostname(m_strRemoteHost)
 676
 677     'We've got two options here:
 678     '1) m_strRemoteHost was an IP, so a resolution wasn't
 679     '   necessary, and now lngAddress is a 32 bits long and
 680     '   we proceed to connect.
 681     '2) m_strRemoteHost was a hostname, so a resolution was
 682     '   necessary and it's taking place right now. We leave
 683     '   silently.
 684     If lngAddress <> vbNull Then
 685         '136         registrar "~SOCK: Conectando directamente por IP", 3
 686         ConnectToIP lngAddress, 0
 687     End If
 688
 689     '<EhFooter>
 690     Exit Sub
 691 Connect_Err:
 692     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Connect"
 693     Resume Next
 694     '</EhFooter>
 695 End Sub
 696
 697 'When the system resolves a hostname in asynchronous way we
 698 'call this function to decide what to do with the result.
 699 Private Sub PostResolution(ByVal lngAsynHandle As Long, _
 700                            ByVal lngErrorCode As Long)
 701     'erase that record from the collection since we won't need it any longer
 702     '<EhHeader>
 703     On Error GoTo PostResolution_Err
 704     '</EhHeader>
 705     m_colWaitingResolutions.Remove "R" & lngAsynHandle
 706     UnregisterResolution lngAsynHandle
 707
 708     If m_enmState <> sckResolvingHost Then Exit Sub
 709     If lngErrorCode = 0 Then 'if there weren't errors trying to resolve the hostname
 710         m_enmState = sckHostResolved
 711         Dim udtHostent As HOSTENT
 712         Dim lngPtrToIP As Long
 713         Dim arrIpAddress(1 To 4) As Byte
 714         Dim lngRemoteHostAddress As Long
 715         Dim Count As Integer
 716         Dim strIpAddress As String
 717         api_CopyMemory udtHostent, ByVal m_lngMemoryPointer, LenB(udtHostent)
 718         api_CopyMemory lngPtrToIP, ByVal udtHostent.hAddrList, 4
 719         api_CopyMemory arrIpAddress(1), ByVal lngPtrToIP, 4
 720         api_CopyMemory lngRemoteHostAddress, ByVal lngPtrToIP, 4
 721         'free memory, won't need it any longer
 722         FreeMemory
 723
 724         'We turn the 32 bits long into a readable string.
 725         'Note: we don't need this string. I put this here just
 726         'in case you need it.
 727         For Count = 1 To 4
 728             strIpAddress = strIpAddress & arrIpAddress(Count) & "."
 729         Next
 730
 731         strIpAddress = Left$(strIpAddress, Len(strIpAddress) - 1)
 732         ConnectToIP lngRemoteHostAddress, 0
 733     Else 'there were errors trying to resolve the hostname
 734         'free buffer memory
 735         FreeMemory
 736         ConnectToIP vbNull, lngErrorCode
 737     End If
 738
 739     '<EhFooter>
 740     Exit Sub
 741 PostResolution_Err:
 742     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.PostResolution"
 743     Resume Next
 744     '</EhFooter>
 745 End Sub
 746
 747 'This procedure is called by the WindowProc callback function.
 748 'The lngEventID argument is an ID of the network event
 749 'occurred for the socket. The lngErrorCode argument contains
 750 'an error code only if an error was occurred during an
 751 'asynchronous execution.
 752 Private Sub PostSocket(ByVal lngEventID As Long, _
 753                        ByVal lngErrorCode As Long)
 754     '<EhHeader>
 755     On Error GoTo PostSocket_Err
 756     '</EhHeader>
 757     Dim blnCancelDisplay As Boolean
 758
 759     'handle any possible error
 760     If lngErrorCode <> 0 Then
 761         m_enmState = sckError
 762         Registrar "~SOCK: Estado -> sckError", 3
 763         blnCancelDisplay = True
 764         RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.PostSocket", "", 0, blnCancelDisplay)
 765
 766         If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.PostSocket"
 767         Exit Sub
 768     End If
 769
 770     Dim udtSockAddr As sockaddr_in
 771     Dim lngResult As Long
 772     Dim lngBytesReceived As Long
 773
 774     Select Case lngEventID
 775
 776             '======================================================================
 777         Case FD_CONNECT
 778
 779             'Arrival of this message means that the connection initiated by the call
 780             'of the connect Winsock API function was successfully established.
 781             'registrar "~SOCK:" & "FD_CONNECT " & m_lngSocketHandle, 3
 782             If m_enmState <> sckConnecting Then
 783                 Registrar "~SOCK:" & "Advertencia: Omitiendo FD_CONNECT", 3
 784                 Exit Sub
 785             End If
 786
 787             'Get the local parameters
 788             GetLocalInfo m_lngSocketHandle, m_lngLocalPortBind, m_strLocalIP
 789             'Get the connection local end-point parameters
 790             GetRemoteInfo m_lngSocketHandle, m_lngRemotePort, m_strRemoteHostIP, m_strRemoteHost
 791             m_enmState = sckConnected
 792             Registrar "~SOCK: Estado -> sckConnected", 3
 793             RaiseEvent Connect
 794
 795             '======================================================================
 796         Case FD_WRITE
 797
 798             'This message means that the socket in a write-able
 799             'state, that is, buffer for outgoing data of the transport
 800             'service is empty and ready to receive data to send through
 801             'the network.
 802             'registrar "~SOCK:" & "FD_WRITE " & m_lngSocketHandle, 3
 803             If m_enmState <> sckConnected Then
 804                 Registrar "~SOCK:" & "Advertencia: Omitiendo FD_WRITE", 3
 805                 Exit Sub
 806             End If
 807
 808             If Len(m_strSendBuffer) > 0 Then
 809                 SendBufferedData
 810             End If
 811
 812             '======================================================================
 813         Case FD_READ
 814
 815             'Some data has arrived for this socket.
 816             'registrar "~SOCK:" & "FD_READ " & m_lngSocketHandle, 3
 817             If m_enmProtocol = sckTCPProtocol Then
 818                 If m_enmState <> sckConnected Then
 819                     Registrar "~SOCK:" & "Advertencia: Omitiendo FD_READ", 3
 820                     Exit Sub
 821                 End If
 822
 823                 'Call the RecvDataToBuffer function that move arrived data
 824                 'from the Winsock buffer to the local one and returns number
 825                 'of bytes received.
 826                 lngBytesReceived = RecvDataToBuffer
 827
 828                 If lngBytesReceived > 0 Then
 829                     RaiseEvent DataArrival(Len(m_strRecvBuffer))
 830                 End If
 831
 832             Else 'UDP protocol
 833
 834                 If m_enmState <> sckOpen Then
 835                     Registrar "~SOCK:" & "Advertencia: Omitiendo FD_READ", 3
 836                     Exit Sub
 837                 End If
 838
 839                 'If we use UDP we don't remove data from winsock buffer.
 840                 'We just let the user know the amount received so
 841                 'he/she can decide what to do.
 842                 lngBytesReceived = GetBufferLenUDP
 843
 844                 If lngBytesReceived > 0 Then
 845                     RaiseEvent DataArrival(lngBytesReceived)
 846                 End If
 847
 848                 'Now the buffer is emptied no matter what the user
 849                 'dicided to do with the received data
 850                 EmptyBuffer
 851             End If
 852
 853             '======================================================================
 854         Case FD_ACCEPT
 855
 856             'When the socket is in a listening state, arrival of this message
 857             'means that a connection request was received. Call the accept
 858             'Winsock API function in oreder to create a new socket for the
 859             'requested connection.
 860             'registrar "~SOCK:" & "FD_ACCEPT " & m_lngSocketHandle, 3
 861             If m_enmState <> sckListening Then
 862                 Registrar "~SOCK:" & "Advertencia: Omitiendo FD_ACCEPT", 3
 863                 Exit Sub
 864             End If
 865
 866             lngResult = api_accept(m_lngSocketHandle, udtSockAddr, LenB(udtSockAddr))
 867
 868             If lngResult = INVALID_SOCKET Then
 869                 lngErrorCode = Err.LastDllError
 870                 m_enmState = sckError
 871                 blnCancelDisplay = True
 872                 RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.PostSocket", "", 0, blnCancelDisplay)
 873
 874                 If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.PostSocket"
 875             Else
 876                 'We assign a temporal instance of CSocketMaster to
 877                 'handle this new socket until user accepts (or not)
 878                 'the new connection
 879                 modSocketMaster.RegisterAccept lngResult
 880                 'We change remote info before firing ConnectionRequest
 881                 'event so the user can see which host is trying to
 882                 'connect.
 883                 Dim lngTempRP As Long
 884                 Dim strTempRHIP As String
 885                 Dim strTempRH As String
 886                 lngTempRP = m_lngRemotePort
 887                 strTempRHIP = m_strRemoteHostIP
 888                 strTempRH = m_strRemoteHost
 889                 GetRemoteInfo lngResult, m_lngRemotePort, m_strRemoteHostIP, m_strRemoteHost
 890                 Registrar "~SOCK: Socket aceptado -> " & lngResult, 3
 891                 RaiseEvent ConnectionRequest(lngResult)
 892
 893                 'we return original info
 894                 If m_enmState = sckListening Then
 895                     m_lngRemotePort = lngTempRP
 896                     m_strRemoteHostIP = strTempRHIP
 897                     m_strRemoteHost = strTempRH
 898                 End If
 899
 900                 'This is very important. If the connection wasn't accepted
 901                 'we must close the socket.
 902                 If IsAcceptRegistered(lngResult) Then
 903                     api_closesocket lngResult
 904                     modSocketMaster.UnregisterSocket lngResult
 905                     modSocketMaster.UnregisterAccept lngResult
 906                     Registrar "~SOCK: Socket aceptado cerrado ->  " & lngResult, 3
 907                 End If
 908             End If
 909
 910             '======================================================================
 911         Case FD_CLOSE
 912
 913             'This message means that the remote host is closing the conection
 914             'registrar "~SOCK:" & "FD_CLOSE " & m_lngSocketHandle, 3
 915             If m_enmState <> sckConnected Then
 916                 Registrar "~SOCK: Advertencia: Omitiendo FD_CLOSE", 3
 917                 Exit Sub
 918             End If
 919
 920             m_enmState = sckClosing
 921             Registrar "~SOCK: Estado -> sckClosing", 3
 922             RaiseEvent CloseSck
 923     End Select
 924
 925     '<EhFooter>
 926     Exit Sub
 927 PostSocket_Err:
 928     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.PostSocket"
 929     Resume Next
 930     '</EhFooter>
 931 End Sub
 932
 933 'Connect to a given 32 bits long ip
 934 Private Sub ConnectToIP(ByVal lngRemoteHostAddress As Long, _
 935                         ByVal lngErrorCode As Long)
 936     '<EhHeader>
 937     On Error GoTo ConnectToIP_Err
 938     '</EhHeader>
 939     Dim blnCancelDisplay As Boolean
 940
 941     'Check and handle errors
 942     If lngErrorCode <> 0 Then
 943         m_enmState = sckError
 944         blnCancelDisplay = True
 945         RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.ConnectToIP", "", 0, blnCancelDisplay)
 946
 947         If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.ConnectToIP"
 948         Exit Sub
 949     End If
 950
 951     Registrar "~SOCK: Conectando a: " + m_strRemoteHost + " " + m_strRemoteHostIP, 3
 952     m_enmState = sckConnecting
 953     Registrar "~SOCK: Estado -> sckConnecting", 3
 954     Dim udtSockAddr As sockaddr_in
 955     Dim lngResult As Long
 956
 957     'Build the sockaddr_in structure to pass it to the connect
 958     'Winsock API function as an address of the remote host.
 959     With udtSockAddr
 960         .sin_addr = lngRemoteHostAddress
 961         .sin_family = AF_INET
 962         .sin_port = api_htons(modSocketMaster.UnsignedToInteger(m_lngRemotePort))
 963     End With
 964
 965     'Call the connect Winsock API function in order to establish connection.
 966     lngResult = api_connect(m_lngSocketHandle, udtSockAddr, LenB(udtSockAddr))
 967
 968     'Check and handle errors
 969     If lngResult = SOCKET_ERROR Then
 970         lngErrorCode = Err.LastDllError
 971
 972         If lngErrorCode <> WSAEWOULDBLOCK Then
 973             If lngErrorCode = WSAEADDRNOTAVAIL Then
 974                 Err.Raise WSAEADDRNOTAVAIL, "CSocketMaster.ConnectToIP", GetErrorDescription(WSAEADDRNOTAVAIL)
 975             Else
 976                 m_enmState = sckError
 977                 blnCancelDisplay = True
 978                 RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.ConnectToIP", "", 0, blnCancelDisplay)
 979
 980                 If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.ConnectToIP"
 981             End If
 982         End If
 983     End If
 984
 985     '<EhFooter>
 986     Exit Sub
 987 ConnectToIP_Err:
 988     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.ConnectToIP"
 989     Resume Next
 990     '</EhFooter>
 991 End Sub
 992 'Public Sub Bind(Optional LocalPort As Variant, _
 993 '                Optional LocalIP As Variant)
 994 '        '<EhHeader>
 995 '        On Error GoTo Bind_Err
 996 '        '</EhHeader>
 997 '
 998 '100     If m_enmState <> sckClosed Then
 999 '102         Err.Raise sckInvalidOp, "CSocketMaster.Bind", "Operación invalida en el estado actual"
1000 '        End If
1001 '
1002 ''104     If BindInternal(LocalPort, LocalIP) Then
1003 '
1004 '104     If BindInternal(LocalPort, LocalIP) Then
1005 '106         m_enmState = sckOpen
1006 '        End If
1007 '
1008 '        '<EhFooter>
1009 '        Exit Sub
1010 '
1011 'Bind_Err:
1012 '
1013 '        Controlar_Error Erl, Err.Description, "XMR.CSocketMaster.Bind"
1014 '        Resume Next
1015 '        '</EhFooter>
1016 'End Sub
1017
1018 'This function binds a socket to a local port and IP.
1019 'Retunrs TRUE if it has success.
1020 Private Function BindInternal(Optional ByVal varLocalPort As Variant, _
1021                               Optional ByVal varLocalIP As Variant) As Boolean
1022     '<EhHeader>
1023     On Error GoTo BindInternal_Err
1024
1025     '</EhHeader>
1026     If m_enmState = sckOpen Then
1027         BindInternal = True
1028         Exit Function
1029     End If
1030
1031     Dim lngLocalPortInternal As Long
1032     Dim strLocalHostInternal As String
1033     Dim strIP As String
1034     Dim lngAddressInternal As Long
1035     Dim lngResult As Long
1036     Dim lngErrorCode As Long
1037     BindInternal = False
1038
1039     'Check if varLocalPort is a number between 0 and 65535
1040     If Not IsMissing(varLocalPort) Then
1041         If IsNumeric(varLocalPort) Then
1042             If varLocalPort < 0 Or varLocalPort > 65535 Then
1043                 BindInternal = False
1044                 Err.Raise sckInvalidArg, "CSocketMaster.BindInternal", "El argumento pasado a la función no era correcto o no era en el rango especificado"
1045             Else
1046                 lngLocalPortInternal = CLng(varLocalPort)
1047             End If
1048
1049         Else
1050             BindInternal = False
1051             Err.Raise sckUnsupported, "CSocketMaster.BindInternal", "Tipos variantes no soportados"
1052         End If
1053
1054     Else
1055         lngLocalPortInternal = m_lngLocalPort
1056     End If
1057
1058     If IsMissing(varLocalIP) Then varLocalIP = "000.000.000.000"
1059     strLocalHostInternal = CStr(varLocalIP)
1060     'registrar "~SOCK:" & "@Wine => varLocalIP: " & CStr(varLocalIP) & " | strLocalHostInternal: " & CStr(strLocalHostInternal) & " | strIP: " & strIP, 3
1061     'get a 32 bits long IP
1062     lngAddressInternal = ResolveIfHostnameSync(strLocalHostInternal, strIP, lngResult)
1063
1064     'registrar "~SOCK:" & "@Wine => lngResult: " & lngResult, 3
1065     If lngResult <> 0 Then Err.Raise sckInvalidArg, "CSocketMaster.BindInternal", "Argumento inválido"
1066
1067     'create a socket if there isn't one yet
1068     If Not SocketExists Then Exit Function
1069     Dim udtSockAddr As sockaddr_in
1070
1071     With udtSockAddr
1072         .sin_addr = lngAddressInternal
1073         .sin_family = AF_INET
1074         .sin_port = api_htons(modSocketMaster.UnsignedToInteger(lngLocalPortInternal))
1075     End With
1076
1077     'bind the socket
1078     lngResult = api_bind(m_lngSocketHandle, udtSockAddr, LenB(udtSockAddr))
1079
1080     If lngResult = SOCKET_ERROR Then
1081         lngErrorCode = Err.LastDllError
1082         Err.Raise lngErrorCode, "CSocketMaster.BindInternal", GetErrorDescription(lngErrorCode)
1083     Else
1084
1085         If lngLocalPortInternal <> 0 Then
1086             '160             registrar "~SOCK: Servidor enlazado -> " & strLocalHostInternal & " | Puerto -> " & lngLocalPortInternal, 3
1087             m_lngLocalPort = lngLocalPortInternal
1088         Else
1089             lngResult = GetLocalPort(m_lngSocketHandle)
1090
1091             If lngResult = SOCKET_ERROR Then
1092                 lngErrorCode = Err.LastDllError
1093                 Err.Raise lngErrorCode, "CSocketMaster.BindInternal", GetErrorDescription(lngErrorCode)
1094             Else
1095                 'registrar "~SOCK: Servidor enlazado -> " & strLocalHostInternal & " | Puerto -> " & lngLocalPortInternal, 3
1096                 m_lngLocalPortBind = lngResult
1097             End If
1098         End If
1099
1100         BindInternal = True
1101     End If
1102
1103     '<EhFooter>
1104     Exit Function
1105 BindInternal_Err:
1106     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.BindInternal"
1107     Resume Next
1108     '</EhFooter>
1109 End Function
1110
1111 'Allocate some memory for HOSTEN structure and returns
1112 'a pointer to this buffer if no error occurs.
1113 'Returns 0 if it fails.
1114 Private Function AllocateMemory() As Long
1115     '<EhHeader>
1116     On Error GoTo AllocateMemory_Err
1117     '</EhHeader>
1118     m_lngMemoryHandle = api_GlobalAlloc(GMEM_FIXED, MAXGETHOSTSTRUCT)
1119
1120     If m_lngMemoryHandle <> 0 Then
1121         m_lngMemoryPointer = api_GlobalLock(m_lngMemoryHandle)
1122
1123         If m_lngMemoryPointer <> 0 Then
1124             api_GlobalUnlock (m_lngMemoryHandle)
1125             AllocateMemory = m_lngMemoryPointer
1126         Else
1127             api_GlobalFree (m_lngMemoryHandle)
1128             AllocateMemory = m_lngMemoryPointer '0
1129         End If
1130
1131     Else
1132         AllocateMemory = m_lngMemoryHandle '0
1133     End If
1134
1135     '<EhFooter>
1136     Exit Function
1137 AllocateMemory_Err:
1138     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.AllocateMemory"
1139     Resume Next
1140     '</EhFooter>
1141 End Function
1142
1143 'Free memory allocated by AllocateMemory
1144 Private Sub FreeMemory()
1145     '<EhHeader>
1146     On Error GoTo FreeMemory_Err
1147
1148     '</EhHeader>
1149     If m_lngMemoryHandle <> 0 Then
1150         m_lngMemoryPointer = 0
1151         api_GlobalFree m_lngMemoryHandle
1152         m_lngMemoryHandle = 0
1153         'registrar "~SOCK: Liberada memoria de resolución", 3
1154     End If
1155
1156     '<EhFooter>
1157     Exit Sub
1158 FreeMemory_Err:
1159     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.FreeMemory"
1160     Resume Next
1161     '</EhFooter>
1162 End Sub
1163
1164 Private Function GetLocalHostName() As String
1165     '<EhHeader>
1166     On Error GoTo GetLocalHostName_Err
1167     '</EhHeader>
1168     Dim strHostNameBuf As String * LOCAL_HOST_BUFF
1169     Dim lngResult As Long
1170     lngResult = api_gethostname(strHostNameBuf, LOCAL_HOST_BUFF)
1171
1172     If lngResult = SOCKET_ERROR Then
1173         GetLocalHostName = vbNullString
1174         Dim lngErrorCode As Long
1175         lngErrorCode = Err.LastDllError
1176         Err.Raise lngErrorCode, "CSocketMaster.GetLocalHostName", GetErrorDescription(lngErrorCode)
1177     Else
1178         GetLocalHostName = Left$(strHostNameBuf, InStr(1, strHostNameBuf, vbNullChar) - 1)
1179     End If
1180
1181     '<EhFooter>
1182     Exit Function
1183 GetLocalHostName_Err:
1184     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetLocalHostName"
1185     Resume Next
1186     '</EhFooter>
1187 End Function
1188
1189 'Get local IP when the socket isn't connected yet
1190 Private Function GetLocalIP() As String
1191     '<EhHeader>
1192     On Error GoTo GetLocalIP_Err
1193     '</EhHeader>
1194     Dim lngResult As Long
1195     Dim lngPtrToIP As Long
1196     Dim strLocalHost As String
1197     Dim arrIpAddress(1 To 4) As Byte
1198     Dim Count As Integer
1199     Dim udtHostent As HOSTENT
1200     Dim strIpAddress As String
1201     strLocalHost = GetLocalHostName
1202     lngResult = api_gethostbyname(strLocalHost)
1203
1204     If lngResult = 0 Then
1205         GetLocalIP = vbNullString
1206         Dim lngErrorCode As Long
1207         lngErrorCode = Err.LastDllError
1208         Err.Raise lngErrorCode, "CSocketMaster.GetLocalIP", GetErrorDescription(lngErrorCode)
1209     Else
1210         api_CopyMemory udtHostent, ByVal lngResult, LenB(udtHostent)
1211         api_CopyMemory lngPtrToIP, ByVal udtHostent.hAddrList, 4
1212         api_CopyMemory arrIpAddress(1), ByVal lngPtrToIP, 4
1213
1214         For Count = 1 To 4
1215             strIpAddress = strIpAddress & arrIpAddress(Count) & "."
1216         Next
1217
1218         strIpAddress = Left$(strIpAddress, Len(strIpAddress) - 1)
1219         GetLocalIP = strIpAddress
1220     End If
1221
1222     '<EhFooter>
1223     Exit Function
1224 GetLocalIP_Err:
1225     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetLocalIP"
1226     Resume Next
1227     '</EhFooter>
1228 End Function
1229
1230 'If Host is an IP doesn't resolve anything and returns a
1231 'a 32 bits long IP.
1232 'If Host isn't an IP then returns vbNull, tries to resolve it
1233 'in asynchronous way.
1234 Private Function ResolveIfHostname(ByVal Host As String) As Long
1235     '<EhHeader>
1236     On Error GoTo ResolveIfHostname_Err
1237     '</EhHeader>
1238     Dim lngAddress As Long
1239     lngAddress = api_inet_addr(Host)
1240
1241     If lngAddress = INADDR_NONE Then 'if Host isn't an IP
1242         ResolveIfHostname = vbNull
1243         m_enmState = sckResolvingHost
1244
1245         If AllocateMemory Then
1246             Dim lngAsynHandle As Long
1247             lngAsynHandle = modSocketMaster.ResolveHost(Host, m_lngMemoryPointer, ObjPtr(Me))
1248
1249             If lngAsynHandle = 0 Then
1250                 FreeMemory
1251                 m_enmState = sckError
1252                 Dim lngErrorCode As Long
1253                 lngErrorCode = Err.LastDllError
1254                 Dim blnCancelDisplay As Boolean
1255                 blnCancelDisplay = True
1256                 RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.ResolveIfHostname", "", 0, blnCancelDisplay)
1257
1258                 If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.ResolveIfHostname"
1259             Else
1260                 m_colWaitingResolutions.Add lngAsynHandle, "R" & lngAsynHandle
1261                 Registrar "~SOCK: Resolviendo servidor -> " & Host & " - con control ASYNC: " & lngAsynHandle, 3
1262             End If
1263
1264         Else
1265             m_enmState = sckError
1266             Registrar "~SOCK: Error asignando memoria", 3
1267             Err.Raise sckOutOfMemory, "CSocketMaster.ResolveIfHostname", "Sin memoria"
1268         End If
1269
1270     Else 'if Host is an IP doen't need to resolve anything
1271         ResolveIfHostname = lngAddress
1272     End If
1273
1274     '<EhFooter>
1275     Exit Function
1276 ResolveIfHostname_Err:
1277     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.ResolveIfHostname"
1278     Resume Next
1279     '</EhFooter>
1280 End Function
1281
1282 'Resolves a host (if necessary) in synchronous way
1283 'If succeeds returns a 32 bits long IP,
1284 'strHostIP = readable IP string and lngErrorCode = 0
1285 'If fails returns vbNull,
1286 'strHostIP = vbNullString and lngErrorCode <> 0
1287 Private Function ResolveIfHostnameSync(ByVal Host As String, _
1288                                        ByRef strHostIP As String, _
1289                                        ByRef lngErrorCode As Long) As Long
1290     '<EhHeader>
1291     On Error GoTo ResolveIfHostnameSync_Err
1292     '</EhHeader>
1293     Dim lngPtrToHOSTENT As Long
1294     Dim udtHostent As HOSTENT
1295     Dim lngAddress As Long
1296     Dim lngPtrToIP As Long
1297     Dim arrIpAddress(1 To 4) As Byte
1298     Dim Count As Integer
1299     lngAddress = api_inet_addr(Host)
1300
1301     If lngAddress = INADDR_NONE Then 'if Host isn't an IP
1302         lngPtrToHOSTENT = api_gethostbyname(Host)
1303
1304         If lngPtrToHOSTENT = 0 Then
1305             lngErrorCode = Err.LastDllError
1306             strHostIP = vbNullString
1307             ResolveIfHostnameSync = vbNull
1308         Else
1309             api_CopyMemory udtHostent, ByVal lngPtrToHOSTENT, LenB(udtHostent)
1310             api_CopyMemory lngPtrToIP, ByVal udtHostent.hAddrList, 4
1311             api_CopyMemory arrIpAddress(1), ByVal lngPtrToIP, 4
1312             api_CopyMemory lngAddress, ByVal lngPtrToIP, 4
1313
1314             For Count = 1 To 4
1315                 strHostIP = strHostIP & arrIpAddress(Count) & "."
1316             Next
1317
1318             strHostIP = Left$(strHostIP, Len(strHostIP) - 1)
1319             lngErrorCode = 0
1320             ResolveIfHostnameSync = lngAddress
1321         End If
1322
1323     Else 'if Host is an IP doen't need to resolve anything
1324         lngErrorCode = 0
1325         strHostIP = Host
1326         ResolveIfHostnameSync = lngAddress
1327     End If
1328
1329     '<EhFooter>
1330     Exit Function
1331 ResolveIfHostnameSync_Err:
1332     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.ResolveIfHostnameSync"
1333     Resume Next
1334     '</EhFooter>
1335 End Function
1336
1337 'Returns local port from a connected or bound socket.
1338 'Returns SOCKET_ERROR if fails.
1339 Private Function GetLocalPort(ByVal lngSocket As Long) As Long
1340     '<EhHeader>
1341     On Error GoTo GetLocalPort_Err
1342     '</EhHeader>
1343     Dim udtSockAddr As sockaddr_in
1344     Dim lngResult As Long
1345     lngResult = api_getsockname(lngSocket, udtSockAddr, LenB(udtSockAddr))
1346
1347     If lngResult = SOCKET_ERROR Then
1348         GetLocalPort = SOCKET_ERROR
1349     Else
1350         GetLocalPort = modSocketMaster.IntegerToUnsigned(api_ntohs(udtSockAddr.sin_port))
1351     End If
1352
1353     '<EhFooter>
1354     Exit Function
1355 GetLocalPort_Err:
1356     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetLocalPort"
1357     Resume Next
1358     '</EhFooter>
1359 End Function
1360
1361 Public Sub SendData(data As Variant)
1362     '<EhHeader>
1363     On Error GoTo SendData_Err
1364     '</EhHeader>
1365     Dim arrData() As Byte 'We store the data here before send it
1366
1367     If m_enmProtocol = sckTCPProtocol Then
1368         If m_enmState <> sckConnected Then
1369             Err.Raise sckBadState, "CSocketMaster.SendData", "Wrong protocol or connection state for the requested transaction or request"
1370             Exit Sub
1371         End If
1372
1373     Else 'If we use UDP we create a socket if there isn't one yet
1374
1375         If Not SocketExists Then Exit Sub
1376         If Not BindInternal Then Exit Sub
1377         m_enmState = sckOpen
1378     End If
1379
1380     'We need to convert data variant into a byte array
1381     Select Case varType(data)
1382
1383         Case vbString
1384             Dim strdata As String
1385             strdata = CStr(data)
1386
1387             If Len(strdata) = 0 Then Exit Sub
1388             ReDim arrData(Len(strdata) - 1)
1389             arrData() = StrConv(strdata, vbFromUnicode)
1390
1391         Case vbArray + vbByte
1392             Dim strArray As String
1393             strArray = StrConv(data, vbUnicode)
1394
1395             If Len(strArray) = 0 Then Exit Sub
1396             arrData() = StrConv(strArray, vbFromUnicode)
1397
1398         Case vbBoolean
1399             Dim blnData As Boolean
1400             blnData = CBool(data)
1401             ReDim arrData(LenB(blnData) - 1)
1402             api_CopyMemory arrData(0), blnData, LenB(blnData)
1403
1404         Case vbByte
1405             Dim bytData As Byte
1406             bytData = CByte(data)
1407             ReDim arrData(LenB(bytData) - 1)
1408             api_CopyMemory arrData(0), bytData, LenB(bytData)
1409
1410         Case vbCurrency
1411             Dim curData As Currency
1412             curData = CCur(data)
1413             ReDim arrData(LenB(curData) - 1)
1414             api_CopyMemory arrData(0), curData, LenB(curData)
1415
1416         Case vbDate
1417             Dim datData As Date
1418             datData = CDate(data)
1419             ReDim arrData(LenB(datData) - 1)
1420             api_CopyMemory arrData(0), datData, LenB(datData)
1421
1422         Case vbDouble
1423             Dim dblData As Double
1424             dblData = CDbl(data)
1425             ReDim arrData(LenB(dblData) - 1)
1426             api_CopyMemory arrData(0), dblData, LenB(dblData)
1427
1428         Case vbInteger
1429             Dim intData As Integer
1430             intData = CInt(data)
1431             ReDim arrData(LenB(intData) - 1)
1432             api_CopyMemory arrData(0), intData, LenB(intData)
1433
1434         Case vbLong
1435             Dim lngData As Long
1436             lngData = CLng(data)
1437             ReDim arrData(LenB(lngData) - 1)
1438             api_CopyMemory arrData(0), lngData, LenB(lngData)
1439
1440         Case vbSingle
1441             Dim sngData As Single
1442             sngData = CSng(data)
1443             ReDim arrData(LenB(sngData) - 1)
1444             api_CopyMemory arrData(0), sngData, LenB(sngData)
1445
1446         Case Else
1447             Err.Raise sckUnsupported, "CSocketMaster.SendData", "Unsupported variant type."
1448     End Select
1449
1450     'if there's already something in the buffer that means we are
1451     'already sending data, so we put the new data in the buffer
1452     'and exit silently
1453     If Len(m_strSendBuffer) > 0 Then
1454         m_strSendBuffer = m_strSendBuffer + StrConv(arrData(), vbUnicode)
1455         Exit Sub
1456     Else
1457         m_strSendBuffer = m_strSendBuffer + StrConv(arrData(), vbUnicode)
1458     End If
1459
1460     'send the data
1461     SendBufferedData
1462     '<EhFooter>
1463     Exit Sub
1464 SendData_Err:
1465     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SendData"
1466     Resume Next
1467     '</EhFooter>
1468 End Sub
1469
1470 'Check which protocol we are using to decide which
1471 'function should handle the data sending.
1472 Private Sub SendBufferedData()
1473     '<EhHeader>
1474     On Error GoTo SendBufferedData_Err
1475
1476     '</EhHeader>
1477     If m_enmProtocol = sckTCPProtocol Then
1478         SendBufferedDataTCP
1479     Else
1480         SendBufferedDataUDP
1481     End If
1482
1483     '<EhFooter>
1484     Exit Sub
1485 SendBufferedData_Err:
1486     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SendBufferedData"
1487     Resume Next
1488     '</EhFooter>
1489 End Sub
1490
1491 'Send buffered data if we are using UDP protocol.
1492 Private Sub SendBufferedDataUDP()
1493     '<EhHeader>
1494     On Error GoTo SendBufferedDataUDP_Err
1495     '</EhHeader>
1496     Dim lngAddress As Long
1497     Dim udtSockAddr As sockaddr_in
1498     Dim arrData() As Byte
1499     Dim lngBufferLength As Long
1500     Dim lngResult As Long
1501     Dim lngErrorCode As Long
1502     Dim strTemp As String
1503     lngAddress = ResolveIfHostnameSync(m_strRemoteHost, strTemp, lngErrorCode)
1504
1505     If lngErrorCode <> 0 Then
1506         m_strSendBuffer = ""
1507
1508         If lngErrorCode = WSAEAFNOSUPPORT Then
1509             Err.Raise lngErrorCode, "CSocketMaster.SendBufferedDataUDP", GetErrorDescription(lngErrorCode)
1510         Else
1511             Err.Raise sckInvalidArg, "CSocketMaster.SendBufferedDataUDP", "Invalid argument"
1512         End If
1513     End If
1514
1515     With udtSockAddr
1516         .sin_addr = lngAddress
1517         .sin_family = AF_INET
1518         .sin_port = api_htons(modSocketMaster.UnsignedToInteger(m_lngRemotePort))
1519     End With
1520
1521     lngBufferLength = Len(m_strSendBuffer)
1522     arrData() = StrConv(m_strSendBuffer, vbFromUnicode)
1523     m_strSendBuffer = ""
1524     lngResult = api_sendto(m_lngSocketHandle, arrData(0), lngBufferLength, 0&, udtSockAddr, LenB(udtSockAddr))
1525
1526     If lngResult = SOCKET_ERROR Then
1527         lngErrorCode = Err.LastDllError
1528         m_enmState = sckError
1529         Dim blnCancelDisplay As Boolean
1530         blnCancelDisplay = True
1531         RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.SendBufferedDataUDP", "", 0, blnCancelDisplay)
1532
1533         If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.SendBufferedDataUDP"
1534     End If
1535
1536     '<EhFooter>
1537     Exit Sub
1538 SendBufferedDataUDP_Err:
1539     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SendBufferedDataUDP"
1540     Resume Next
1541     '</EhFooter>
1542 End Sub
1543
1544 'Send buffered data if we are using TCP protocol.
1545 Private Sub SendBufferedDataTCP()
1546     '<EhHeader>
1547     On Error GoTo SendBufferedDataTCP_Err
1548     '</EhHeader>
1549     Dim arrData()       As Byte
1550     Dim lngBufferLength As Long
1551     Dim lngResult    As Long
1552     Dim lngTotalSent As Long
1553
1554     Do Until lngResult = SOCKET_ERROR Or Len(m_strSendBuffer) = 0
1555         lngBufferLength = Len(m_strSendBuffer)
1556
1557         If lngBufferLength > m_lngSendBufferLen Then
1558             lngBufferLength = m_lngSendBufferLen
1559             arrData() = StrConv(Left$(m_strSendBuffer, m_lngSendBufferLen), vbFromUnicode)
1560         Else
1561             arrData() = StrConv(m_strSendBuffer, vbFromUnicode)
1562         End If
1563
1564         lngResult = api_send(m_lngSocketHandle, arrData(0), lngBufferLength, 0&)
1565
1566         If lngResult = SOCKET_ERROR Then
1567             Dim lngErrorCode As Long
1568             lngErrorCode = Err.LastDllError
1569
1570             If lngErrorCode = WSAEWOULDBLOCK Then
1571                 Registrar "~SOCK:" & "Advertencia: Buffer de envío lleno, esperando...", 3
1572
1573                 If lngTotalSent > 0 Then RaiseEvent SendProgress(lngTotalSent, Len(m_strSendBuffer))
1574             Else
1575                 m_enmState = sckError
1576                 Dim blnCancelDisplay As Boolean
1577                 blnCancelDisplay = True
1578                 RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.SendBufferedData", "", 0, blnCancelDisplay)
1579
1580                 If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.SendBufferedData"
1581             End If
1582
1583         Else
1584             Registrar "~SOCK: Bytes enviados => " & lngResult, 3
1585             lngTotalSent = lngTotalSent + lngResult
1586
1587             If Len(m_strSendBuffer) > lngResult Then
1588                 m_strSendBuffer = Mid$(m_strSendBuffer, lngResult + 1)
1589             Else
1590                 Registrar "~SOCK: Envío terminado", 3
1591                 m_strSendBuffer = ""
1592                 Dim lngTemp As Long
1593                 lngTemp = lngTotalSent
1594                 lngTotalSent = 0
1595                 RaiseEvent SendProgress(lngTemp, 0)
1596                 RaiseEvent SendComplete
1597             End If
1598         End If
1599
1600     Loop
1601
1602     '<EhFooter>
1603     Exit Sub
1604 SendBufferedDataTCP_Err:
1605     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SendBufferedDataTCP"
1606     Resume Next
1607     '</EhFooter>
1608 End Sub
1609
1610 'This function retrieves data from the Winsock buffer
1611 'into the class local buffer. The function returns number
1612 'of bytes retrieved (received).
1613 Private Function RecvDataToBuffer() As Long
1614     '<EhHeader>
1615     On Error GoTo RecvDataToBuffer_Err
1616     '</EhHeader>
1617     Dim arrBuffer() As Byte
1618     Dim lngBytesReceived As Long
1619     Dim strBuffTemporal As String
1620     ReDim arrBuffer(m_lngRecvBufferLen - 1)
1621     lngBytesReceived = api_recv(m_lngSocketHandle, arrBuffer(0), m_lngRecvBufferLen, 0&)
1622
1623     If lngBytesReceived = SOCKET_ERROR Then
1624         m_enmState = sckError
1625         Dim lngErrorCode As Long
1626         lngErrorCode = Err.LastDllError
1627         Err.Raise lngErrorCode, "CSocketMaster.RecvDataToBuffer", GetErrorDescription(lngErrorCode)
1628     ElseIf lngBytesReceived > 0 Then
1629         strBuffTemporal = StrConv(arrBuffer(), vbUnicode)
1630         m_strRecvBuffer = m_strRecvBuffer & Left$(strBuffTemporal, lngBytesReceived)
1631         RecvDataToBuffer = lngBytesReceived
1632     End If
1633
1634     '<EhFooter>
1635     Exit Function
1636 RecvDataToBuffer_Err:
1637     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RecvDataToBuffer"
1638     Resume Next
1639     '</EhFooter>
1640 End Function
1641
1642 'Retrieves some socket options.
1643 'If it is an UDP socket also sets SO_BROADCAST option.
1644 Private Sub ProcessOptions()
1645     '<EhHeader>
1646     On Error GoTo ProcessOptions_Err
1647     '</EhHeader>
1648     Dim lngResult As Long
1649     Dim lngBuffer As Long
1650     Dim lngErrorCode As Long
1651
1652     If m_enmProtocol = sckTCPProtocol Then
1653         lngResult = api_getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_RCVBUF, lngBuffer, LenB(lngBuffer))
1654
1655         If lngResult = SOCKET_ERROR Then
1656             lngErrorCode = Err.LastDllError
1657             Err.Raise lngErrorCode, "CSocketMaster.ProcessOptions", GetErrorDescription(lngErrorCode)
1658         Else
1659             m_lngRecvBufferLen = lngBuffer
1660         End If
1661
1662         lngResult = api_getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_SNDBUF, lngBuffer, LenB(lngBuffer))
1663
1664         If lngResult = SOCKET_ERROR Then
1665             lngErrorCode = Err.LastDllError
1666             Err.Raise lngErrorCode, "CSocketMaster.ProcessOptions", GetErrorDescription(lngErrorCode)
1667         Else
1668             m_lngSendBufferLen = lngBuffer
1669         End If
1670
1671     Else
1672         lngBuffer = 1
1673         lngResult = api_setsockopt(m_lngSocketHandle, SOL_SOCKET, SO_BROADCAST, lngBuffer, LenB(lngBuffer))
1674         lngResult = api_getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_MAX_MSG_SIZE, lngBuffer, LenB(lngBuffer))
1675
1676         If lngResult = SOCKET_ERROR Then
1677             lngErrorCode = Err.LastDllError
1678             Err.Raise lngErrorCode, "CSocketMaster.ProcessOptions", GetErrorDescription(lngErrorCode)
1679         Else
1680             m_lngRecvBufferLen = lngBuffer
1681             m_lngSendBufferLen = lngBuffer
1682         End If
1683     End If
1684
1685     'registrar "~SOCK:" & "Tamaño de buffer para envíar: " & m_lngRecvBufferLen, 3
1686     'registrar "~SOCK:" & "Tamaño de buffer para recibir: " & m_lngSendBufferLen, 3
1687     '<EhFooter>
1688     Exit Sub
1689 ProcessOptions_Err:
1690     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.ProcessOptions"
1691     Resume Next
1692     '</EhFooter>
1693 End Sub
1694
1695 Public Sub GetData(ByRef data As Variant, _
1696                    Optional varType As Variant, _
1697                    Optional maxLen As Variant)
1698     '<EhHeader>
1699     On Error GoTo GetData_Err
1700
1701     '</EhHeader>
1702     If m_enmProtocol = sckTCPProtocol Then
1703         If m_enmState <> sckConnected And Not m_blnAcceptClass Then
1704             Err.Raise sckBadState, "CSocketMaster.GetData", "Wrong protocol or connection state for the requested transaction or request"
1705             Exit Sub
1706         End If
1707
1708     Else
1709
1710         If m_enmState <> sckOpen Then
1711             Err.Raise sckBadState, "CSocketMaster.GetData", "Wrong protocol or connection state for the requested transaction or request"
1712             Exit Sub
1713         End If
1714
1715         If GetBufferLenUDP = 0 Then Exit Sub
1716     End If
1717
1718     If Not IsMissing(maxLen) Then
1719         If IsNumeric(maxLen) Then
1720             If CLng(maxLen) < 0 Then
1721                 Err.Raise sckInvalidArg, "CSocketMaster.GetData", "The argument passed to a function was not in the correct format or in the specified range."
1722             End If
1723
1724         Else
1725
1726             If m_enmProtocol = sckTCPProtocol Then
1727                 maxLen = Len(m_strRecvBuffer)
1728             Else
1729                 maxLen = GetBufferLenUDP
1730             End If
1731         End If
1732     End If
1733
1734     Dim lngBytesRecibidos  As Long
1735     lngBytesRecibidos = RecvData(data, False, varType, maxLen)
1736     Registrar "~SOCK: Bytes Obtenidos del buffer: " & lngBytesRecibidos, 3
1737     '<EhFooter>
1738     Exit Sub
1739 GetData_Err:
1740     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetData"
1741     Resume Next
1742     '</EhFooter>
1743 End Sub
1744
1745 Public Sub PeekData(ByRef data As Variant, _
1746                     Optional varType As Variant, _
1747                     Optional maxLen As Variant)
1748     '<EhHeader>
1749     On Error GoTo PeekData_Err
1750
1751     '</EhHeader>
1752     If m_enmProtocol = sckTCPProtocol Then
1753         If m_enmState <> sckConnected Then
1754             Err.Raise sckBadState, "CSocketMaster.PeekData", "Wrong protocol or connection state for the requested transaction or request"
1755             Exit Sub
1756         End If
1757
1758     Else
1759
1760         If m_enmState <> sckOpen Then
1761             Err.Raise sckBadState, "CSocketMaster.PeekData", "Wrong protocol or connection state for the requested transaction or request"
1762             Exit Sub
1763         End If
1764
1765         If GetBufferLenUDP = 0 Then Exit Sub
1766     End If
1767
1768     If Not IsMissing(maxLen) Then
1769         If IsNumeric(maxLen) Then
1770             If CLng(maxLen) < 0 Then
1771                 Err.Raise sckInvalidArg, "CSocketMaster.PeekData", "The argument passed to a function was not in the correct format or in the specified range."
1772             End If
1773
1774         Else
1775
1776             If m_enmProtocol = sckTCPProtocol Then
1777                 maxLen = Len(m_strRecvBuffer)
1778             Else
1779                 maxLen = GetBufferLenUDP
1780             End If
1781         End If
1782     End If
1783
1784     Dim lngBytesRecibidos  As Long
1785     lngBytesRecibidos = RecvData(data, True, varType, maxLen)
1786     Registrar "~SOCK: Bytes obtenidos del buffer: " & lngBytesRecibidos, 3
1787     '<EhFooter>
1788     Exit Sub
1789 PeekData_Err:
1790     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.PeekData"
1791     Resume Next
1792     '</EhFooter>
1793 End Sub
1794
1795 'This function is to retrieve data from the buffer. If we are using TCP
1796 'then the data is retrieved from a local buffer (m_strRecvBuffer). If we
1797 'are using UDP the data is retrieved from winsock buffer.
1798 'It can be called by two public methods of the class - GetData and PeekData.
1799 'Behavior of the function is defined by the blnPeek argument. If a value of
1800 'that argument is TRUE, the function returns number of bytes in the
1801 'buffer, and copy data from that buffer into the data argument.
1802 'If a value of the blnPeek is FALSE, then this function returns number of
1803 'bytes received, and move data from the buffer into the data
1804 'argument. MOVE means that data will be removed from the buffer.
1805 Private Function RecvData(ByRef data As Variant, _
1806                           ByVal blnPeek As Boolean, _
1807                           Optional varClass As Variant, _
1808                           Optional maxLen As Variant) As Long
1809     '<EhHeader>
1810     On Error GoTo RecvData_Err
1811     '</EhHeader>
1812     Dim blnMaxLenMiss   As Boolean
1813     Dim blnClassMiss    As Boolean
1814     'Dim strRecvData     As String
1815     Dim lngBufferLen    As Long
1816     Dim arrBuffer()     As Byte
1817     Dim lngErrorCode    As Long
1818
1819     If m_enmProtocol = sckTCPProtocol Then
1820         lngBufferLen = Len(m_strRecvBuffer)
1821     Else
1822         lngBufferLen = GetBufferLenUDP
1823     End If
1824
1825     blnMaxLenMiss = IsMissing(maxLen)
1826     blnClassMiss = IsMissing(varClass)
1827
1828     'Select type of data
1829     If varType(data) = vbEmpty Then
1830         If blnClassMiss Then varClass = vbArray + vbByte
1831     Else
1832         varClass = varType(data)
1833     End If
1834
1835     'As stated on Winsock control documentation if the
1836     'data type passed is string or byte array type then
1837     'we must take into account maxLen argument.
1838     'If it is another type maxLen is ignored.
1839     If varClass = vbString Or varClass = vbArray + vbByte Then
1840         If blnMaxLenMiss Then 'if maxLen argument is missing
1841             If lngBufferLen = 0 Then
1842                 RecvData = 0
1843                 arrBuffer = StrConv("", vbFromUnicode)
1844                 data = arrBuffer
1845                 Exit Function
1846             Else
1847                 RecvData = lngBufferLen
1848                 BuildArray lngBufferLen, blnPeek, lngErrorCode, arrBuffer
1849             End If
1850
1851         Else 'if maxLen argument is not missing
1852
1853             If maxLen = 0 Or lngBufferLen = 0 Then
1854                 RecvData = 0
1855                 arrBuffer = StrConv("", vbFromUnicode)
1856                 data = arrBuffer
1857
1858                 If m_enmProtocol = sckUDPProtocol Then
1859                     EmptyBuffer
1860                     Err.Raise WSAEMSGSIZE, "CSocketMaster.RecvData", GetErrorDescription(WSAEMSGSIZE)
1861                 End If
1862
1863                 Exit Function
1864             ElseIf maxLen > lngBufferLen Then
1865                 RecvData = lngBufferLen
1866                 BuildArray lngBufferLen, blnPeek, lngErrorCode, arrBuffer
1867             Else
1868                 RecvData = CLng(maxLen)
1869                 BuildArray CLng(maxLen), blnPeek, lngErrorCode, arrBuffer
1870             End If
1871         End If
1872     End If
1873
1874     Select Case varClass
1875
1876         Case vbString
1877             Dim strdata As String
1878             strdata = StrConv(arrBuffer(), vbUnicode)
1879             data = strdata
1880
1881         Case vbArray + vbByte
1882             data = arrBuffer
1883
1884         Case vbBoolean
1885             Dim blnData As Boolean
1886
1887             If LenB(blnData) > lngBufferLen Then Exit Function
1888             BuildArray LenB(blnData), blnPeek, lngErrorCode, arrBuffer
1889             RecvData = LenB(blnData)
1890             api_CopyMemory blnData, arrBuffer(0), LenB(blnData)
1891             data = blnData
1892
1893         Case vbByte
1894             Dim bytData As Byte
1895
1896             If LenB(bytData) > lngBufferLen Then Exit Function
1897             BuildArray LenB(bytData), blnPeek, lngErrorCode, arrBuffer
1898             RecvData = LenB(bytData)
1899             api_CopyMemory bytData, arrBuffer(0), LenB(bytData)
1900             data = bytData
1901
1902         Case vbCurrency
1903             Dim curData As Currency
1904
1905             If LenB(curData) > lngBufferLen Then Exit Function
1906             BuildArray LenB(curData), blnPeek, lngErrorCode, arrBuffer
1907             RecvData = LenB(curData)
1908             api_CopyMemory curData, arrBuffer(0), LenB(curData)
1909             data = curData
1910
1911         Case vbDate
1912             Dim datData As Date
1913
1914             If LenB(datData) > lngBufferLen Then Exit Function
1915             BuildArray LenB(datData), blnPeek, lngErrorCode, arrBuffer
1916             RecvData = LenB(datData)
1917             api_CopyMemory datData, arrBuffer(0), LenB(datData)
1918             data = datData
1919
1920         Case vbDouble
1921             Dim dblData As Double
1922
1923             If LenB(dblData) > lngBufferLen Then Exit Function
1924             BuildArray LenB(dblData), blnPeek, lngErrorCode, arrBuffer
1925             RecvData = LenB(dblData)
1926             api_CopyMemory dblData, arrBuffer(0), LenB(dblData)
1927             data = dblData
1928
1929         Case vbInteger
1930             Dim intData As Integer
1931
1932             If LenB(intData) > lngBufferLen Then Exit Function
1933             BuildArray LenB(intData), blnPeek, lngErrorCode, arrBuffer
1934             RecvData = LenB(intData)
1935             api_CopyMemory intData, arrBuffer(0), LenB(intData)
1936             data = intData
1937
1938         Case vbLong
1939             Dim lngData As Long
1940
1941             If LenB(lngData) > lngBufferLen Then Exit Function
1942             BuildArray LenB(lngData), blnPeek, lngErrorCode, arrBuffer
1943             RecvData = LenB(lngData)
1944             api_CopyMemory lngData, arrBuffer(0), LenB(lngData)
1945             data = lngData
1946
1947         Case vbSingle
1948             Dim sngData As Single
1949
1950             If LenB(sngData) > lngBufferLen Then Exit Function
1951             BuildArray LenB(sngData), blnPeek, lngErrorCode, arrBuffer
1952             RecvData = LenB(sngData)
1953             api_CopyMemory sngData, arrBuffer(0), LenB(sngData)
1954             data = sngData
1955
1956         Case Else
1957             Err.Raise sckUnsupported, "CSocketMaster.RecvData", "Unsupported variant type."
1958     End Select
1959
1960     'if BuildArray returns an error is handled here
1961     If lngErrorCode <> 0 Then
1962         Err.Raise lngErrorCode, "CSocketMaster.RecvData", GetErrorDescription(lngErrorCode)
1963     End If
1964
1965     '<EhFooter>
1966     Exit Function
1967 RecvData_Err:
1968     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RecvData"
1969     Resume Next
1970     '</EhFooter>
1971 End Function
1972
1973 'Returns a byte array of Size bytes filled with incoming buffer data.
1974 Private Sub BuildArray(ByVal Size As Long, _
1975                        ByVal blnPeek As Boolean, _
1976                        ByRef lngErrorCode As Long, _
1977                        ByRef bytArray() As Byte)
1978     '<EhHeader>
1979     On Error GoTo BuildArray_Err
1980     '</EhHeader>
1981     Dim strdata As String
1982
1983     If m_enmProtocol = sckTCPProtocol Then
1984         strdata = Left$(m_strRecvBuffer, CLng(Size))
1985
1986         If strdata <> vbNullString Then bytArray = StrConv(strdata, vbFromUnicode)
1987         If Not blnPeek Then m_strRecvBuffer = Mid$(m_strRecvBuffer, Size + 1)
1988     Else 'UDP protocol
1989         Dim arrBuffer() As Byte
1990         Dim lngResult As Long
1991         Dim udtSockAddr As sockaddr_in
1992         Dim lngFlags As Long
1993
1994         If blnPeek Then lngFlags = MSG_PEEK
1995         ReDim arrBuffer(Size - 1)
1996         lngResult = api_recvfrom(m_lngSocketHandle, arrBuffer(0), Size, lngFlags, udtSockAddr, LenB(udtSockAddr))
1997
1998         If lngResult = SOCKET_ERROR Then
1999             lngErrorCode = Err.LastDllError
2000         End If
2001
2002         bytArray = arrBuffer
2003         GetRemoteInfoFromSI udtSockAddr, m_lngRemotePort, m_strRemoteHostIP, m_strRemoteHost
2004     End If
2005
2006     '<EhFooter>
2007     Exit Sub
2008 BuildArray_Err:
2009     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.BuildArray"
2010     Resume Next
2011     '</EhFooter>
2012 End Sub
2013
2014 'Clean resolution system that is in charge of
2015 'asynchronous hostname resolutions.
2016 Private Sub CleanResolutionSystem()
2017     '<EhHeader>
2018     On Error GoTo CleanResolutionSystem_Err
2019     '</EhHeader>
2020     Dim varAsynHandle As Variant
2021     Dim lngResult As Long
2022
2023     'cancel async resolutions if they're still running
2024     For Each varAsynHandle In m_colWaitingResolutions
2025         lngResult = api_WSACancelAsyncRequest(varAsynHandle)
2026
2027         If lngResult = 0 Then
2028             modSocketMaster.UnregisterResolution varAsynHandle
2029             Set m_colWaitingResolutions = Nothing
2030             Set m_colWaitingResolutions = New Collection
2031             'free memory buffer where resolution results are stored
2032             FreeMemory
2033         End If
2034
2035     Next
2036
2037     '<EhFooter>
2038     Exit Sub
2039 CleanResolutionSystem_Err:
2040     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.CleanResolutionSystem"
2041     Resume Next
2042     '</EhFooter>
2043 End Sub
2044
2045 Public Sub Listen()
2046     '<EhHeader>
2047     On Error GoTo Listen_Err
2048
2049     '</EhHeader>
2050     If m_enmState <> sckClosed And m_enmState <> sckOpen Then
2051         Err.Raise sckInvalidOp, "CSocketMaster.Listen", "Invalid operation at current state"
2052     End If
2053
2054     If Not SocketExists Then Exit Sub
2055     If Not BindInternal Then Exit Sub
2056     Dim lngResult As Long
2057     lngResult = api_listen(m_lngSocketHandle, SOMAXCONN)
2058
2059     If lngResult = SOCKET_ERROR Then
2060         Dim lngErrorCode As Long
2061         lngErrorCode = Err.LastDllError
2062         Err.Raise lngErrorCode, "CSocketMaster.Listen", GetErrorDescription(lngErrorCode)
2063     Else
2064         m_enmState = sckListening
2065         Registrar "~SOCK: Estado -> sckListening ", 3
2066     End If
2067
2068     '<EhFooter>
2069     Exit Sub
2070 Listen_Err:
2071     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Listen"
2072     Resume Next
2073     '</EhFooter>
2074 End Sub
2075
2076 Public Sub Accept(requestID As Long)
2077     '<EhHeader>
2078     On Error GoTo Accept_Err
2079
2080     '</EhHeader>
2081     If m_enmState <> sckClosed Then
2082         Registrar "~SOCK: Operación inválida en el estado actual", 3
2083     End If
2084
2085     m_lngSocketHandle = requestID
2086     m_enmProtocol = sckTCPProtocol
2087     ProcessOptions
2088
2089     If Not modSocketMaster.IsAcceptRegistered(requestID) Then
2090         If IsSocketRegistered(requestID) Then
2091             m_lngSocketHandle = INVALID_SOCKET
2092             m_lngRecvBufferLen = 0
2093             m_lngSendBufferLen = 0
2094             Registrar "~SOCK: Protocolo incorrecto o estado de conexión para la transacción", 3
2095         Else
2096             m_blnAcceptClass = True
2097             m_enmState = sckConnected
2098             Registrar "~SOCK: Estado -> sckConnected", 3
2099             GetLocalInfo m_lngSocketHandle, m_lngLocalPortBind, m_strLocalIP
2100             modSocketMaster.RegisterSocket m_lngSocketHandle, ObjPtr(Me), False
2101             Exit Sub
2102         End If
2103     End If
2104
2105     Dim clsSocket As CSocketMaster
2106     Set clsSocket = GetAcceptClass(requestID)
2107     modSocketMaster.UnregisterAccept requestID
2108     GetLocalInfo m_lngSocketHandle, m_lngLocalPortBind, m_strLocalIP
2109     GetRemoteInfo m_lngSocketHandle, m_lngRemotePort, m_strRemoteHostIP, m_strRemoteHost
2110     m_enmState = sckConnected
2111     Registrar "~SOCK: Estado -> sckConnected", 3
2112
2113     If clsSocket.BytesReceived > 0 Then
2114         clsSocket.GetData m_strRecvBuffer
2115     End If
2116
2117     modSocketMaster.Subclass_ChangeOwner requestID, ObjPtr(Me)
2118
2119     If Len(m_strRecvBuffer) > 0 Then RaiseEvent DataArrival(Len(m_strRecvBuffer))
2120     If clsSocket.State = sckClosing Then
2121         m_enmState = sckClosing
2122         Registrar "~SOCK: Estado -> sckClosing", 3
2123         RaiseEvent CloseSck
2124     End If
2125
2126     Set clsSocket = Nothing
2127     '<EhFooter>
2128     Exit Sub
2129 Accept_Err:
2130     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Accept"
2131     Resume Next
2132     '</EhFooter>
2133 End Sub
2134
2135 'Retrieves local info from a connected socket.
2136 'If succeeds returns TRUE and loads the arguments.
2137 'If fails returns FALSE and arguments are not loaded.
2138 Private Function GetLocalInfo(ByVal lngSocket As Long, _
2139                               ByRef lngLocalPort As Long, _
2140                               ByRef strLocalIP As String) As Boolean
2141     '<EhHeader>
2142     On Error GoTo GetLocalInfo_Err
2143     '</EhHeader>
2144     GetLocalInfo = False
2145     Dim lngResult As Long
2146     Dim udtSockAddr As sockaddr_in
2147     lngResult = api_getsockname(lngSocket, udtSockAddr, LenB(udtSockAddr))
2148
2149     If lngResult = SOCKET_ERROR Then
2150         lngLocalPort = 0
2151         strLocalIP = ""
2152     Else
2153         GetLocalInfo = True
2154         lngLocalPort = IntegerToUnsigned(api_ntohs(udtSockAddr.sin_port))
2155         strLocalIP = StringFromPointer(api_inet_ntoa(udtSockAddr.sin_addr))
2156     End If
2157
2158     '<EhFooter>
2159     Exit Function
2160 GetLocalInfo_Err:
2161     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetLocalInfo"
2162     Resume Next
2163     '</EhFooter>
2164 End Function
2165
2166 'Retrieves remote info from a connected socket.
2167 'If succeeds returns TRUE and loads the arguments.
2168 'If fails returns FALSE and arguments are not loaded.
2169 Private Function GetRemoteInfo(ByVal lngSocket As Long, _
2170                                ByRef lngRemotePort As Long, _
2171                                ByRef strRemoteHostIP As String, _
2172                                ByRef strRemoteHost As String) As Boolean
2173     '<EhHeader>
2174     On Error GoTo GetRemoteInfo_Err
2175     '</EhHeader>
2176     GetRemoteInfo = False
2177     Dim lngResult As Long
2178     Dim udtSockAddr As sockaddr_in
2179     lngResult = api_getpeername(lngSocket, udtSockAddr, LenB(udtSockAddr))
2180
2181     If lngResult = 0 Then
2182         GetRemoteInfo = True
2183         GetRemoteInfoFromSI udtSockAddr, lngRemotePort, strRemoteHostIP, strRemoteHost
2184     Else
2185         lngRemotePort = 0
2186         strRemoteHostIP = ""
2187         strRemoteHost = ""
2188     End If
2189
2190     '<EhFooter>
2191     Exit Function
2192 GetRemoteInfo_Err:
2193     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetRemoteInfo"
2194     Resume Next
2195     '</EhFooter>
2196 End Function
2197
2198 'Gets remote info from a sockaddr_in structure.
2199 Private Sub GetRemoteInfoFromSI(ByRef udtSockAddr As sockaddr_in, _
2200                                 ByRef lngRemotePort As Long, _
2201                                 ByRef strRemoteHostIP As String, _
2202                                 ByRef strRemoteHost As String)
2203     'Dim lngResult As Long
2204     'Dim udtHostent As HOSTENT
2205     '<EhHeader>
2206     On Error GoTo GetRemoteInfoFromSI_Err
2207     '</EhHeader>
2208     lngRemotePort = IntegerToUnsigned(api_ntohs(udtSockAddr.sin_port))
2209     strRemoteHostIP = StringFromPointer(api_inet_ntoa(udtSockAddr.sin_addr))
2210     'lngResult = api_gethostbyaddr(udtSockAddr.sin_addr, 4&, AF_INET)
2211     'If lngResult <> 0 Then
2212     '    api_CopyMemory udtHostent, ByVal lngResult, LenB(udtHostent)
2213     '    strRemoteHost = StringFromPointer(udtHostent.hName)
2214     'Else
2215     strRemoteHost = ""
2216     'End If
2217     '<EhFooter>
2218     Exit Sub
2219 GetRemoteInfoFromSI_Err:
2220     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetRemoteInfoFromSI"
2221     Resume Next
2222     '</EhFooter>
2223 End Sub
2224
2225 'Returns winsock incoming buffer length from an UDP socket.
2226 Private Function GetBufferLenUDP() As Long
2227     '<EhHeader>
2228     On Error GoTo GetBufferLenUDP_Err
2229     '</EhHeader>
2230     Dim lngResult As Long
2231     Dim lngBuffer As Long
2232     lngResult = api_ioctlsocket(m_lngSocketHandle, FIONREAD, lngBuffer)
2233
2234     If lngResult = SOCKET_ERROR Then
2235         GetBufferLenUDP = 0
2236     Else
2237         GetBufferLenUDP = lngBuffer
2238     End If
2239
2240     '<EhFooter>
2241     Exit Function
2242 GetBufferLenUDP_Err:
2243     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetBufferLenUDP"
2244     Resume Next
2245     '</EhFooter>
2246 End Function
2247
2248 'Empty winsock incoming buffer from an UDP socket.
2249 Private Sub EmptyBuffer()
2250     '<EhHeader>
2251     On Error GoTo EmptyBuffer_Err
2252     '</EhHeader>
2253     Dim B As Byte
2254     api_recv m_lngSocketHandle, B, Len(B), 0&
2255     '<EhFooter>
2256     Exit Sub
2257 EmptyBuffer_Err:
2258     Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.EmptyBuffer"
2259     Resume Next
2260     '</EhFooter>
2261 End Sub