[Aportes indexados] Mensaje global [Copiado de TDS]

CUICUI · Jul 19, 2016

Ya está aportado esto pero yo lo hice tipo TDS.

¿Cómo funciona?

El servidor al iniciar prende el sistema de mensajes globales.
El usuario al loguear no puede leer o escribir mensajes globales a no ser que use el comando /ACTIVAR.
Cualquier GM puede habilitar o deshabilitar los mensajes globales mediante /ActivarGlobal

EXTRA: Agregué una validación simple para evitar que modifiquen el formato del mensaje (RGB, bold e italic.)

SERVIDOR

Agregamos 3 paquetes en el ClientPacketID:

Código:

Activar
GlobalMessage
GlobalStatus

Debajo de

Código:

       Case ClientPacketID.ShareNpc
            Call HandleShareNpc(UserIndex)

Poner

Código:

       Case ClientPacketID.GlobalMessage
            Call HandleGlobalMessage(UserIndex)

        Case ClientPacketID.GlobalStatus
            Call HandleGlobalStatus(UserIndex)

       Case ClientPacketID.Activar
                Call HandleActivar(UserIndex)

Al final de protocol poner:

Código:

Private Sub HandleGlobalMessage(ByVal UserIndex As Integer)

    '***************************************************
    'Author: Martín Gomez (Samke)
    'Last Modification: 10/03/2012
    '
    '***************************************************
    Dim buffer As New clsByteQueue

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

        Dim message As String

        message = buffer.ReadASCIIString()
    If .flags.LeerGlobal Then
        If Not (GetTickCount() - .UltimoGlobal) < (INTERVALO_GLOBAL * 1000) Then
            If GlobalActivado = 1 And .flags.Silenciado = 0 Then
            If .flags.Muerto <> 0 Or .death Then
                Call WriteConsoleMsg(UserIndex, "Tu estado no te permite enviar un mensaje global.", FontTypeNames.FONTTYPE_INFO)
                Else 'Not flagmuerto or Death
              
                    Call SendData(SendTarget.toAll, 0, PrepareMessageConsoleMsg("[" & .name & "] " & message, FontTypeNames.FONTTYPE_GLOBAL))
                    .UltimoGlobal = GetTickCount()

                End If
          
            ' @@ El /Silenciar también te mutea prro
            ElseIf GlobalActivado = 1 And .flags.Silenciado = 1 Then Call WriteConsoleMsg(UserIndex, "Estás silenciado..", FontTypeNames.FONTTYPE_INFO)

              

            Else ' @@ Not globalActivado
                Call WriteConsoleMsg(UserIndex, "En estos momentos el sistema de global se encuentra desactivado..", FontTypeNames.FONTTYPE_INFO)

            End If

        Else                                                                                                       ' puto
            Call WriteConsoleMsg(UserIndex, "Debes esperar unos segundos para enviar otro mensaje global.", FontTypeNames.FONTTYPE_INFO)

        End If
        End If

        Call .incomingData.CopyBuffer(buffer)

    End With

    Set buffer = Nothing

End Sub


Private Sub HandleGlobalStatus(ByVal UserIndex As Integer)

    '***************************************************
    'Author: Martín Gomez (Samke)
    'Last Modification: 10/03/2012
    '
    '***************************************************
    With UserList(UserIndex)
        'Remove packet ID
        Call .incomingData.ReadByte

        If .flags.Privilegios > PlayerType.Consejero Then
            If GlobalActivado = 1 Then
                GlobalActivado = 0
                Call SendData(SendTarget.toAll, 0, PrepareMessageConsoleMsg("Global> Global Desactivado.", FontTypeNames.FONTTYPE_SERVER))
            Else
                GlobalActivado = 1
                Call SendData(SendTarget.toAll, 0, PrepareMessageConsoleMsg("Global> Global Activado.", FontTypeNames.FONTTYPE_SERVER))

            End If
        End If
    End With
End Sub

