Comando Buscar

por Los Aldeanos 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:

[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,

! Saludos.