Anti editados

primero q nada, agarran este sub y le cambian todas las contraseñas , tienen q ser diferentes, o si no no tiene gracia

Código:

Function Encripta(text As String, Encriptar As Boolean) As String
 
On Error GoTo a:
 
Dim a() As Integer
Dim b() As Integer
Dim Contraseñas(9) As String
Dim i As Integer
Dim ii As Integer
Dim R As String
Dim CI As Byte
Dim ss As Integer
 
Contraseñas(0) = "Asdu"
Contraseñas(1) = "ssd"
Contraseñas(2) = "sd"
Contraseñas(3) = "Aadsd"
Contraseñas(4) = "sd"
Contraseñas(5) = "Afsd"
Contraseñas(6) = "sd"
Contraseñas(7) = "sad"
Contraseñas(8) = "desd"
Contraseñas(9) = "dsd"
 
 
 
'********* que contraseña hay q usar? *********
If Not Encriptar Then
    CI = Val(Asc(Left(text, 1))) - 10
    text = Right(text, Len(text) - 1)
End If
'**********************************************
 
'para no llamar a cada rato a la function
ss = Len(text)
 
'Por las dudas
If ss <= 0 Then Exit Function
 
ReDim a(1 To ss) As Integer
 
    For i = 1 To ss
        a(i) = Asc(Mid(text, i, 1))
    Next i
 
 
    If Encriptar Then
 
        '****** Separamos la Contraseña ******
            CI = RandomNumber(0, 9)
            ReDim b(1 To Len(Contraseñas(CI))) As Integer
 
            For i = 1 To Len(Contraseñas(CI))
                b(i) = Asc(Mid(Contraseñas(CI), i, 1))
            Next i
        '*************************************
 
        For i = 1 To ss
            If ii >= UBound(b) Then ii = 0
            ii = ii + 1
            a(i) = a(i) + b(ii)
            If a(i) > 255 Then a(i) = a(i) - 255
            R = R + Chr(a(i))
        Next i
 
        Encripta = Chr(CI + 10) & R
 
    Else
       
    '****** Separamos la Contraseña ******
        ReDim b(1 To Len(Contraseñas(CI))) As Integer
       
        For i = 1 To Len(Contraseñas(CI))
            b(i) = Asc(Mid(Contraseñas(CI), i, 1))
        Next i
    '*************************************
       
        For i = 1 To ss
        If ii >= UBound(b) Then ii = 0
            ii = ii + 1
            a(i) = a(i) - b(ii)
            If a(i) < 0 Then
            a(i) = a(i) + 255
            End If
            R = R + Chr(a(i))
        Next i
       
        Encripta = R
   
    End If
 
a:
 
End Function

ahora, lo agregan en el cliente y en el server.

progresemos.

Cliente:

Declaramos:

Código:

Public PersonalPass As String

ahora, buscamos:

Código:

bRK = ReadField(2, Rdata, Asc(","))

y abajo ponen:

Código:

PersonalPass = ReadField(3, Rdata, 44)
          PersonalPass = Encripta(PersonalPass, False)
          PersonalPass = Encripta(PersonalPass, False)

ahora, buscan:

Código:

Sub Login(ByVal valcode As Integer)

y abajo ponen:

Código:

valcode = Val(PersonalPass)

End Client.

Server:

Buscan:

Código:

Call SendData(ToIndex, UserIndex, 0, "VAL"

y lo reemplazan esa linea por:

Código:

UserList(UserIndex).PersonalPass = RandomNumber(100, 999)
    Dim S As String
    S = Encripta(CStr(UserList(UserIndex).PersonalPass), True)
  S = Encripta(s, True)
  Call SendData(ToIndex, UserIndex, 0, "VAL" & UserList(UserIndex).RandKey & "," & UserList(UserIndex).flags.ValCoDe & "," & S

)



ahora buscan:

Código:

Type user

y abajo le ponen

Código:

PersonalPass as integer

Buscan:

Código:

If (UserList(UserIndex).flags.ValCoDe = 0) Or (ValidarLoginMSG(UserList(UserIndex).flags.ValCoDe) <> CInt(val(ReadField(37, rdata, 44)))) Then

y lo reemplazan por:

Código:

If UserList(UserIndex).PersonalPass <> val(ReadField(37, rdata, 44)) Then

ahora buscan:

Código:

If (UserList(UserIndex).flags.ValCoDe = 0) Or (ValidarLoginMSG(UserList(UserIndex).flags.ValCoDe) <> CInt(val(ReadField(4, rdata, 44)))) Then

y lo reemplazan por:

Código:

If UserList(UserIndex).PersonalPass <> val(ReadField(4, rdata, 44)) Then

Saludos!