Public Sub HandleActivar(ByVal UserIndex As Integer)

    '***************************************************
    'Author: Cuicui
    '***************************************************
    With UserList(UserIndex)
        'Remove packet ID
        Call .incomingData.ReadByte
      
        ' @@ Tiene que estar vivo
        If .flags.Muerto Then Call WriteConsoleMsg(UserIndex, "Debes estar vivo para realizar esta acción.", FontTypeNames.FONTTYPE_INFO): Call FlushBuffer(UserIndex): Exit Sub
        If .Counters.Pena <> 0 Then Call WriteConsoleMsg(UserIndex, "Debes estar vivo para realizar esta acción.", FontTypeNames.FONTTYPE_INFO): Call FlushBuffer(UserIndex): Exit Sub
      
        If .flags.LeerGlobal = 0 Then
            .flags.LeerGlobal = 1
            Call WriteConsoleMsg(UserIndex, "Empiezas a leer el chat global.", FontTypeNames.FONTTYPE_INFO)
        Else
            .flags.LeerGlobal = 0
            Call WriteConsoleMsg(UserIndex, "Dejas de leer el chat global.", FontTypeNames.FONTTYPE_INFO)
        End If
      
    End With
End Sub

Buscar

Código:

Public Type UserFlags

y debajo poner

Código:

LeerGlobal As Boolean

En el sub connectnewuser debajo de:

Código:

.flags.Escondido = 0

Poner

Código:

.flags.LeerGlobal = 0

En el sub connectuser debajo de:

Código:

.flags.TargetUser = 0

Poner

Código:

.flags.LeerGlobal = 0
UserList(UserIndex).ultimoGlobal = GetTickCount()

En el sub ResetUserFlags, debajo de:

Código:

.Ignorado = False

Poner

Código:

.LeerGlobal = False

Buscar

Código:

Public Type User

Debajo poner:

Código:

ultimoGlobal As Long

En Declaraciones ponemos:

Código:

Public Const INTERVALO_GLOBAL As Integer = 5 'segundos
Public GlobalActivado As byte 'porq no lo dejamos en boolean?

Buscar

Código:

DatPath = App.Path & "\Dat\"

Debajo poner:

Código:

GlobalActivado = 1

Buscar

Código:

Public Enum FontTypeNames

Debajo poner:

Código:

FONTTYPE_GLOBAL

Buscar

Código:

Public Const FONTTYPE_INFO As String = "~65~190~156~0~0"

Debajo poner:

Código:

Public Const FONTTYPE_GLOBAL As String = "~139~248~244~0~1" ' Pongale el que quieran

CLIENTE

Agregar 3 paquetes:

Código:

   GlobalMessage
    GlobalStatus
    Activar

Al final del Protocol poner:

Código:

Public Sub WriteGlobalStatus()
    '***************************************************
    'Writes the "GlobalStatus" message to the outgoing data buffer
    '***************************************************
    Call outgoingData.WriteByte(ClientPacketID.GlobalStatus)

End Sub

Public Sub WriteGlobalMessage(ByVal Message As String)

    '***************************************************
    'Writes the "GlobalMessage" message to the outgoing data buffer
    '***************************************************
    With outgoingData
        Call .WriteByte(ClientPacketID.GlobalMessage)
        Call .WriteASCIIString(Message)

    End With
End Sub

Public Sub WriteActivar()

    '***************************************************
    'En realidad activa y desactiva :v
    '***************************************************
        Call outgoingData.WriteByte(ClientPacketID.Activar)
End Sub

Debajo de:

Código:

           Case "/TELEPLOC"
                Call WriteWarpMeToTarget

Poner:

Código:

           Case "/ACTIVARGLOBAL"
                Call WriteGlobalStatus

            Case "/GLOBAL"

                If notNullArguments Then
                    Call WriteGlobalMessage(ArgumentosRaw)
                Else
                    'Avisar que falta el parametro
                    Call ShowConsoleMsg("Escriba un mensaje.")
                End If

           Case "/ACTIVAR"

                If UserEstado = 1 Then 'Muerto
                    With FontTypes(FontTypeNames.FONTTYPE_INFO)
                        Call ShowConsoleMsg("¡¡Estás muerto!!", .red, .green, .blue, .bold, .italic)
                    End With
                    Exit Sub
                End If

                Call WriteActivar

ArgentumGame · Jul 19, 2016

Código:

Public Const FONTTYPE_GLOBAL As String = "~139~248~244~0~1" ' Pongale el que quieran

Esto no va, porque la estas seteando en el cliente a la font

CUICUI · Jul 19, 2016

Cómo que no?
Entonces borremos todo esto ?) http://i.imgur.com/5rYZNUy.png

Fanta-ao · Jul 19, 2016

Inu*iles,borren todo el modulo protocol.bas y intenten generar el server.

