PureBasic Forums - English

Code: Select all

;/#################################
;/# ClientEvent 4 include example #
;/#################################
;
;/ Coded by 'Lars'

Procedure ErrorProc(msg.s)
  Debug "Error: " + msg
EndProcedure


If InitNetwork() = 0
  ErrorProc("Could not initialise Network.")
  End
EndIf


XIncludeFile "ClientEvent4.pbi"
CE4_SetErrorProcedure(@ErrorProc()) ;Set our own error procedure


*Mem_Receive = AllocateMemory(1024)
If *Mem_Receive = 0
  ErrorProc("Could not allocate 1KB of memory!")
  End
EndIf


ConnectTo.s = InputRequester("Server adress", "Please enter ServerIP:Port to connect to:", "127.0.0.1:6000")
If ConnectTo = ""
  End
EndIf

ColonPos.l = FindString(ConnectTo, ":", 1)
If ColonPos = 0
  ErrorProc("Invalid server adress Data.")
  End
EndIf

ServerIP.s = Left(ConnectTo, ColonPos - 1)
ServerPort.l = Val(Right(ConnectTo, Len(ConnectTo) - ColonPos))


ConnectionID = OpenNetworkConnection(ServerIP, ServerPort)
If ConnectionID
  CE4_EnableClientEvent4(ConnectionID)
  Repeat
    NetEvent.l = NetworkClientEvent(ConnectionID)
    CE4_CheckClientEvent4(ConnectionID, @NetEvent)
    
    Select NetEvent
      Case 2
        LengthReceived.l = ReceiveNetworkData(ConnectionID, *Mem_Receive, 1023) 
        Debug Str(LengthReceived) + "bytes of Data received!"
        Debug "Data:"
        Debug PeekS(*Mem_Receive, LengthReceived)
      Case 4
        Debug "Server disconnected!"
    EndSelect
  Until NetEvent = 4
Else
  ErrorProc("Could not connect To '" + ServerIP + ":" + Str(ServerPort) + "'.")
  End
EndIf

Code: Select all

;/#########################
;/# ClientEvent 4 include #
;/#########################
;
;/ Coded by 'Lars'
;
;/ Short how-to:
; To get ClientEvent 4 (server disconnect) responses, first 
; establish a connection, and then enable the ClientEvent4 
; for it with CE4_EnableClientEvent4(). After that, you can
; check for server disconnects with the CE4_CheckClientEvent4()
; procedure.
; When you drop a connection you should disable the server 
; disconnect with the CE4_DisableClientEvent4(), because this 
; procedure deletes the internal linked list element that matches
; hSocket to WSock handles (namely the EventObject handle).
;
;
;/ A few word on error handling:
; On each failure regarding the WSSock2 routines an error procedure
; that you can define (via CE4_SetErrorProcedure()) is called. If 
; you don't specify an own error procedure, which can be used for 
; every thing that could be usefull, you can add log entries or just 
; do nothing.
; In every case you still can call the procedures of the CE4 include, 
; because it has an internal status variable that indicates whether everything
; is ok and thus the procedures just do nothing if this variable indicates
; an error somewhere.
;

Procedure _CE4_Error(msg.s)
  Shared *_CE4_ptrErrorProcedure
  
  If *_CE4_ptrErrorProcedure
    CallFunctionFast(*_CE4_ptrErrorProcedure, @msg)
  EndIf
EndProcedure

;LinkedList that stores the event object for each connection ID
Structure _CE4_EventObjectsStruct
  hSocket.l
  hEventObject.l
EndStructure

NewList _CE4_EventObjects._CE4_EventObjectsStruct()

;Various, not in PB declared constants
#WSA_INVALID_EVENT     = #Null
#WSA_NOT_ENOUGH_MEMORY = #ERROR_NOT_ENOUGH_MEMORY
#WSA_INVALID_HANDLE    = #ERROR_INVALID_HANDLE
#WSA_INVALID_PARAMETER = #ERROR_INVALID_PARAMETER
#WSA_WAIT_EVENT_0      = #Null

