[Aportes indexados] Mensaje global [Copiado de TDS]

CUICUI

Oráculo Lvl 4
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
 
Última edición:

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
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
 
G

G Toyz

Invitado
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.
 

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
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)

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 xD
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

G Toyz

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



No entiendo que me queres corregir a mi cabeza xD
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 xD"

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

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
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 xD

Lo decís como si fueras un tipo con conocimientos increíbles y te confundís en estas pelotudeces xD
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

G Toyz

Invitado
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 :)
 

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
Recibe la font enviada desde el servidor. :

Código Fuente (Visual Basic):
  1. FontIndex = Buffer.ReadByte()
Acá la aplica:
Código Fuente (Visual Basic):

  1. With FontTypes(FontIndex)

  2. 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 xD

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



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.
 

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
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

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

CUICUI

Oráculo Lvl 4
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; "~"
 

CUICUI

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

G Toyz

Invitado
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
 
Última edición por un moderador:

CUICUI

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

G Toyz

Invitado
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)))
 
Última edición por un moderador:
Arriba