G Toyz · Jul 19, 2016

Shak dijo:
Código:

Public Const FONTTYPE_GLOBAL As String = "~139~248~244~0~1" ' Pongale el que quieran

Esto no va, porque la estas seteando en el cliente a la font

El PrepareMessageConsoleMsg tiene un parametro y ese parametro pide la font, envía la font al cliente y ahí hace el mensaje en la consola con los parametros mandado anteriormente.

Las fonts del cliente son para setear MENSAJES del servidor.

Fanta-ao · Jul 19, 2016

Miren si vamos a usar el sarcasmo, yo les gano.

ArgentumGame · Jul 19, 2016

CuiCui dijo:
Cómo que no?
Entonces borremos todo esto ?) http://i.imgur.com/5rYZNUy.png

Fijate borralo y vas a ver que anda bien (Incluso yo lo hice)

G Toyz dijo:
El PrepareMessageConsoleMsg tiene un parametro y ese parametro pide la font, envía la font al cliente y ahí hace el mensaje en la consola con los parametros mandado anteriormente.

Las fonts del cliente son para setear MENSAJES del servidor.

No entiendo que me queres corregir a mi cabeza

Las fuentes estan seteadas en el cliente (lo que yo dije). Lo que vos decis. El servidor puede mandar el identificador con la fuente que quiere, pero es el cliente en donde estan seteadas

Sigo sin entender que me quisiste corregir. Las fonts del cliente, son usadas para setear mensajes provenientes del servidor, o mensajes incluso del mismo cliente gua

G Toyz · Jul 19, 2016

Shak dijo:
Fijate borralo y vas a ver que anda bien (Incluso yo lo hice)

No entiendo que me queres corregir a mi cabeza
Las fuentes estan seteadas en el cliente (lo que yo dije). Lo que vos decis. El servidor puede mandar el identificador con la fuente que quiere, pero es el cliente en donde estan seteadas

Sigo sin entender que me quisiste corregir. Las fonts del cliente, son usadas para setear mensajes provenientes del servidor, o mensajes incluso del mismo cliente gua

Decime entonces, como identifica el cliente que font poner?

Yo jamás dije que las fuentes están seteadas desde el cliente mostro.

Leete este sub:

Código:

Private Sub HandleConsoleMessage()

Recibe la font enviada desde el servidor. :

Código:

    FontIndex = Buffer.ReadByte()

Acá la aplica:

Código:

With FontTypes(FontIndex)

Call AddtoRichTextBox(frmMain.RecTxt, chat, .Red, .Green, .Blue, .bold, .italic)

.red, .green, .blue, .bold y .italic lo envió el servidor.

No sé que me estás queriendo decir, master.

-
"No entiendo que me queres corregir a mi cabeza

"

Lo decís como si fueras un tipo con conocimientos increíbles y no sabés como funciona esta pelotudés.

ArgentumGame · Jul 19, 2016

G Toyz dijo:
Decime entonces, como identifica el cliente que font poner?

Leete este sub:

Código:

Private Sub HandleConsoleMessage()

Recibe la font enviada desde el servidor. :

Código:

FontIndex = Buffer.ReadByte()

Acá la aplica:

Código:

With FontTypes(FontIndex) Call AddtoRichTextBox(frmMain.RecTxt, chat, .Red, .Green, .Blue, .bold, .italic)

.red, .green, .blue, .bold y .italic lo envió el servidor.

No sé que me estás queriendo decir, master.

-
No entiendo que me queres corregir a mi cabeza

Lo decís como si fueras un tipo con conocimientos increíbles y te confundís en estas pelotudeces

Se podria decir que me sé de memoria el codigo de 0.13.0 (Por más que no soy un re programeitor como vos)

Mira te explico este sub del AO. Esta parte de aca, se puede usar de dos formas. Usando la vieja forma del AO, en la que mande el string, y vos desde el servidor le mandas las lineas que cuicui pregunto si había que borrar.
Y la otra forma es mediante el identificador en el que manda el index de fonttype, que se encuentra seteada en el cliente

vos desde el servidor mandas

call writeconsolemsg(userindex,"mensaje",1)
y sería lo mismo que
call writeconsolemsg(userindex,"mensaje",fonttypenames.fonttype_info)
(No sé si la info es la primera, pero ponele que lo sea)

Si bien podes mandar los colores desde el servidor (Como están declaradas)
http://i.imgur.com/5rYZNUy.png

