Lista de usuarios, facilidad para eventos manuales. - 0.13.x

Ir abajo

Lista de usuarios, facilidad para eventos manuales. - 0.13.x

Mensaje por Toyz el 28/7/2016, 3:40 am

Bueno, estuve un rato haciendo este código, espero que les guste y sirva.
Explicación:
Un GM activa una lista con cierta cantidad de cupos (elegidos por él), ahora, cuando el usuario tipea /ENTRAR automáticamente se mete a la lista (si tiene espacio). Cuando la lista se completa puede darle sum a todos los usuarios o sumonear a los que quiere (haciendo click más el botón "sum").
Es algo tipo /SHOW SOS - /GM

Servidor:


Código:

Option Explicit

Private Type tList

    Quotas        As Byte      'Cantidad de cupos para la lista
    Active        As Boolean   'Lista activada?
    UsersInList   As Byte      'Usuarios en la lista
    UserIndex()   As Integer   'ID

End Type

Private list As tList
'_

Public Sub Start_List(ByVal UserIndex As Integer, ByVal Amount As Byte)

    '@@ Iniciamos la lista.

    With list

        If Not Amount <> 0 Then Exit Sub

        If Not EsGM(UserIndex) Then
            Call WriteConsoleMsg(UserIndex, "Tienes que ser GM para hacer esta operación.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Sub
        End If

        Call Clean_List

        .Quotas = Amount
        .Active = True
  
        '@@ Redimensionamos el array
        ReDim .UserIndex(1 To .Quotas) As Integer
  
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Lista activada para " & .Quotas & " usuarios, tipee /ENTRAR para ingresar al evento.", FontTypeNames.FONTTYPE_INFOBOLD))

    End With

End Sub

Public Sub Access_List(ByVal UserIndex As Integer)

    '@@ Meter usuario a la lista.

    With UserList(UserIndex)

        If .flags.Muerto = 1 Then
            Call WriteConsoleMsg(UserIndex, "¡¡Estás muerto!!", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Sub
        End If

        If EsGM(UserIndex) = True Or LCase(.name) = "varawel" Then
            Call WriteConsoleMsg(UserIndex, "Tienes que ser una persona normal para ingresar a la lista.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Sub
        End If

        If .flags.list <> 0 Then
            Call WriteConsoleMsg(UserIndex, "Ya estás en la lista!", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Sub
        End If
  
        If list.Active = False Then
            Call WriteConsoleMsg(UserIndex, "No hay lista en curso.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Sub
        End If
  
        '@@ Le damos el flag para que esté en lista
        .flags.list = 1
        '@@ Aumentamos la variable de usuarios en lista
        list.UsersInList = list.UsersInList + 1
        '@@ Guardamos el ID del usuario
        list.UserIndex(list.UsersInList) = UserList(UserIndex).ID
  
        Call WriteNameList(UserIndex)
  
        Call WriteConsoleMsg(UserIndex, "Has ingresado a lista.", FontTypeNames.FONTTYPE_INFOBOLD)
  
        If list.UsersInList = list.Quotas Then Call Full_List

    End With

End Sub

Private Sub Full_List()

    '@@ Se completa la lista.

        List.Active = False
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("La lista ha sido completada.", FontTypeNames.FONTTYPE_INFOBOLD))

End Sub

Public Sub Clean_List()

    '@ Limpiamos la lista.

    Dim LoopC As Long

    With list

        '@@ Canceló la lista.
        If .UsersInList < .Quotas Then _
            Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Lista cancelada.", FontTypeNames.FONTTYPE_INFOBOLD))

        If .UsersInList <> 0 Then
  
            For LoopC = 1 To .UsersInList
      
                UserList(.UserIndex(LoopC)).flags.list = 0
      
            Next LoopC
      
        End If
  
        .Active = False
        .Quotas = 0
        .UsersInList = 0
  
    End With

End Sub

Public Sub Remove_User(ByVal UserIndex As Integer)

    '@@ Por si se desconecta

    Dim LoopX As Long
    Dim LoopC As Long
  
    UserList(UserIndex).flags.list = 0

    For LoopX = 1 To list.UsersInList

        If list.UserIndex(LoopX) = UserList(UserIndex).ID Then
      
            For LoopC = LoopX To (list.UsersInList - 1)
      
                list.UserIndex(LoopC) = list.UserIndex(LoopC + 1)
          
            Next LoopC
      
            list.UsersInList = list.UsersInList - 1
      
            Exit For
      
        End If

    Next LoopX

End Sub



Código:

Public Sub WriteNameList(ByVal UserIndex As Integer)

On Error GoTo Errhandler

    With UserList(UserIndex).outgoingData

        Call .WriteByte(ServerPacketID.NameList)
        Call .WriteASCIIString(UserList(UserIndex).name) '@@ Nick
  
    End With

Exit Sub

Errhandler:
    If Err.Number = UserList(UserIndex).outgoingData.NotEnoughSpaceErrCode Then
        Call FlushBuffer(UserIndex)
        Resume
    End If
End Sub

Private Sub HandleStartList(ByVal UserIndex As Integer)

    With UserList(UserIndex)
        'Remove packet ID
        Call .incomingData.ReadByte

        Call ListEvent.Start_List(UserIndex, .incomingData.ReadByte())
  
    End With

End Sub

Private Sub HandleAccessList(ByVal UserIndex As Integer)

    With UserList(UserIndex)
        'Remove packet ID
        Call .incomingData.ReadByte
  
        Call ListEvent.Access_List(UserIndex)
  
    End With

End Sub

Private Sub HandleCanceLlist(ByVal UserIndex As Integer)

    With UserList(UserIndex)
        'Remove packet ID
        Call .incomingData.ReadByte
  
        Call ListEvent.Clean_List
  
    End With

End Sub



ClientPacketID:


Código:

    StartList
    AccessList
    CancelList


y:


Código:

Case ClientPacketID.StartList
            Call HandleStartList(UserIndex)

        Case ClientPacketID.AccessList
            Call HandleAccessList(UserIndex)
      
        Case ClientPacketID.CancelList
            Call HandleCanceLlist(UserIndex)


ServerPacketID:


Código:

NameList


Agregar en el Type UserFlag:


Código:
   List   As Byte '¿En lista?


En el CloseSocketUser:


Código:

    If UserList(UserIndex).flags.List = 1 Then
        UserList(UserIndex).flags.List = 0
        Call ListEvent.Remove_User(UserIndex)
    End If


Cliente:


Código:

Public Sub WriteStartList(ByVal Amount As Byte)

    With outgoingData

        ReDim List.Names(1 To Amount)

        Call .WriteByte(ClientPacketID.StartList)
        Call .WriteByte(Amount)

    End With

End Sub

Public Sub WriteAccessList()

    Call outgoingData.WriteByte(ClientPacketID.AccessList)

End Sub


Public Sub WriteCancelList()

    Call outgoingData.WriteByte(ClientPacketID.CancelList)

End Sub

Private Sub HandleNameList()

    Dim Name As String

    Call incomingData.ReadByte
 
    Name = incomingData.ReadASCIIString()
 
    With List
        .Indexs = .Indexs + 1
    
        .Names(Indexs) = Name
    
        frmList.list_participant.AddItem Names(.Indexs)
        frmList.lbl_participant.Caption = frmList.list_participant.ListCount & "/" & .AmountList
    
    End With
End Sub



ClientPacketID:


Código:

    StartList
    AccessList
    CancelList


ServerPacketID:


Código:
NameList

y:

Código:

        Case ServerPacketID.NameList
            Call HandleNameList


Declaraciones:


Código:

Public Type tList

    AmountList  As Byte
    Names()     As String
    Indexs      As Byte

End Type

Public List As tList


Código:

            Case "/ENTRAR"
                Call WriteAccessList


Para ver el form: (esto cambienlo jaja)


Código:

            Case "/VER"
                frmList.Show


Descargan este formulario y lo añaden al cliente: frmList

Lo único que tendrían que hacer es sacar el nombre de la lista cuando desloguean, fijensé como lo hice en el servidor.
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5045
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Lista de usuarios, facilidad para eventos manuales. - 0.13.x

Mensaje por Metrosersuah el 4/9/2016, 11:48 am

Buen aporte, quizás lo utilize, gracias Wink
avatar
Metrosersuah
Nivel 5
Nivel 5

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 234
Localización : 4 Paredes
Fecha de inscripción : 13/02/2016

Ver perfil de usuario http://www.argentumonline.com.ar

Volver arriba Ir abajo

Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.