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 100     Select Case uMsg
 213
 214             Case RESOLVE_MESSAGE
 215 101             PostResolution wParam, HiWord(lParam)
 216
 217 102         Case SOCKET_MESSAGE
 218 103             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.Ref 12/2/2008 : 09:38:34"
 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 100     m_lngSocketHandle = INVALID_SOCKET
 235         'initiate resolution collection
 236 101     Set m_colWaitingResolutions = New Collection
 237         'initiate processes and winsock service
 238 102     modSocketMaster.InitiateProcesses
 239         '<EhFooter>
 240         Exit Sub
 241 Class_Initialize_Err:
 242         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Class_Initialize.Ref 12/2/2008 : 09:38:34"
 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 100     RemotePort = m_lngRemotePort
 270         '<EhFooter>
 271         Exit Property
 272 RemotePort_Err:
 273         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemotePort.Ref 12/2/2008 : 09:38:34"
 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 100     If m_enmProtocol = sckTCPProtocol And m_enmState <> sckClosed Then
 284 101         Err.Raise sckInvalidOp, "CSocketMaster.RemotePort", "Invalid operation at current state"
 285         End If
 286
 287 102     If lngPort < 0 Or lngPort > 65535 Then
 288 103         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 104         m_lngRemotePort = lngPort
 291         End If
 292
 293         '<EhFooter>
 294         Exit Property
 295 RemotePort_Err:
 296         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemotePort.Ref 12/2/2008 : 09:38:34"
 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 100     RemoteHost = m_strRemoteHost
 306         '<EhFooter>
 307         Exit Property
 308 RemoteHost_Err:
 309         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemoteHost.Ref 12/2/2008 : 09:38:34"
 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 100     If m_enmProtocol = sckTCPProtocol And m_enmState <> sckClosed Then
 320 101         Err.Raise sckInvalidOp, "CSocketMaster.RemoteHost", "Invalid operation at current state"
 321         End If
 322
 323 102     m_strRemoteHost = strHost
 324         '<EhFooter>
 325         Exit Property
 326 RemoteHost_Err:
 327         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemoteHost.Ref 12/2/2008 : 09:38:34"
 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 100     RemoteHostIP = m_strRemoteHostIP
 337         '<EhFooter>
 338         Exit Property
 339 RemoteHostIP_Err:
 340         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RemoteHostIP.Ref 12/2/2008 : 09:38:34"
 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 100     If m_lngLocalPortBind = 0 Then
 351 101         LocalPort = m_lngLocalPort
 352         Else
 353 102         LocalPort = m_lngLocalPortBind
 354         End If
 355
 356         '<EhFooter>
 357         Exit Property
 358 LocalPort_Err:
 359         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.LocalPort.Ref 12/2/2008 : 09:38:34"
 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 100     If m_enmState <> sckClosed Then
 370 101         Err.Raise sckInvalidOp, "CSocketMaster.LocalPort", "Invalid operation at current state"
 371         End If
 372
 373 102     If lngPort < 0 Or lngPort > 65535 Then
 374 103         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 104         m_lngLocalPort = lngPort
 377         End If
 378
 379         '<EhFooter>
 380         Exit Property
 381 LocalPort_Err:
 382         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.LocalPort.Ref 12/2/2008 : 09:38:34"
 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 100     State = m_enmState
 392         '<EhFooter>
 393         Exit Property
 394 State_Err:
 395         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.State.Ref 12/2/2008 : 09:38:34"
 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 100     LocalHostName = GetLocalHostName
 405         '<EhFooter>
 406         Exit Property
 407 LocalHostName_Err:
 408         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.LocalHostName.Ref 12/2/2008 : 09:38:34"
 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 100     If m_enmState = sckConnected Then
 419 101         LocalIP = m_strLocalIP
 420         Else
 421 102         LocalIP = GetLocalIP
 422         End If
 423
 424         '<EhFooter>
 425         Exit Property
 426 LocalIP_Err:
 427         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.LocalIP.Ref 12/2/2008 : 09:38:33"
 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 100     If m_enmProtocol = sckTCPProtocol Then
 438 101         BytesReceived = Len(m_strRecvBuffer)
 439         Else
 440 102         BytesReceived = GetBufferLenUDP
 441         End If
 442
 443         '<EhFooter>
 444         Exit Property
 445 BytesReceived_Err:
 446         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.BytesReceived.Ref 12/2/2008 : 09:38:33"
 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 100     SocketHandle = m_lngSocketHandle
 456         '<EhFooter>
 457         Exit Property
 458 SocketHandle_Err:
 459         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SocketHandle.Ref 12/2/2008 : 09:38:33"
 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 100     Tag = m_strTag
 469         '<EhFooter>
 470         Exit Property
 471 Tag_Err:
 472         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Tag.Ref 12/2/2008 : 09:38:33"
 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 100     m_strTag = strTag
 482         '<EhFooter>
 483         Exit Property
 484 Tag_Err:
 485         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Tag.Ref 12/2/2008 : 09:38:33"
 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 100     Protocol = m_enmProtocol
 495         '<EhFooter>
 496         Exit Property
 497 Protocol_Err:
 498         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Protocol.Ref 12/2/2008 : 09:38:33"
 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 100     If m_enmState <> sckClosed Then
 509 101         Err.Raise sckInvalidOp, "CSocketMaster.Protocol", "Invalid operation at current state"
 510         Else
 511 102         m_enmProtocol = enmProtocol
 512         End If
 513
 514         '<EhFooter>
 515         Exit Property
 516 Protocol_Err:
 517         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Protocol.Ref 12/2/2008 : 09:38:33"
 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 100     If Not m_lngSocketHandle = INVALID_SOCKET Then
 530             Dim lngResult As Long
 531 101         lngResult = api_closesocket(m_lngSocketHandle)
 532
 533 102         If lngResult = SOCKET_ERROR Then
 534 103             m_enmState = sckError
 535                 Dim lngErrorCode As Long
 536 104             lngErrorCode = Err.LastDllError
 537 105             Err.Raise lngErrorCode, "CSocketMaster.DestroySocket", GetErrorDescription(lngErrorCode)
 538             Else
 539 106             modSocketMaster.UnregisterSocket m_lngSocketHandle
 540 107             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.Ref 12/2/2008 : 09:38:33"
 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 100     If m_lngSocketHandle = INVALID_SOCKET Then Exit Sub
 558 101     m_enmState = sckClosing
 559 102     CleanResolutionSystem
 560 103     DestroySocket
 561 104     m_lngLocalPortBind = 0
 562 105     m_strRemoteHostIP = ""
 563 106     m_strRecvBuffer = ""
 564 107     m_strSendBuffer = ""
 565 108     m_lngSendBufferLen = 0
 566 109     m_lngRecvBufferLen = 0
 567 110     m_enmState = sckClosed
 568         '<EhFooter>
 569         Exit Sub
 570 CloseSck_Err:
 571         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.CloseSck.Ref 12/2/2008 : 09:38:33"
 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 100     SocketExists = True
 584         Dim lngResult As Long
 585         Dim lngErrorCode As Long
 586
 587         'check if there is a socket already
 588 101     If m_lngSocketHandle = INVALID_SOCKET Then
 589
 590             'decide what kind of socket we are creating, TCP or UDP
 591 102         If m_enmProtocol = sckTCPProtocol Then
 592 103             lngResult = api_socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
 593             Else
 594 104             lngResult = api_socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
 595             End If
 596
 597 105         If lngResult = INVALID_SOCKET Then
 598 106             m_enmState = sckError
 599 107             SocketExists = False
 600 108             lngErrorCode = Err.LastDllError
 601                 Dim blnCancelDisplay As Boolean
 602 109             blnCancelDisplay = True
 603 110             RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.SocketExists", "", 0, blnCancelDisplay)
 604
 605 111             If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.SocketExists"
 606             Else
 607 112             m_lngSocketHandle = lngResult
 608                 'set and get some socket options
 609 113             ProcessOptions
 610 114             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.Ref 12/2/2008 : 09:38:33"
 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 100     If m_enmState <> sckClosed Then
 632 101         Err.Raise sckInvalidOp, "CSocketMaster.Connect", "Invalid operation at current state"
 633         End If
 634
 635 102     If Not IsMissing(RemoteHost) Then
 636 103         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 104     If m_strRemoteHost = vbNullString Then
 643 105         m_strRemoteHost = ""
 644         End If
 645
 646         'check if RemotePort is a number between 1 and 65535
 647 106     If Not IsMissing(RemotePort) Then
 648 107         If IsNumeric(RemotePort) Then
 649 108             If CLng(RemotePort) > 65535 Or CLng(RemotePort) < 1 Then
 650 109                 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 110                 m_lngRemotePort = CLng(RemotePort)
 653                 End If
 654
 655             Else
 656 111             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 112     If Not SocketExists Then Exit Sub
 662
 663         'Here we bind the socket
 664 113     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 114     If m_enmProtocol = sckUDPProtocol Then
 669 115         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 116     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 117     If lngAddress <> vbNull Then
 685             '136         registrar "~SOCK: Conectando directamente por IP", 3
 686 118         ConnectToIP lngAddress, 0
 687         End If
 688
 689         '<EhFooter>
 690         Exit Sub
 691 Connect_Err:
 692         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Connect.Ref 12/2/2008 : 09:38:33"
 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 100     m_colWaitingResolutions.Remove "R" & lngAsynHandle
 706 101     UnregisterResolution lngAsynHandle
 707
 708 102     If m_enmState <> sckResolvingHost Then Exit Sub
 709 103     If lngErrorCode = 0 Then 'if there weren't errors trying to resolve the hostname
 710 104         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 105         api_CopyMemory udtHostent, ByVal m_lngMemoryPointer, LenB(udtHostent)
 718 106         api_CopyMemory lngPtrToIP, ByVal udtHostent.hAddrList, 4
 719 107         api_CopyMemory arrIpAddress(1), ByVal lngPtrToIP, 4
 720 108         api_CopyMemory lngRemoteHostAddress, ByVal lngPtrToIP, 4
 721             'free memory, won't need it any longer
 722 109         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 110         For Count = 1 To 4
 728 111             strIpAddress = strIpAddress & arrIpAddress(Count) & "."
 729             Next
 730
 731 112         strIpAddress = Left$(strIpAddress, Len(strIpAddress) - 1)
 732 113         ConnectToIP lngRemoteHostAddress, 0
 733         Else 'there were errors trying to resolve the hostname
 734             'free buffer memory
 735 114         FreeMemory
 736 115         ConnectToIP vbNull, lngErrorCode
 737         End If
 738
 739         '<EhFooter>
 740         Exit Sub
 741 PostResolution_Err:
 742         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.PostResolution.Ref 12/2/2008 : 09:38:33"
 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 100     If lngErrorCode <> 0 Then
 761 101         m_enmState = sckError
 762 102         Registrar "~SOCK: Estado -> sckError", 3
 763 103         blnCancelDisplay = True
 764 104         RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.PostSocket", "", 0, blnCancelDisplay)
 765
 766 105         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 106     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 107             If m_enmState <> sckConnecting Then
 783 108                 Registrar "~SOCK:" & "Advertencia: Omitiendo FD_CONNECT", 3
 784                     Exit Sub
 785                 End If
 786
 787                 'Get the local parameters
 788 109             GetLocalInfo m_lngSocketHandle, m_lngLocalPortBind, m_strLocalIP
 789                 'Get the connection local end-point parameters
 790 110             GetRemoteInfo m_lngSocketHandle, m_lngRemotePort, m_strRemoteHostIP, m_strRemoteHost
 791 111             m_enmState = sckConnected
 792 112             Registrar "~SOCK: Estado -> sckConnected", 3
 793 113             RaiseEvent Connect
 794
 795                 '======================================================================
 796 114         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 115             If m_enmState <> sckConnected Then
 804 116                 Registrar "~SOCK:" & "Advertencia: Omitiendo FD_WRITE", 3
 805                     Exit Sub
 806                 End If
 807
 808 117             If Len(m_strSendBuffer) > 0 Then
 809 118                 SendBufferedData
 810                 End If
 811
 812                 '======================================================================
 813 119         Case FD_READ
 814
 815                 'Some data has arrived for this socket.
 816                 'registrar "~SOCK:" & "FD_READ " & m_lngSocketHandle, 3
 817 120             If m_enmProtocol = sckTCPProtocol Then
 818 121                 If m_enmState <> sckConnected Then
 819 122                     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 123                 lngBytesReceived = RecvDataToBuffer
 827
 828 124                 If lngBytesReceived > 0 Then
 829 125                     RaiseEvent DataArrival(Len(m_strRecvBuffer))
 830                     End If
 831
 832                 Else 'UDP protocol
 833
 834 126                 If m_enmState <> sckOpen Then
 835 127                     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 128                 lngBytesReceived = GetBufferLenUDP
 843
 844 129                 If lngBytesReceived > 0 Then
 845 130                     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 131                 EmptyBuffer
 851                 End If
 852
 853                 '======================================================================
 854 132         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 133             If m_enmState <> sckListening Then
 862 134                 Registrar "~SOCK:" & "Advertencia: Omitiendo FD_ACCEPT", 3
 863                     Exit Sub
 864                 End If
 865
 866 135             lngResult = api_accept(m_lngSocketHandle, udtSockAddr, LenB(udtSockAddr))
 867
 868 136             If lngResult = INVALID_SOCKET Then
 869 137                 lngErrorCode = Err.LastDllError
 870 138                 m_enmState = sckError
 871 139                 blnCancelDisplay = True
 872 140                 RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.PostSocket", "", 0, blnCancelDisplay)
 873
 874 141                 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 142                 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 143                 lngTempRP = m_lngRemotePort
 887 144                 strTempRHIP = m_strRemoteHostIP
 888 145                 strTempRH = m_strRemoteHost
 889 146                 GetRemoteInfo lngResult, m_lngRemotePort, m_strRemoteHostIP, m_strRemoteHost
 890 147                 Registrar "~SOCK: Socket aceptado -> " & lngResult, 3
 891 148                 RaiseEvent ConnectionRequest(lngResult)
 892
 893                     'we return original info
 894 149                 If m_enmState = sckListening Then
 895 150                     m_lngRemotePort = lngTempRP
 896 151                     m_strRemoteHostIP = strTempRHIP
 897 152                     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 153                 If IsAcceptRegistered(lngResult) Then
 903 154                     api_closesocket lngResult
 904 155                     modSocketMaster.UnregisterSocket lngResult
 905 156                     modSocketMaster.UnregisterAccept lngResult
 906 157                     Registrar "~SOCK: Socket aceptado cerrado ->  " & lngResult, 3
 907                     End If
 908                 End If
 909
 910                 '======================================================================
 911 158         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 159             If m_enmState <> sckConnected Then
 916 160                 Registrar "~SOCK: Advertencia: Omitiendo FD_CLOSE", 3
 917                     Exit Sub
 918                 End If
 919
 920 161             m_enmState = sckClosing
 921 162             Registrar "~SOCK: Estado -> sckClosing", 3
 922 163             RaiseEvent CloseSck
 923         End Select
 924
 925         '<EhFooter>
 926         Exit Sub
 927 PostSocket_Err:
 928         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.PostSocket.Ref 12/2/2008 : 09:38:33"
 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 100     If lngErrorCode <> 0 Then
 943 101         m_enmState = sckError
 944 102         blnCancelDisplay = True
 945 103         RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.ConnectToIP", "", 0, blnCancelDisplay)
 946
 947 104         If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.ConnectToIP"
 948             Exit Sub
 949         End If
 950
 951 105     Registrar "~SOCK: Conectando a: " + m_strRemoteHost + " " + m_strRemoteHostIP, 3
 952 106     m_enmState = sckConnecting
 953 107     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 108     With udtSockAddr
 960 109         .sin_addr = lngRemoteHostAddress
 961 110         .sin_family = AF_INET
 962 111         .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 112     lngResult = api_connect(m_lngSocketHandle, udtSockAddr, LenB(udtSockAddr))
 967
 968         'Check and handle errors
 969 113     If lngResult = SOCKET_ERROR Then
 970 114         lngErrorCode = Err.LastDllError
 971
 972 115         If lngErrorCode <> WSAEWOULDBLOCK Then
 973 116             If lngErrorCode = WSAEADDRNOTAVAIL Then
 974 117                 Err.Raise WSAEADDRNOTAVAIL, "CSocketMaster.ConnectToIP", GetErrorDescription(WSAEADDRNOTAVAIL)
 975                 Else
 976 118                 m_enmState = sckError
 977 119                 blnCancelDisplay = True
 978 120                 RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.ConnectToIP", "", 0, blnCancelDisplay)
 979
 980 121                 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.Ref 12/2/2008 : 09:38:33"
 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 100     If m_enmState = sckOpen Then