Cuicui, en este caso, no usa esta forma, me entendes? Usa el identificador según estuve leyendo. No sé que mas queres que te explique, tengo razon xd

Código:

Private Sub HandleConsoleMessage()
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
    If incomingData.length < 4 Then
        Err.Raise incomingData.NotEnoughDataErrCode
        Exit Sub
    End If
   
On Error GoTo ErrHandler
    'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
    Dim Buffer As New clsByteQueue
    Call Buffer.CopyBuffer(incomingData)
   
    'Remove packet ID
    Call Buffer.ReadByte
   
    Dim chat As String
    Dim FontIndex As Integer
    Dim str As String
    Dim r As Byte
    Dim g As Byte
    Dim b As Byte
   
    chat = Buffer.ReadASCIIString()
    FontIndex = Buffer.ReadByte()

    If InStr(1, chat, "~") Then
        str = ReadField(2, chat, 126)
            If Val(str) > 255 Then
                r = 255
            Else
                r = Val(str)
            End If
           
            str = ReadField(3, chat, 126)
            If Val(str) > 255 Then
                g = 255
            Else
                g = Val(str)
            End If
           
            str = ReadField(4, chat, 126)
            If Val(str) > 255 Then
                b = 255
            Else
                b = Val(str)
            End If
           
        Call AddtoRichTextBox(frmMain.RecTxt, Left$(chat, InStr(1, chat, "~") - 1), r, g, b, Val(ReadField(5, chat, 126)) <> 0, Val(ReadField(6, chat, 126)) <> 0)
    Else
        With FontTypes(FontIndex)
            Call AddtoRichTextBox(frmMain.RecTxt, chat, .Red, .Green, .Blue, .bold, .italic)
        End With
       
        '   Para no perder el foco cuando chatea por party
        If FontIndex = FontTypeNames.FONTTYPE_PARTY Then
            If MirandoParty Then frmParty.SendTxt.SetFocus
        End If
    End If

    'If we got here then packet is complete, copy data back to original queue
    Call incomingData.CopyBuffer(Buffer)
   
ErrHandler:
    Dim Error As Long
    Error = Err.Number
On Error GoTo 0
   
    'Destroy auxiliar buffer
    Set Buffer = Nothing

    If Error <> 0 Then _
        Err.Raise Error
End Sub

G Toyz · Jul 19, 2016

CuiCui en este caso planeabla enviar el String supongo, lo hizo de ambas formas, porque pensar que lo hizo de una forma, si aplicó ambas?...

Ahí entendí lo que me querías decir, pero entendé lo que yo te quiero decir

ArgentumGame · Jul 19, 2016

Recibe la font enviada desde el servidor. :

Código Fuente (Visual Basic):

FontIndex = Buffer.ReadByte()

Acá la aplica:
Código Fuente (Visual Basic):

With FontTypes(FontIndex)
Call AddtoRichTextBox(frmMain.RecTxt, chat, .Red, .Green, .Blue, .bold, .italic)

.red, .green, .blue, .bold y .italic lo envió el servidor.

No sé que me estás queriendo decir, master.

-
No entiendo que me queres corregir a mi cabeza

Lo decís como si fueras un tipo con conocimientos increíbles y te confundís en estas pelotudeces

Es mas, queres quedar peor parado ya que editaste y me pusiste eso al final.

.red .green .blue no son mandados desde el servidor.

en todo caso los de arriba si, pero esos, son los de

fonttypes(INDEXXXXXXXXXXXXXXXX)

BUSCALOS , estan seteados en el cliente, no desde el servidor.

ArgentumGame · Jul 19, 2016

G Toyz dijo:
CuiCui en este caso planeabla enviar el String supongo, lo hizo de ambas formas, porque pensar que lo hizo de una forma, si aplicó ambas?...

Ahí entendí lo que me querías decir, pero entendé lo que yo te quiero decir

Entendelo wachin me quisiste basurear o quisiste sobrarme con tus conocimientos, que tenga errores no significa que seas mejor que yo. Es mas si queres retamos para ver quien logra hacer un código antes de tiempo y de la mejor forma. (No tengo problema)

Y te repito, cuicui lo que hizo fue buscar en el servdor y decir "Uhh estan declaradas las fonttype aca" ya fue le mando esta con el mismo nombre pero con _global. Y nqv, no entendió , como vos. saludos