;Variable that indicates whether everything is ok. If not, the routines just do nothing, so you don't have to stop the 
;                                                                                                    whole application.
_CE4_StatusOk         = #True
;Internal pointer to yout own Error procedure, set by CE4_SetErrorProcedure(). Standard is 0, which does nothing.
*_CE4_ptrErrorProcedure = 0

;Open the library manually as PB doesn't delcare the WSock2 Functions
_CE4_Library_WSock2 = OpenLibrary(#PB_Any, "ws2_32.dll")
If _CE4_Library_WSock2 = 0
  _CE4_Error("Could not initialise WSock2 API")
  _CE4_StatusOk = #False
EndIf



;CE4_SetErrorProcedure() - Sets the procedure that is called if an error occurs. If you don't use this function, the standard,
;                          which is just doing nothing, is used. Note that the procedure has to have one string parameter which
;                          is an WSock2 error description.
;                          *ptrErrorProcedure.l - pointer to the procedure that is to be executed
;                          Returnvalue: The parameter (useless, but whatever)
Procedure.l CE4_SetErrorProcedure(*ptrErrorProcedure)
  Shared *_CE4_ptrErrorProcedure
  
  *_CE4_ptrErrorProcedure = *ptrErrorProcedure
  
  ProcedureReturn *_CE4_ptrErrorProcedure
EndProcedure


;CE4_EnableClientEvent4() - Enables ClientEvent 4 (server disconnect) for the specified connection hSocket.
;                           hSocket.l is the ConnectionID.
;                           Returnvalue: #True on success, #False on Failure. 
Procedure.l CE4_EnableClientEvent4(hSocket.l)
  Shared _CE4_Library_WSock2, _CE4_StatusOk, _CE4_EventObjects()
  
  _CE4_TempOk = #True
  
  ForEach _CE4_EventObjects()
    If _CE4_EventObjects()\hSocket = hSocket
      ProcedureReturn #False
    EndIf
  Next
  
  If _CE4_StatusOk
    hEventObject.l = CallFunction(_CE4_Library_WSock2, "WSACreateEvent")
    
    If hEventObject = #WSA_INVALID_EVENT
      _CE4_TempOk = #False
      Select WSAGetLastError_()
        Case #WSANOTINITIALISED 
          _CE4_Error("WSock2 Error:" + #CRLF$ + "A successful WSAStartup call must occur before using this function.")
        Case #WSAENETDOWN 
          _CE4_Error("WSock2 Error:" + #CRLF$ + "The network Subsystem has failed.")
        Case #WSAEINPROGRESS 
          _CE4_Error("WSock2 Error:" + #CRLF$ + "A blocking Windows Sockets 1.1 call is in progress, Or The service provider is still processing A callback function.")
        Case #WSA_NOT_ENOUGH_MEMORY
          _CE4_Error("WSock2 Error:" + #CRLF$ + "Not enough free memory available To create The Event object.")
        Default
          _CE4_Error("WSock2 Error.")
      EndSelect
    EndIf
  EndIf
  
  
  If _CE4_StatusOk And _CE4_TempOk
    If CallFunction(_CE4_Library_WSock2, "WSAEventSelect", hSocket, hEventObject, #FD_CLOSE) = #SOCKET_ERROR
      _CE4_TempOk = #False
      Select WSAGetLastError_()
        Case #WSANOTINITIALISED 
          _CE4_Error("WSock2 Error:" + #CRLF$ + "A successful WSAStartup call must occur before using this function.")
        Case #WSAENETDOWN 
          _CE4_Error("WSock2 Error:" + #CRLF$ + "The network Subsystem has failed.")
        Case #WSAEINVAL 
          _CE4_Error("WSock2 Error:" + #CRLF$ + "Indicates that one of The specified parameters was invalid, Or The specified socket is in an invalid State.")
        Case #WSAEINPROGRESS 
          _CE4_Error("WSock2 Error:" + #CRLF$ + "A blocking Windows Sockets 1.1 call is in progress, Or The service provider is still processing A callback function.")
        Case #WSAENOTSOCK 
          _CE4_Error("WSock2 Error:" + #CRLF$ + "The descriptor is not A socket.")
        Default
          _CE4_Error("WSock2 Error.")
      EndSelect
    EndIf
  EndIf
  
  If _CE4_StatusOk And _CE4_TempOk
    AddElement(_CE4_EventObjects())
    _CE4_EventObjects()\hSocket      = hSocket
    _CE4_EventObjects()\hEventObject = hEventObject
    
    ProcedureReturn #True
  EndIf 
  
  ProcedureReturn #False
EndProcedure


;CE4_DisableClientEvent4() - Disables ClientEvent 4 (server disconnect) for the specified connection hSocket and 
;                            deletes the internal linked list element that matches hSocket to WSock handles.
;                            hSocket.l is the ConnectionID.
;                            Returnvalue: #True on success, #False on Failure (no entry with specified hSocket).
Procedure.l CE4_DisableClientEvent4(hSocket.l)
  Shared _CE4_EventObjects()
  ForEach _CE4_EventObjects()
    If _CE4_EventObjects()\hSocket = hSocket
      CloseHandle_(_CE4_EventObjects()\hEventObject)
      DeleteElement(_CE4_EventObjects())
      
      ProcedureReturn #True
    EndIf
  Next
  
  ProcedureReturn #False
EndProcedure


;CE4_CheckClientEvent4() - Checks for a server disconnect event on a connection that has already enabled this event
;                          via CE4_EnableClientEvent4().
;                          hSocket.l is the ConnectionID.
;                          The second parameter is a _pointer_ (!) to your usual netevent variable (long). This procedure 
;                          checks ich this value is 0 and just then returns a server disconnect event is reported the next 
;                          time you call this procedure and netevent is 0. As a result, you can easily check the netevents
;                          and you don't need to implement 2 checks on this.
;                          Returnvalue: #True on success, #False on Failure (no entry with specified hSocket).
Procedure.l CE4_CheckClientEvent4(hSocket.l, *NetEvent.LONG)
  Shared _CE4_Library_WSock2
  
  _CE4_Found.l = #False
  Shared _CE4_EventObjects()
  ForEach _CE4_EventObjects()
    If _CE4_EventObjects()\hSocket = hSocket
      _CE4_Found = #True
      Break
    EndIf
  Next
  
  If _CE4_Found
    If *NetEvent\l = 0
      Select CallFunction(_CE4_Library_WSock2, "WSAWaitForMultipleEvents", 1, @_CE4_EventObjects()\hEventObject, #False, #False, #False)
        Case #WSA_WAIT_EVENT_0
          ResetEvent_(_CE4_EventObjects()\hEventObject)
          *NetEvent\l = 4
        Case #SOCKET_ERROR
          Select WSAGetLastError_()
            Case #WSANOTINITIALISED 
              _CE4_Error("WSock2 Error:" + #CRLF$ + "A successful WSAStartup call must occur before using this function.")
            Case #WSAENETDOWN 
              _CE4_Error("WSock2 Error:" + #CRLF$ + "The network Subsystem has failed.")
            Case #WSAEINPROGRESS 
              _CE4_Error("WSock2 Error:" + #CRLF$ + "A blocking Windows Sockets 1.1 call is in progress, Or The service provider is still processing A callback function.")
            Case #WSA_NOT_ENOUGH_MEMORY 
              _CE4_Error("WSock2 Error:" + #CRLF$ + "Not enough free memory available To complete The operation.")
            Case #WSA_INVALID_HANDLE 
              _CE4_Error("WSock2 Error:" + #CRLF$ + "One Or more of The values in The lphEvents array is Not A valid Event object handle.")
            Case #WSA_INVALID_PARAMETER 
              _CE4_Error("WSock2 Error:" + #CRLF$ + "The cEvents parameter does Not contain A valid handle count.")
            Default
              _CE4_Error("WSock2 Error.")
          EndSelect
      EndSelect
    EndIf
  Else
    ProcedureReturn #False
  EndIf
  
  ProcedureReturn #True
EndProcedure