1027 101         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 102     BindInternal = False
1038
1039         'Check if varLocalPort is a number between 0 and 65535
1040 103     If Not IsMissing(varLocalPort) Then
1041 104         If IsNumeric(varLocalPort) Then
1042 105             If varLocalPort < 0 Or varLocalPort > 65535 Then
1043 106                 BindInternal = False
1044 107                 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 108                 lngLocalPortInternal = CLng(varLocalPort)
1047                 End If
1048
1049             Else
1050 109             BindInternal = False
1051 110             Err.Raise sckUnsupported, "CSocketMaster.BindInternal", "Tipos variantes no soportados"
1052             End If
1053
1054         Else
1055 111         lngLocalPortInternal = m_lngLocalPort
1056         End If
1057
1058 112     If IsMissing(varLocalIP) Then varLocalIP = "000.000.000.000"
1059 113     strLocalHostInternal = CStr(varLocalIP)
1060         'registrar "~SOCK:" & "@Wine => varLocalIP: " & CStr(varLocalIP) & " | strLocalHostInternal: " & CStr(strLocalHostInternal) & " | strIP: " & strIP, 3
1061         'get a 32 bits long IP
1062 114     lngAddressInternal = ResolveIfHostnameSync(strLocalHostInternal, strIP, lngResult)
1063
1064         'registrar "~SOCK:" & "@Wine => lngResult: " & lngResult, 3
1065 115     If lngResult <> 0 Then Err.Raise sckInvalidArg, "CSocketMaster.BindInternal", "Argumento inválido"
1066
1067         'create a socket if there isn't one yet
1068 116     If Not SocketExists Then Exit Function
1069         Dim udtSockAddr As sockaddr_in
1070
1071 117     With udtSockAddr
1072 118         .sin_addr = lngAddressInternal
1073 119         .sin_family = AF_INET
1074 120         .sin_port = api_htons(modSocketMaster.UnsignedToInteger(lngLocalPortInternal))
1075         End With
1076
1077         'bind the socket
1078 121     lngResult = api_bind(m_lngSocketHandle, udtSockAddr, LenB(udtSockAddr))
1079
1080 122     If lngResult = SOCKET_ERROR Then
1081 123         lngErrorCode = Err.LastDllError
1082 124         Err.Raise lngErrorCode, "CSocketMaster.BindInternal", GetErrorDescription(lngErrorCode)
1083         Else
1084
1085 125         If lngLocalPortInternal <> 0 Then
1086                 '160             registrar "~SOCK: Servidor enlazado -> " & strLocalHostInternal & " | Puerto -> " & lngLocalPortInternal, 3
1087 126             m_lngLocalPort = lngLocalPortInternal
1088             Else
1089 127             lngResult = GetLocalPort(m_lngSocketHandle)
1090
1091 128             If lngResult = SOCKET_ERROR Then
1092 129                 lngErrorCode = Err.LastDllError
1093 130                 Err.Raise lngErrorCode, "CSocketMaster.BindInternal", GetErrorDescription(lngErrorCode)
1094                 Else
1095                     'registrar "~SOCK: Servidor enlazado -> " & strLocalHostInternal & " | Puerto -> " & lngLocalPortInternal, 3
1096 131                 m_lngLocalPortBind = lngResult
1097                 End If
1098             End If
1099
1100 132         BindInternal = True
1101         End If
1102
1103         '<EhFooter>
1104         Exit Function
1105 BindInternal_Err:
1106         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.BindInternal.Ref 12/2/2008 : 09:38:33"
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 100     m_lngMemoryHandle = api_GlobalAlloc(GMEM_FIXED, MAXGETHOSTSTRUCT)
1119
1120 101     If m_lngMemoryHandle <> 0 Then
1121 102         m_lngMemoryPointer = api_GlobalLock(m_lngMemoryHandle)
1122
1123 103         If m_lngMemoryPointer <> 0 Then
1124 104             api_GlobalUnlock (m_lngMemoryHandle)
1125 105             AllocateMemory = m_lngMemoryPointer
1126             Else
1127 106             api_GlobalFree (m_lngMemoryHandle)
1128 107             AllocateMemory = m_lngMemoryPointer '0
1129             End If
1130
1131         Else
1132 108         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.Ref 12/2/2008 : 09:38:33"
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 100     If m_lngMemoryHandle <> 0 Then
1150 101         m_lngMemoryPointer = 0
1151 102         api_GlobalFree m_lngMemoryHandle
1152 103         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.Ref 12/2/2008 : 09:38:33"
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 100     lngResult = api_gethostname(strHostNameBuf, LOCAL_HOST_BUFF)
1171
1172 101     If lngResult = SOCKET_ERROR Then
1173 102         GetLocalHostName = vbNullString
1174             Dim lngErrorCode As Long
1175 103         lngErrorCode = Err.LastDllError
1176 104         Err.Raise lngErrorCode, "CSocketMaster.GetLocalHostName", GetErrorDescription(lngErrorCode)
1177         Else
1178 105         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.Ref 12/2/2008 : 09:38:33"
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 100     strLocalHost = GetLocalHostName
1202 101     lngResult = api_gethostbyname(strLocalHost)
1203
1204 102     If lngResult = 0 Then
1205 103         GetLocalIP = vbNullString
1206             Dim lngErrorCode As Long
1207 104         lngErrorCode = Err.LastDllError
1208 105         Err.Raise lngErrorCode, "CSocketMaster.GetLocalIP", GetErrorDescription(lngErrorCode)
1209         Else
1210 106         api_CopyMemory udtHostent, ByVal lngResult, LenB(udtHostent)
1211 107         api_CopyMemory lngPtrToIP, ByVal udtHostent.hAddrList, 4
1212 108         api_CopyMemory arrIpAddress(1), ByVal lngPtrToIP, 4
1213
1214 109         For Count = 1 To 4
1215 110             strIpAddress = strIpAddress & arrIpAddress(Count) & "."
1216             Next
1217
1218 111         strIpAddress = Left$(strIpAddress, Len(strIpAddress) - 1)
1219 112         GetLocalIP = strIpAddress
1220         End If
1221
1222         '<EhFooter>
1223         Exit Function
1224 GetLocalIP_Err:
1225         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetLocalIP.Ref 12/2/2008 : 09:38:33"
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 100     lngAddress = api_inet_addr(Host)
1240
1241 101     If lngAddress = INADDR_NONE Then 'if Host isn't an IP
1242 102         ResolveIfHostname = vbNull
1243 103         m_enmState = sckResolvingHost
1244
1245 104         If AllocateMemory Then
1246                 Dim lngAsynHandle As Long
1247 105             lngAsynHandle = modSocketMaster.ResolveHost(Host, m_lngMemoryPointer, ObjPtr(Me))
1248
1249 106             If lngAsynHandle = 0 Then
1250 107                 FreeMemory
1251 108                 m_enmState = sckError
1252                     Dim lngErrorCode As Long
1253 109                 lngErrorCode = Err.LastDllError
1254                     Dim blnCancelDisplay As Boolean
1255 110                 blnCancelDisplay = True
1256 111                 RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.ResolveIfHostname", "", 0, blnCancelDisplay)
1257
1258 112                 If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.ResolveIfHostname"
1259                 Else
1260 113                 m_colWaitingResolutions.Add lngAsynHandle, "R" & lngAsynHandle
1261 114                 Registrar "~SOCK: Resolviendo servidor -> " & Host & " - con control ASYNC: " & lngAsynHandle, 3
1262                 End If
1263
1264             Else
1265 115             m_enmState = sckError
1266 116             Registrar "~SOCK: Error asignando memoria", 3
1267 117             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 118         ResolveIfHostname = lngAddress
1272         End If
1273
1274         '<EhFooter>
1275         Exit Function
1276 ResolveIfHostname_Err:
1277         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.ResolveIfHostname.Ref 12/2/2008 : 09:38:33"
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 100     lngAddress = api_inet_addr(Host)
1300
1301 101     If lngAddress = INADDR_NONE Then 'if Host isn't an IP
1302 102         lngPtrToHOSTENT = api_gethostbyname(Host)
1303
1304 103         If lngPtrToHOSTENT = 0 Then
1305 104             lngErrorCode = Err.LastDllError
1306 105             strHostIP = vbNullString
1307 106             ResolveIfHostnameSync = vbNull
1308             Else
1309 107             api_CopyMemory udtHostent, ByVal lngPtrToHOSTENT, LenB(udtHostent)
1310 108             api_CopyMemory lngPtrToIP, ByVal udtHostent.hAddrList, 4
1311 109             api_CopyMemory arrIpAddress(1), ByVal lngPtrToIP, 4
1312 110             api_CopyMemory lngAddress, ByVal lngPtrToIP, 4
1313
1314 111             For Count = 1 To 4
1315 112                 strHostIP = strHostIP & arrIpAddress(Count) & "."
1316                 Next
1317
1318 113             strHostIP = Left$(strHostIP, Len(strHostIP) - 1)
1319 114             lngErrorCode = 0
1320 115             ResolveIfHostnameSync = lngAddress
1321             End If
1322
1323         Else 'if Host is an IP doen't need to resolve anything
1324 116         lngErrorCode = 0
1325 117         strHostIP = Host
1326 118         ResolveIfHostnameSync = lngAddress
1327         End If
1328
1329         '<EhFooter>
1330         Exit Function
1331 ResolveIfHostnameSync_Err:
1332         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.ResolveIfHostnameSync.Ref 12/2/2008 : 09:38:33"
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 100     lngResult = api_getsockname(lngSocket, udtSockAddr, LenB(udtSockAddr))
1346
1347 101     If lngResult = SOCKET_ERROR Then
1348 102         GetLocalPort = SOCKET_ERROR
1349         Else
1350 103         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.Ref 12/2/2008 : 09:38:33"
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 100     If m_enmProtocol = sckTCPProtocol Then
1368 101         If m_enmState <> sckConnected Then
1369 102             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 103         If Not SocketExists Then Exit Sub
1376 104         If Not BindInternal Then Exit Sub
1377 105         m_enmState = sckOpen
1378         End If
1379
1380         'We need to convert data variant into a byte array
1381 106     Select Case varType(data)
1382
1383             Case vbString
1384                 Dim strdata As String
1385 107             strdata = CStr(data)
1386
1387 108             If Len(strdata) = 0 Then Exit Sub
1388 109             ReDim arrData(Len(strdata) - 1)
1389 110             arrData() = StrConv(strdata, vbFromUnicode)
1390
1391 111         Case vbArray + vbByte
1392                 Dim strArray As String
1393 112             strArray = StrConv(data, vbUnicode)
1394
1395 113             If Len(strArray) = 0 Then Exit Sub
1396 114             arrData() = StrConv(strArray, vbFromUnicode)
1397
1398 115         Case vbBoolean
1399                 Dim blnData As Boolean
1400 116             blnData = CBool(data)
1401 117             ReDim arrData(LenB(blnData) - 1)
1402 118             api_CopyMemory arrData(0), blnData, LenB(blnData)
1403
1404 119         Case vbByte
1405                 Dim bytData As Byte
1406 120             bytData = CByte(data)
1407 121             ReDim arrData(LenB(bytData) - 1)
1408 122             api_CopyMemory arrData(0), bytData, LenB(bytData)
1409
1410 123         Case vbCurrency
1411                 Dim curData As Currency
1412 124             curData = CCur(data)
1413 125             ReDim arrData(LenB(curData) - 1)
1414 126             api_CopyMemory arrData(0), curData, LenB(curData)
1415
1416 127         Case vbDate
1417                 Dim datData As Date
1418 128             datData = CDate(data)
1419 129             ReDim arrData(LenB(datData) - 1)
1420 130             api_CopyMemory arrData(0), datData, LenB(datData)
1421
1422 131         Case vbDouble
1423                 Dim dblData As Double
1424 132             dblData = CDbl(data)
1425 133             ReDim arrData(LenB(dblData) - 1)
1426 134             api_CopyMemory arrData(0), dblData, LenB(dblData)
1427
1428 135         Case vbInteger
1429                 Dim intData As Integer
1430 136             intData = CInt(data)
1431 137             ReDim arrData(LenB(intData) - 1)
1432 138             api_CopyMemory arrData(0), intData, LenB(intData)
1433
1434 139         Case vbLong
1435                 Dim lngData As Long
1436 140             lngData = CLng(data)
1437 141             ReDim arrData(LenB(lngData) - 1)
1438 142             api_CopyMemory arrData(0), lngData, LenB(lngData)
1439
1440 143         Case vbSingle
1441                 Dim sngData As Single
1442 144             sngData = CSng(data)
1443 145             ReDim arrData(LenB(sngData) - 1)
1444 146             api_CopyMemory arrData(0), sngData, LenB(sngData)
1445
1446 147         Case Else
1447 148             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 149     If Len(m_strSendBuffer) > 0 Then
1454 150         m_strSendBuffer = m_strSendBuffer + StrConv(arrData(), vbUnicode)
1455             Exit Sub
1456         Else
1457 151         m_strSendBuffer = m_strSendBuffer + StrConv(arrData(), vbUnicode)
1458         End If
1459
1460         'send the data
1461 152     SendBufferedData
1462         '<EhFooter>
1463         Exit Sub
1464 SendData_Err:
1465         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SendData.Ref 12/2/2008 : 09:38:33"
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 100     If m_enmProtocol = sckTCPProtocol Then
1478 101         SendBufferedDataTCP
1479         Else
1480 102         SendBufferedDataUDP
1481         End If
1482
1483         '<EhFooter>
1484         Exit Sub
1485 SendBufferedData_Err:
1486         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.SendBufferedData.Ref 12/2/2008 : 09:38:33"
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 100     lngAddress = ResolveIfHostnameSync(m_strRemoteHost, strTemp, lngErrorCode)
1504
1505 101     If lngErrorCode <> 0 Then
1506 102         m_strSendBuffer = ""
1507
1508 103         If lngErrorCode = WSAEAFNOSUPPORT Then
1509 104             Err.Raise lngErrorCode, "CSocketMaster.SendBufferedDataUDP", GetErrorDescription(lngErrorCode)
1510             Else
1511 105             Err.Raise sckInvalidArg, "CSocketMaster.SendBufferedDataUDP", "Invalid argument"
1512             End If
1513         End If
1514
1515 106     With udtSockAddr
1516 107         .sin_addr = lngAddress
1517 108         .sin_family = AF_INET
1518 109         .sin_port = api_htons(modSocketMaster.UnsignedToInteger(m_lngRemotePort))
1519         End With
1520
1521 110     lngBufferLength = Len(m_strSendBuffer)
1522 111     arrData() = StrConv(m_strSendBuffer, vbFromUnicode)
1523 112     m_strSendBuffer = ""
1524 113     lngResult = api_sendto(m_lngSocketHandle, arrData(0), lngBufferLength, 0&, udtSockAddr, LenB(udtSockAddr))
1525
1526 114     If lngResult = SOCKET_ERROR Then
1527 115         lngErrorCode = Err.LastDllError
1528 116         m_enmState = sckError
1529             Dim blnCancelDisplay As Boolean
1530 117         blnCancelDisplay = True
1531 118         RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.SendBufferedDataUDP", "", 0, blnCancelDisplay)
1532
1533 119         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.Ref 12/2/2008 : 09:38:33"
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 100     Do Until lngResult = SOCKET_ERROR Or Len(m_strSendBuffer) = 0
1555 101         lngBufferLength = Len(m_strSendBuffer)
1556
1557 102         If lngBufferLength > m_lngSendBufferLen Then
1558 103             lngBufferLength = m_lngSendBufferLen
1559 104             arrData() = StrConv(Left$(m_strSendBuffer, m_lngSendBufferLen), vbFromUnicode)
1560             Else
1561 105             arrData() = StrConv(m_strSendBuffer, vbFromUnicode)
1562             End If
1563
1564 106         lngResult = api_send(m_lngSocketHandle, arrData(0), lngBufferLength, 0&)
1565
1566 107         If lngResult = SOCKET_ERROR Then
1567                 Dim lngErrorCode As Long
1568 108             lngErrorCode = Err.LastDllError
1569
1570 109             If lngErrorCode = WSAEWOULDBLOCK Then
1571 110                 Registrar "~SOCK:" & "Advertencia: Buffer de envío lleno, esperando...", 3
1572
1573 111                 If lngTotalSent > 0 Then RaiseEvent SendProgress(lngTotalSent, Len(m_strSendBuffer))
1574                 Else
1575 112                 m_enmState = sckError
1576                     Dim blnCancelDisplay As Boolean
1577 113                 blnCancelDisplay = True
1578 114                 RaiseEvent error(lngErrorCode, GetErrorDescription(lngErrorCode), 0, "CSocketMaster.SendBufferedData", "", 0, blnCancelDisplay)
1579
1580 115                 If blnCancelDisplay = False Then MsgBox GetErrorDescription(lngErrorCode), vbOKOnly, "CSocketMaster.SendBufferedData"
1581                 End If
1582
1583             Else
1584 116             Registrar "~SOCK: Bytes enviados => " & lngResult, 3
1585 117             lngTotalSent = lngTotalSent + lngResult
1586
1587 118             If Len(m_strSendBuffer) > lngResult Then
1588 119                 m_strSendBuffer = Mid$(m_strSendBuffer, lngResult + 1)
1589                 Else
1590 120                 Registrar "~SOCK: Envío terminado", 3
1591 121                 m_strSendBuffer = ""
1592                     Dim lngTemp As Long
1593 122                 lngTemp = lngTotalSent
1594 123                 lngTotalSent = 0
1595 124                 RaiseEvent SendProgress(lngTemp, 0)
1596 125                 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.Ref 12/2/2008 : 09:38:33"
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 100     ReDim arrBuffer(m_lngRecvBufferLen - 1)
1621 101     lngBytesReceived = api_recv(m_lngSocketHandle, arrBuffer(0), m_lngRecvBufferLen, 0&)
1622
1623 102     If lngBytesReceived = SOCKET_ERROR Then
1624 103         m_enmState = sckError
1625             Dim lngErrorCode As Long
1626 104         lngErrorCode = Err.LastDllError
1627 105         Err.Raise lngErrorCode, "CSocketMaster.RecvDataToBuffer", GetErrorDescription(lngErrorCode)
1628 106     ElseIf lngBytesReceived > 0 Then
1629 107         strBuffTemporal = StrConv(arrBuffer(), vbUnicode)
1630 108         m_strRecvBuffer = m_strRecvBuffer & Left$(strBuffTemporal, lngBytesReceived)
1631 109         RecvDataToBuffer = lngBytesReceived
1632         End If
1633
1634         '<EhFooter>
1635         Exit Function
1636 RecvDataToBuffer_Err:
1637         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.RecvDataToBuffer.Ref 12/2/2008 : 09:38:32"
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 100     If m_enmProtocol = sckTCPProtocol Then
1653 101         lngResult = api_getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_RCVBUF, lngBuffer, LenB(lngBuffer))
1654
1655 102         If lngResult = SOCKET_ERROR Then
1656 103             lngErrorCode = Err.LastDllError
1657 104             Err.Raise lngErrorCode, "CSocketMaster.ProcessOptions", GetErrorDescription(lngErrorCode)
1658             Else
1659 105             m_lngRecvBufferLen = lngBuffer
1660             End If
1661
1662 106         lngResult = api_getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_SNDBUF, lngBuffer, LenB(lngBuffer))
1663
1664 107         If lngResult = SOCKET_ERROR Then
1665 108             lngErrorCode = Err.LastDllError
1666 109             Err.Raise lngErrorCode, "CSocketMaster.ProcessOptions", GetErrorDescription(lngErrorCode)
1667             Else
1668 110             m_lngSendBufferLen = lngBuffer
1669             End If
1670
1671         Else
1672 111         lngBuffer = 1
1673 112         lngResult = api_setsockopt(m_lngSocketHandle, SOL_SOCKET, SO_BROADCAST, lngBuffer, LenB(lngBuffer))
1674 113         lngResult = api_getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_MAX_MSG_SIZE, lngBuffer, LenB(lngBuffer))
1675
1676 114         If lngResult = SOCKET_ERROR Then
1677 115             lngErrorCode = Err.LastDllError
1678 116             Err.Raise lngErrorCode, "CSocketMaster.ProcessOptions", GetErrorDescription(lngErrorCode)
1679             Else
1680 117             m_lngRecvBufferLen = lngBuffer
1681 118             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.Ref 12/2/2008 : 09:38:32"
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 100     If m_enmProtocol = sckTCPProtocol Then
1703 101         If m_enmState <> sckConnected And Not m_blnAcceptClass Then
1704 102             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 103         If m_enmState <> sckOpen Then
1711 104             Err.Raise sckBadState, "CSocketMaster.GetData", "Wrong protocol or connection state for the requested transaction or request"
1712                 Exit Sub
1713             End If
1714
1715 105         If GetBufferLenUDP = 0 Then Exit Sub
1716         End If
1717
1718 106     If Not IsMissing(maxLen) Then
1719 107         If IsNumeric(maxLen) Then
1720 108             If CLng(maxLen) < 0 Then
1721 109                 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 110             If m_enmProtocol = sckTCPProtocol Then
1727 111                 maxLen = Len(m_strRecvBuffer)
1728                 Else
1729 112                 maxLen = GetBufferLenUDP
1730                 End If
1731             End If
1732         End If
1733
1734         Dim lngBytesRecibidos  As Long
1735 113     lngBytesRecibidos = RecvData(data, False, varType, maxLen)
1736 114     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.Ref 12/2/2008 : 09:38:32"
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 100     If m_enmProtocol = sckTCPProtocol Then
1753 101         If m_enmState <> sckConnected Then
1754 102             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 103         If m_enmState <> sckOpen Then
1761 104             Err.Raise sckBadState, "CSocketMaster.PeekData", "Wrong protocol or connection state for the requested transaction or request"
1762                 Exit Sub
1763             End If
1764
1765 105         If GetBufferLenUDP = 0 Then Exit Sub
1766         End If
1767
1768 106     If Not IsMissing(maxLen) Then
1769 107         If IsNumeric(maxLen) Then
1770 108             If CLng(maxLen) < 0 Then
1771 109                 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 110             If m_enmProtocol = sckTCPProtocol Then
1777 111                 maxLen = Len(m_strRecvBuffer)
1778                 Else
1779 112                 maxLen = GetBufferLenUDP
1780                 End If
1781             End If
1782         End If
1783
1784         Dim lngBytesRecibidos  As Long
1785 113     lngBytesRecibidos = RecvData(data, True, varType, maxLen)
1786 114     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.Ref 12/2/2008 : 09:38:32"
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 100     If m_enmProtocol = sckTCPProtocol Then
1820 101         lngBufferLen = Len(m_strRecvBuffer)
1821         Else
1822 102         lngBufferLen = GetBufferLenUDP
1823         End If
1824
1825 103     blnMaxLenMiss = IsMissing(maxLen)
1826 104     blnClassMiss = IsMissing(varClass)
1827
1828         'Select type of data
1829 105     If varType(data) = vbEmpty Then
1830 106         If blnClassMiss Then varClass = vbArray + vbByte
1831         Else
1832 107         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 108     If varClass = vbString Or varClass = vbArray + vbByte Then
1840 109         If blnMaxLenMiss Then 'if maxLen argument is missing
1841 110             If lngBufferLen = 0 Then
1842 111                 RecvData = 0
1843 112                 arrBuffer = StrConv("", vbFromUnicode)
1844 113                 data = arrBuffer
1845                     Exit Function
1846                 Else
1847 114                 RecvData = lngBufferLen
1848 115                 BuildArray lngBufferLen, blnPeek, lngErrorCode, arrBuffer
1849                 End If
1850
1851             Else 'if maxLen argument is not missing
1852
1853 116             If maxLen = 0 Or lngBufferLen = 0 Then
1854 117                 RecvData = 0
1855 118                 arrBuffer = StrConv("", vbFromUnicode)
1856 119                 data = arrBuffer
1857
1858 120                 If m_enmProtocol = sckUDPProtocol Then
1859 121                     EmptyBuffer
1860 122                     Err.Raise WSAEMSGSIZE, "CSocketMaster.RecvData", GetErrorDescription(WSAEMSGSIZE)
1861                     End If
1862
1863                     Exit Function
1864 123             ElseIf maxLen > lngBufferLen Then
1865 124                 RecvData = lngBufferLen
1866 125                 BuildArray lngBufferLen, blnPeek, lngErrorCode, arrBuffer
1867                 Else
1868 126                 RecvData = CLng(maxLen)
1869 127                 BuildArray CLng(maxLen), blnPeek, lngErrorCode, arrBuffer
1870                 End If
1871             End If
1872         End If
1873
1874 128     Select Case varClass
1875
1876             Case vbString
1877                 Dim strdata As String
1878 129             strdata = StrConv(arrBuffer(), vbUnicode)
1879 130             data = strdata
1880
1881 131         Case vbArray + vbByte
1882 132             data = arrBuffer
1883
1884 133         Case vbBoolean
1885                 Dim blnData As Boolean
1886
1887 134             If LenB(blnData) > lngBufferLen Then Exit Function
1888 135             BuildArray LenB(blnData), blnPeek, lngErrorCode, arrBuffer
1889 136             RecvData = LenB(blnData)
1890 137             api_CopyMemory blnData, arrBuffer(0), LenB(blnData)
1891 138             data = blnData
1892
1893 139         Case vbByte
1894                 Dim bytData As Byte
1895
1896 140             If LenB(bytData) > lngBufferLen Then Exit Function
1897 141             BuildArray LenB(bytData), blnPeek, lngErrorCode, arrBuffer
1898 142             RecvData = LenB(bytData)
1899 143             api_CopyMemory bytData, arrBuffer(0), LenB(bytData)
1900 144             data = bytData
1901
1902 145         Case vbCurrency
1903                 Dim curData As Currency
1904
1905 146             If LenB(curData) > lngBufferLen Then Exit Function
1906 147             BuildArray LenB(curData), blnPeek, lngErrorCode, arrBuffer
1907 148             RecvData = LenB(curData)
1908 149             api_CopyMemory curData, arrBuffer(0), LenB(curData)
1909 150             data = curData
1910
1911 151         Case vbDate
1912                 Dim datData As Date
1913
1914 152             If LenB(datData) > lngBufferLen Then Exit Function
1915 153             BuildArray LenB(datData), blnPeek, lngErrorCode, arrBuffer
1916 154             RecvData = LenB(datData)
1917 155             api_CopyMemory datData, arrBuffer(0), LenB(datData)
1918 156             data = datData
1919
1920 157         Case vbDouble
1921                 Dim dblData As Double
1922
1923 158             If LenB(dblData) > lngBufferLen Then Exit Function
1924 159             BuildArray LenB(dblData), blnPeek, lngErrorCode, arrBuffer
1925 160             RecvData = LenB(dblData)
1926 161             api_CopyMemory dblData, arrBuffer(0), LenB(dblData)
1927 162             data = dblData
1928
1929 163         Case vbInteger
1930                 Dim intData As Integer
1931
1932 164             If LenB(intData) > lngBufferLen Then Exit Function
1933 165             BuildArray LenB(intData), blnPeek, lngErrorCode, arrBuffer
1934 166             RecvData = LenB(intData)
1935 167             api_CopyMemory intData, arrBuffer(0), LenB(intData)
1936 168             data = intData
1937
1938 169         Case vbLong
1939                 Dim lngData As Long
1940
1941 170             If LenB(lngData) > lngBufferLen Then Exit Function
1942 171             BuildArray LenB(lngData), blnPeek, lngErrorCode, arrBuffer
1943 172             RecvData = LenB(lngData)
1944 173             api_CopyMemory lngData, arrBuffer(0), LenB(lngData)
1945 174             data = lngData
1946
1947 175         Case vbSingle
1948                 Dim sngData As Single
1949
1950 176             If LenB(sngData) > lngBufferLen Then Exit Function
1951 177             BuildArray LenB(sngData), blnPeek, lngErrorCode, arrBuffer
1952 178             RecvData = LenB(sngData)
1953 179             api_CopyMemory sngData, arrBuffer(0), LenB(sngData)
1954 180             data = sngData
1955
1956 181         Case Else
1957 182             Err.Raise sckUnsupported, "CSocketMaster.RecvData", "Unsupported variant type."
1958         End Select
1959
1960         'if BuildArray returns an error is handled here
1961 183     If lngErrorCode <> 0 Then
1962 184         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.Ref 12/2/2008 : 09:38:32"
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 100     If m_enmProtocol = sckTCPProtocol Then
1984 101         strdata = Left$(m_strRecvBuffer, CLng(Size))
1985
1986 102         If strdata <> vbNullString Then bytArray = StrConv(strdata, vbFromUnicode)
1987 103         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 104         If blnPeek Then lngFlags = MSG_PEEK
1995 105         ReDim arrBuffer(Size - 1)
1996 106         lngResult = api_recvfrom(m_lngSocketHandle, arrBuffer(0), Size, lngFlags, udtSockAddr, LenB(udtSockAddr))
1997
1998 107         If lngResult = SOCKET_ERROR Then
1999 108             lngErrorCode = Err.LastDllError
2000             End If
2001
2002 109         bytArray = arrBuffer
2003 110         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.Ref 12/2/2008 : 09:38:32"
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 100     For Each varAsynHandle In m_colWaitingResolutions
2025 101         lngResult = api_WSACancelAsyncRequest(varAsynHandle)
2026
2027 102         If lngResult = 0 Then
2028 103             modSocketMaster.UnregisterResolution varAsynHandle
2029 104             Set m_colWaitingResolutions = Nothing
2030 105             Set m_colWaitingResolutions = New Collection
2031                 'free memory buffer where resolution results are stored
2032 106             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.Ref 12/2/2008 : 09:38:32"
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 100     If m_enmState <> sckClosed And m_enmState <> sckOpen Then
2051 101         Err.Raise sckInvalidOp, "CSocketMaster.Listen", "Invalid operation at current state"
2052         End If
2053
2054 102     If Not SocketExists Then Exit Sub
2055 103     If Not BindInternal Then Exit Sub
2056         Dim lngResult As Long
2057 104     lngResult = api_listen(m_lngSocketHandle, SOMAXCONN)
2058
2059 105     If lngResult = SOCKET_ERROR Then
2060             Dim lngErrorCode As Long
2061 106         lngErrorCode = Err.LastDllError
2062 107         Err.Raise lngErrorCode, "CSocketMaster.Listen", GetErrorDescription(lngErrorCode)
2063         Else
2064 108         m_enmState = sckListening
2065 109         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.Ref 12/2/2008 : 09:38:32"
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 100     If m_enmState <> sckClosed Then
2082 101         Registrar "~SOCK: Operación inválida en el estado actual", 3
2083         End If
2084
2085 102     m_lngSocketHandle = requestID
2086 103     m_enmProtocol = sckTCPProtocol
2087 104     ProcessOptions
2088
2089 105     If Not modSocketMaster.IsAcceptRegistered(requestID) Then
2090 106         If IsSocketRegistered(requestID) Then
2091 107             m_lngSocketHandle = INVALID_SOCKET
2092 108             m_lngRecvBufferLen = 0
2093 109             m_lngSendBufferLen = 0
2094 110             Registrar "~SOCK: Protocolo incorrecto o estado de conexión para la transacción", 3
2095             Else
2096 111             m_blnAcceptClass = True
2097 112             m_enmState = sckConnected
2098 113             Registrar "~SOCK: Estado -> sckConnected", 3
2099 114             GetLocalInfo m_lngSocketHandle, m_lngLocalPortBind, m_strLocalIP
2100 115             modSocketMaster.RegisterSocket m_lngSocketHandle, ObjPtr(Me), False
2101                 Exit Sub
2102             End If
2103         End If
2104
2105         Dim clsSocket As CSocketMaster
2106 116     Set clsSocket = GetAcceptClass(requestID)
2107 117     modSocketMaster.UnregisterAccept requestID
2108 118     GetLocalInfo m_lngSocketHandle, m_lngLocalPortBind, m_strLocalIP
2109 119     GetRemoteInfo m_lngSocketHandle, m_lngRemotePort, m_strRemoteHostIP, m_strRemoteHost
2110 120     m_enmState = sckConnected
2111 121     Registrar "~SOCK: Estado -> sckConnected", 3
2112
2113 122     If clsSocket.BytesReceived > 0 Then
2114 123         clsSocket.GetData m_strRecvBuffer
2115         End If
2116
2117 124     modSocketMaster.Subclass_ChangeOwner requestID, ObjPtr(Me)
2118
2119 125     If Len(m_strRecvBuffer) > 0 Then RaiseEvent DataArrival(Len(m_strRecvBuffer))
2120 126     If clsSocket.State = sckClosing Then
2121 127         m_enmState = sckClosing
2122 128         Registrar "~SOCK: Estado -> sckClosing", 3
2123 129         RaiseEvent CloseSck
2124         End If
2125
2126 130     Set clsSocket = Nothing
2127         '<EhFooter>
2128         Exit Sub
2129 Accept_Err:
2130         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.Accept.Ref 12/2/2008 : 09:38:32"
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 100     GetLocalInfo = False
2145         Dim lngResult As Long
2146         Dim udtSockAddr As sockaddr_in
2147 101     lngResult = api_getsockname(lngSocket, udtSockAddr, LenB(udtSockAddr))
2148
2149 102     If lngResult = SOCKET_ERROR Then
2150 103         lngLocalPort = 0
2151 104         strLocalIP = ""
2152         Else
2153 105         GetLocalInfo = True
2154 106         lngLocalPort = IntegerToUnsigned(api_ntohs(udtSockAddr.sin_port))
2155 107         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.Ref 12/2/2008 : 09:38:32"
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 100     GetRemoteInfo = False
2177         Dim lngResult As Long
2178         Dim udtSockAddr As sockaddr_in
2179 101     lngResult = api_getpeername(lngSocket, udtSockAddr, LenB(udtSockAddr))
2180
2181 102     If lngResult = 0 Then
2182 103         GetRemoteInfo = True
2183 104         GetRemoteInfoFromSI udtSockAddr, lngRemotePort, strRemoteHostIP, strRemoteHost
2184         Else
2185 105         lngRemotePort = 0
2186 106         strRemoteHostIP = ""
2187 107         strRemoteHost = ""
2188         End If
2189
2190         '<EhFooter>
2191         Exit Function
2192 GetRemoteInfo_Err:
2193         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetRemoteInfo.Ref 12/2/2008 : 09:38:32"
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 100     lngRemotePort = IntegerToUnsigned(api_ntohs(udtSockAddr.sin_port))
2209 101     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 102     strRemoteHost = ""
2216         'End If
2217         '<EhFooter>
2218         Exit Sub
2219 GetRemoteInfoFromSI_Err:
2220         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetRemoteInfoFromSI.Ref 12/2/2008 : 09:38:32"
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 100     lngResult = api_ioctlsocket(m_lngSocketHandle, FIONREAD, lngBuffer)
2233
2234 101     If lngResult = SOCKET_ERROR Then
2235 102         GetBufferLenUDP = 0
2236         Else
2237 103         GetBufferLenUDP = lngBuffer
2238         End If
2239
2240         '<EhFooter>
2241         Exit Function
2242 GetBufferLenUDP_Err:
2243         Controlar_Error Erl, Err.Description, "Reseter.CSocketMaster.GetBufferLenUDP.Ref 12/2/2008 : 09:38:32"
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 100     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.Ref 12/2/2008 : 09:38:32"
2259         Resume Next
2260         '</EhFooter>
2261 End Sub