CUICUI LOVES

CUICUI · Sep 1, 2016

Aguante yo loco qué les pasa? bue
Me dicen otra forma de borrar "~" sin tener que analizar letra por letra ?

CUICUI · Sep 2, 2016

Googleé un toque y encontré esto:

Código:

Private Function EliminarString(Cadena As String, aEliminar As String)
Dim Posicion As Long
Dim Longitud As Long
Dim Derecha As String

Derecha = Cadena

Longitud = Len(aEliminar)
Posicion = InStr(1, Derecha, aEliminar)
If Posicion = 0 Then
EliminarString = Cadena
Else
While Not Posicion = 0
EliminarString = EliminarString & Left(Derecha, Posicion - 1)
Derecha = mid(Derecha, Posicion + Longitud + 1)
Posicion = InStr(1, Derecha, aEliminar)
Wend
End If

End Function

Funciona pero ahora voy a buscar cómo sacar también la info que está dentro de lo que quiero borrar.
Pasa esto:
Cadena= "mensaje 1~2~3~4~5~6 continuación del mensaje"

Uso la función >> EliminarString(cadena,"~")

Resultado al usar la función: cadena= "mensaje 1". Esto me borra TODO lo de la derecha a partir de que encuentre el String que quería borrar; "~"

G Toyz · Sep 2, 2016

Buscas el ~ http://www.gs-zone.org/temas/funcion-multiinstr.91677/

Te fijás en qué posición está y cortás el string hasta a esa posición.

CUICUI · Sep 2, 2016

Vos decís algo como:
Si tengo 2 ~, entonces borro desde la posición del primer ~ hasta la posición del segundo ~?

G Toyz · Sep 2, 2016

No... que borre de ~ hasta el final de la cadena.
Edit:

Código:

Option Explicit
Private string1 As String, string2 As String, string3
Private veces  As Byte
Private Posicion() As Integer

Private Sub Command1_Click()
'// un text llamado text1
'// un label llamado label1
'// un botón llamado commmand1

    string1 = Text1.Text
    string2 = "~"


    If MultiInStr(string1, string2, Posicion(), veces) = True Then    'Si es true entonces la letra esta.
       
        Print Posicion(1)
        string3 = Left(string1, (Posicion(1) - 1))
   
    End If

    Label1.Caption = string3

End Sub

Public Function MultiInStr(ByVal string1 As String, ByVal string2 As String, ByRef pos() As Integer, ByRef VecesAparece As Byte) As Boolean

    Dim loopc  As Long

    If Len(string1) < Len(string2) Then

        MultiInStr = 0
        Exit Function

    End If

    Dim veces  As Byte

    For loopc = 1 To Len(string1)

        If Mid$(string1, loopc, Len(string2)) = string2 Then

            veces = veces + 1
            ReDim Preserve pos(1 To veces)
            pos(veces) = loopc

        End If

    Next loopc

    VecesAparece = veces

    If VecesAparece <> 0 Then MultiInStr = True

End Function

CUICUI · Sep 2, 2016

No sería lo que se está pidiendo.
Si pones "string ~255~255~255~ string", se espera que quede "string string"

G Toyz · Sep 2, 2016

CuiCui dijo:
No sería lo que se está pidiendo.
Si pones "string ~255~255~255~ string", se espera que quede "string string"

Código:

string3 = Left(string1, Posicion(1) - 1) & " " & Right$(string1, Len(string1) - Posicion(UBound(Posicion)))

[Aportes indexados] Mensaje global [Copiado de TDS]

CUICUI

Inmortal Lvl 8

ArgentumGame

Dragón Ancestral Lvl 5

CUICUI

Inmortal Lvl 8

Fanta-ao

Usuario Que la re mueve

G Toyz

Invitado

Fanta-ao

Usuario Que la re mueve

ArgentumGame

Dragón Ancestral Lvl 5

G Toyz

Invitado

ArgentumGame

Dragón Ancestral Lvl 5

G Toyz

Invitado

ArgentumGame

Dragón Ancestral Lvl 5

ArgentumGame

Dragón Ancestral Lvl 5

CUICUI

Inmortal Lvl 8

CUICUI

Inmortal Lvl 8

G Toyz

Invitado

CUICUI

Inmortal Lvl 8

G Toyz

Invitado

CUICUI

Inmortal Lvl 8

G Toyz

Invitado