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