Comando Buscar

Ir abajo

Comando Buscar

Mensaje por Los Aldeanos el Lun Sep 23, 2013 8:39 pm

Buenas hoy les traigo un nuevo [Aporte]. El cual consiste : Al poner /Buscar Espada. Les apareceran todas las Espadas y Objetos que tenga su Carpeta "Dat".

¿Para que podría ayudarme? : Bueno esto nos facilitara mucho la busqueda de objetos ya sea Casco u Armaduras etc. Si no sabemos el Número del Objeto no los dira. No tendremos que abrir la carpeta del juego, es todo más rapido y en el momento.

...Empezemos...

[CLIENTE] :

Spoiler:
Abajo de :

Código:
Consulta
Ponemos :

Código:
SearchObj              '/BUSCAR [OBJETO]
Abajo de :

Código:
Case "/CONSULTA"
              Call WriteConsulta
Ponemos :

Código:
Case "/BUSCAR"
                If ArgumentosAll(0) <> "" Then
                            Call WriteSearchObj(ArgumentosAll(0))
                          End If
Y al final del "Protocol"

Código:
Public Sub WriteSearchObj(ByVal restrict As String)
'***************************************************
'Author: Los Aldeanos
'Last Modification:
'***************************************************
    With outgoingData
        Call .WriteByte(ClientPacketID.SearchObj)
         
        Call .WriteASCIIString(restrict)
    End With
End Sub

[SERVIDOR] :

Spoiler:
Abajo de :

Código:
Consultation
Ponemos :

Código:
SearchObj              '/BUSCAR [OBJETO]
Después abajo de :

Código:
Case ClientPacketID.Consultation
            Call HandleConsultation(UserIndex)
Ponemos :

Código:
Case ClientPacketID.SearchObj              '/BUSCAR [OBJETO]
            Call HandleSearchObj(UserIndex)
Al final del Protocol :

Código:
Private Sub HandleSearchObj(ByVal UserIndex As Integer)
    If UserList(UserIndex).incomingData.length < 3 Then
        Err.Raise UserList(UserIndex).incomingData.NotEnoughDataErrCode
        Exit Sub
    End If
     
On Error GoTo Errhandler
    With UserList(UserIndex)
        '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 UserObj As String
        Dim tUser As Integer
        Dim rank As Integer
        Dim N As Integer
        Dim i As Integer
         
        rank = PlayerType.Admin Or PlayerType.Dios Or PlayerType.SemiDios Or PlayerType.Consejero
         
        UserObj = buffer.ReadASCIIString()
         
        If (.flags.Privilegios And (PlayerType.Admin Or PlayerType.Dios Or PlayerType.SemiDios)) Then
             
            For i = 1 To UBound(ObjData)
                If InStr(1, Tilde(ObjData(i).name), Tilde(UserObj)) Then
                    Call WriteConsoleMsg(UserIndex, i & " " & ObjData(i).name & ".", FontTypeNames.FONTTYPE_CENTINELA)
                    N = N + 1
                End If
            Next
            If N = 0 Then
                Call WriteConsoleMsg(UserIndex, "No hubo resultados de la busqueda: " & UserObj, FontTypeNames.FONTTYPE_INFO)
            Else
                Call WriteConsoleMsg(UserIndex, "Hubo " & N & " resultados de la busqueda: " & UserObj, FontTypeNames.FONTTYPE_INFO)
            End If
             
        End If
         
        'If we got here then packet is complete, copy data back to original queue
        Call .incomingData.CopyBuffer(buffer)
    End With
   
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
Por último. Al final del Mod General :

Código:
Public Function Tilde(data As String) As String
   
Tilde = Replace(Replace(Replace(Replace(Replace(UCase$(data), "Á", "A"), "É", "E"), "Í", "I"), "Ó", "O"), "Ú", "U")
   
End Function

Listo, Very Happy! Saludos.
Los Aldeanos
Los Aldeanos



Aportes : 4
Mensajes : 6
Puntos : 14

Ver perfil de usuario

Volver arriba Ir abajo

Volver arriba

- Temas similares

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